From b6d3dfb0755a69f570cd35a5f016dd4c59b685dc Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Sat, 26 Nov 2022 15:22:58 -0600 Subject: [PATCH 01/39] Designated initializers for arrays, part 1. This can parse designated initializers for arrays, but does not create proper initializer records for them. --- Parser.pas | 84 +++++++++++++++++++++++++++++++++-------------------- Scanner.pas | 2 ++ 2 files changed, 54 insertions(+), 32 deletions(-) diff --git a/Parser.pas b/Parser.pas index d1dc492..1587e6b 100644 --- a/Parser.pas +++ b/Parser.pas @@ -2036,25 +2036,6 @@ var begin {GetInitializerValue} - if token.kind in [dotch,lbrackch] then begin - {designated initializer: give error and skip over it} - Error(150); - while token.kind in [dotch,lbrackch] do begin - if token.kind = lbrackch then begin - NextToken; - Expression(arrayExpression, [rbrackch]); - if token.kind = rbrackch then - NextToken; - end {if} - else {if token.kind = dotch then} begin - NextToken; - if token.kind in [ident,typedef] then - NextToken; - end {if} - end; {while} - if token.kind = eqch then - NextToken; - end; {if} if variable^.storage = stackFrame then Expression(autoInitializerExpression, [commach,rparench,rbracech]) else @@ -2361,7 +2342,7 @@ var procedure InitializeTerm (tp: typePtr; bitsize,bitdisp: integer; - main: boolean); + main, nestedDesignator: boolean); { initialize one level of the type } { } @@ -2370,6 +2351,10 @@ var { bitsize - size of bit field (0 for non-bit fields) } { bitdisp - disp of bit field; unused if bitsize = 0 } { main - is this a call from the main level? } + { nestedDesignator - handling second or later level of } + { designator in a designator list? } + + label 1; var bitCount: integer; {# of bits in a union} @@ -2381,6 +2366,7 @@ var kind: typeKind; {base type of an initializer} ktp: typePtr; {array type with definedTypes removed} lSuppressMacroExpansions: boolean;{local copy of suppressMacroExpansions} + skipToNext: boolean; {skip to next array/struct element?} stringElementType: typePtr; {element type of string literal} stringLength: integer; {elements in a string literal} @@ -2505,6 +2491,13 @@ var while tp^.kind = definedType do tp := tp^.dType; kind := tp^.kind; + {check for designators that need to} + {be handled at an outer level } + if token.kind in [dotch,lbrackch] then + if not (braces or nestedDesignator) then begin + {TODO fill?} + goto 1; + end; {if} if kind = arrayType then begin ktp := tp^.atype; while ktp^.kind = definedType do @@ -2571,23 +2564,49 @@ var maxCount := tp^.elements; if token.kind <> rbracech then repeat - InitializeTerm(ktp, 0, 0, false); - count := count+1; - if count <> maxCount then begin - if token.kind = commach then begin - NextToken; - done := token.kind = rbracech; + skipToNext := false; + if token.kind = lbrackch then begin + NextToken; + Expression(arrayExpression, [rbrackch]); + if (expressionValue < 0) + or ((maxCount <> 0) and (expressionValue >= maxCount)) then begin + Error(183); + count := 0; end {if} else - done := true; - end {if} + count := expressionValue; + Match(rbrackch, 24); + {TODO if first designator (or expanding array size) and not nestedDesignator then fill in rest with zeros} + if token.kind in [dotch,lbrackch] then begin + InitializeTerm(ktp, 0, 0, false, true); + skipToNext := true; + end {if} + else + Match(eqch, 182); + end; {if} + if not skipToNext then + InitializeTerm(ktp, 0, 0, false, false); + count := count+1; + if (count = maxCount) and not braces then + done := true + else if token.kind = commach then begin + NextToken; + done := token.kind = rbracech; + if not done then + if count = maxCount then + if not (token.kind = lbrackch) then begin + Error(183); + count := 0; + end; {if} + end {else if} else done := true; - until done or (token.kind = eofsy) or (count = maxCount); + until done or (token.kind = eofsy); if maxCount <> 0 then begin count := maxCount-count; if count <> 0 then {if there weren't enough initializers...} - Fill(count,ktp); { fill in the blank spots} + if not nestedDesignator then + Fill(count,ktp); { fill in the blank spots} end {if} else begin tp^.elements := count; {set the array size} @@ -2629,7 +2648,7 @@ var count := count-bitCount; bitCount := 0; end; {if} - InitializeTerm(ip^.itype, ip^.bitsize, ip^.bitdisp, false); + InitializeTerm(ip^.itype, ip^.bitsize, ip^.bitdisp, false, false); if ip^.bitSize <> 0 then begin bitCount := bitCount + ip^.bitSize; if bitCount > maxBitField then begin @@ -2692,6 +2711,7 @@ var errorFound := true; end; {else} end; {if} +1: end; {InitializeTerm} begin {Initializer} @@ -2707,7 +2727,7 @@ if not (token.kind in [lbracech,stringConst]) then Error(27); errorFound := true; end; {if} -InitializeTerm(variable^.itype, 0, 0, true); {do the initialization} +InitializeTerm(variable^.itype, 0, 0, true, false); {do the initialization} variable^.state := initialized; {mark the variable as initialized} iPtr := variable^.iPtr; {reverse the initializer list} jPtr := nil; diff --git a/Scanner.pas b/Scanner.pas index 00176c6..86a8f8e 100644 --- a/Scanner.pas +++ b/Scanner.pas @@ -777,6 +777,8 @@ if list or (numErr <> 0) then begin 179: msg := @'_Pragma requires one string literal argument'; 180: msg := @'decimal digit sequence expected'; 181: msg := @'''main'' may not have any function specifiers'; + 182: msg := @'''='' expected'; + 183: msg := @'array index out of bounds'; otherwise: Error(57); end; {case} writeln(msg^); From 8cfc14b50ac62cf4c0f2e3e1751d9a8c5e943fb1 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Sat, 26 Nov 2022 15:45:26 -0600 Subject: [PATCH 02/39] Rename itype field of initializerRecord to basetype. --- CCommon.pas | 2 +- Parser.pas | 30 +++++++++++++++--------------- Symbol.pas | 12 ++++++------ 3 files changed, 22 insertions(+), 22 deletions(-) diff --git a/CCommon.pas b/CCommon.pas index 8e20e63..68638a8 100644 --- a/CCommon.pas +++ b/CCommon.pas @@ -328,7 +328,7 @@ type case isConstant: boolean of {is this a constant initializer?} false: (iTree: tokenPtr); true : ( {Note: qVal.lo must overlap iVal} - case itype: baseTypeEnum of + case basetype: baseTypeEnum of cgByte, cgUByte, cgWord, diff --git a/Parser.pas b/Parser.pas index 1587e6b..ab4fc3e 100644 --- a/Parser.pas +++ b/Parser.pas @@ -1888,13 +1888,13 @@ var iPtr^.isStructOrUnion := false; iPtr^.iVal := bitvalue; if bitcount <= 8 then - iPtr^.itype := cgUByte + iPtr^.basetype := cgUByte else if bitcount <= 16 then - iPtr^.itype := cgUWord + iPtr^.basetype := cgUWord else if bitcount > 24 then - iPtr^.itype := cgULong + iPtr^.basetype := cgULong else begin {3-byte bitfield: split into two parts} - iPtr^.itype := cgUWord; + iPtr^.basetype := cgUWord; iPtr^.iVal := bitvalue & $0000FFFF; bitcount := bitcount - 16; bitvalue := bitvalue >> 16; @@ -2064,7 +2064,7 @@ var iPtr^.qval.hi := 0; iPtr^.iVal := expressionValue; end; {else} - iPtr^.itype := tp^.baseType; + iPtr^.basetype := tp^.baseType; InitializeBitField; end; {if} case tp^.kind of @@ -2128,7 +2128,7 @@ var if (etype = stringTypePtr) or (etype = utf16StringTypePtr) or (etype = utf32StringTypePtr) then begin iPtr^.isConstant := true; - iPtr^.iType := ccPointer; + iPtr^.basetype := ccPointer; iPtr^.pval := 0; iPtr^.pPlus := false; iPtr^.isName := false; @@ -2137,7 +2137,7 @@ var else if etype^.kind = scalarType then if etype^.baseType in [cgByte..cgULong] then if expressionValue = 0 then - iPtr^.iType := cgULong + iPtr^.basetype := cgULong else begin Error(47); errorFound := true; @@ -2145,7 +2145,7 @@ var else if etype^.baseType in [cgQuad,cgUQuad] then if (llExpressionValue.hi = 0) and (llExpressionValue.lo = 0) then - iPtr^.iType := cgULong + iPtr^.basetype := cgULong else begin Error(47); errorFound := true; @@ -2155,7 +2155,7 @@ var errorFound := true; end {else} else if etype^.kind = pointerType then begin - iPtr^.iType := cgULong; + iPtr^.basetype := cgULong; iPtr^.pval := expressionValue; end {else if} else begin @@ -2179,7 +2179,7 @@ var or ((tp^.kind = scalarType) and (tp^.baseType in [cgLong,cgULong]))) and (bitsize = 0) then begin - iPtr^.iType := ccPointer; + iPtr^.basetype := ccPointer; if variable^.storage in [external,global,private] then begin {do pointer constants with + or -} @@ -2431,13 +2431,13 @@ var {iPtr^.isStructOrUnion := false;} if iPtr^.isConstant then begin if tp^.kind = scalarType then - iPtr^.itype := tp^.baseType + iPtr^.basetype := tp^.baseType else if tp^.kind = pointertype then begin - iPtr^.itype := cgULong; + iPtr^.basetype := cgULong; {iPtr^.iVal := 0;} end {else if} else begin - iPtr^.itype := cgWord; + iPtr^.basetype := cgWord; Error(47); errorFound := true; end; {else} @@ -2530,7 +2530,7 @@ var iPtr^.isStructOrUnion := false; if (variable^.storage in [external,global,private]) then begin iPtr^.isConstant := true; - iPtr^.itype := cgString; + iPtr^.basetype := cgString; iPtr^.sval := token.sval; count := tp^.elements - stringLength; if count > 0 then @@ -4775,7 +4775,7 @@ iPtr^.count := 1; {iPtr^.bitsize := 0;} {iPtr^.isStructOrUnion := false;} iPtr^.isConstant := true; -iPtr^.itype := cgString; +iPtr^.basetype := cgString; iPtr^.sval := sval; id^.iPtr := iPtr; diff --git a/Symbol.pas b/Symbol.pas index 6197519..ad8eeaa 100644 --- a/Symbol.pas +++ b/Symbol.pas @@ -699,17 +699,17 @@ procedure DoGlobals; Gen2Name(dc_glb, 0, ord(sp^.storage = private), sp^.name); ip := sp^.iPtr; while ip <> nil do begin - case ip^.itype of + case ip^.basetype of cgByte,cgUByte,cgWord,cgUWord: begin lval := ip^.ival; - Gen2t(dc_cns, long(lval).lsw, ip^.count, ip^.itype); + Gen2t(dc_cns, long(lval).lsw, ip^.count, ip^.basetype); end; cgLong,cgULong: GenL1(dc_cns, ip^.ival, ip^.count); cgQuad,cgUQuad: GenQ1(dc_cns, ip^.qval, ip^.count); cgReal,cgDouble,cgComp,cgExtended: - GenR1t(dc_cns, ip^.rval, ip^.count, ip^.itype); + GenR1t(dc_cns, ip^.rval, ip^.count, ip^.basetype); cgString: GenS(dc_cns, ip^.sval); ccPointer: begin @@ -790,17 +790,17 @@ procedure DoGlobals; if sp^.state = initialized then begin Gen2Name(dc_glb, 0, ord(sp^.storage = private), sp^.name); ip := sp^.iPtr; - case ip^.itype of + case ip^.basetype of cgByte,cgUByte,cgWord,cgUWord: begin lval := ip^.ival; - Gen2t(dc_cns, long(lval).lsw, 1, ip^.itype); + Gen2t(dc_cns, long(lval).lsw, 1, ip^.basetype); end; cgLong,cgULong: GenL1(dc_cns, ip^.ival, 1); cgQuad,cgUQuad: GenQ1(dc_cns, ip^.qval, 1); cgReal,cgDouble,cgComp,cgExtended: - GenR1t(dc_cns, ip^.rval, 1, ip^.itype); + GenR1t(dc_cns, ip^.rval, 1, ip^.basetype); cgString: GenS(dc_cns, ip^.sval); ccPointer: begin From cd9931a60c2dce731a3dc5afcbd416d638152fe0 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Sat, 26 Nov 2022 19:27:17 -0600 Subject: [PATCH 03/39] Record displacement from start of object in initializer records. The idea (not yet implemented) is to use this to support out-of-order initialization. For automatic variables, we can just initialize the subobjects in the order that initializers appear. For static variables, we will eventually need to reorder the initializers in order, but this can be done based on their recorded displacements. --- CCommon.pas | 1 + Parser.pas | 58 ++++++++++++++++++++++++++++++++++++++--------------- 2 files changed, 43 insertions(+), 16 deletions(-) diff --git a/CCommon.pas b/CCommon.pas index 68638a8..fff416c 100644 --- a/CCommon.pas +++ b/CCommon.pas @@ -321,6 +321,7 @@ type initializerPtr = ^initializerRecord; {initializers} initializerRecord = record next: initializerPtr; {next record in the chain} + disp: longint; {disp within overall object being initialized} count: integer; {# of duplicate records} bitdisp: integer; {disp in byte (field lists only)} bitsize: integer; {width in bits; 0 for byte sizes} diff --git a/Parser.pas b/Parser.pas index ab4fc3e..16f861f 100644 --- a/Parser.pas +++ b/Parser.pas @@ -1856,6 +1856,7 @@ procedure Initializer (var variable: identPtr); var bitcount: integer; {# if bits initialized} bitvalue: longint; {bit field initializer value} + disp: longint; {disp within overall object being initialized} done: boolean; {for loop termination} errorFound: boolean; {used to remove bad initializations} iPtr,jPtr,kPtr: initializerPtr; {for reversing the list} @@ -1863,6 +1864,23 @@ var luseGlobalPool: boolean; {local copy of useGlobalPool} + procedure InsertInitializerRecord (iPtr: initializerPtr; size: longint); + + { Insert an initializer record in the initializer list } + { } + { parameters: } + { iPtr - the record to insert } + { size - number of bytes initialized by this record } + + begin {InsertInitializerRecord} + iPtr^.disp := disp; + iPtr^.next := variable^.iPtr; + variable^.iPtr := iPtr; +{ writeln('Inserted initializer record with size ', size:1, ' at disp ', disp:1); {debug} + disp := disp + size; + end; {InsertInitializerRecord} + + procedure InitializeBitField; { If bit fields have been initialized, fill them in } @@ -1879,8 +1897,6 @@ var { writeln('InitializeBitField; bitcount = ', bitcount:1); {debug} {create the initializer entry} iPtr := pointer(Malloc(sizeof(initializerRecord))); - iPtr^.next := variable^.iPtr; - variable^.iPtr := iPtr; iPtr^.isConstant := isConstant; iPtr^.count := 1; iPtr^.bitdisp := 0; @@ -1889,12 +1905,12 @@ var iPtr^.iVal := bitvalue; if bitcount <= 8 then iPtr^.basetype := cgUByte - else if bitcount <= 16 then + else if bitcount <= 24 then iPtr^.basetype := cgUWord - else if bitcount > 24 then - iPtr^.basetype := cgULong - else begin {3-byte bitfield: split into two parts} - iPtr^.basetype := cgUWord; + else + iPtr^.basetype := cgULong; + InsertInitializerRecord(iPtr, TypeSize(iPtr^.basetype)); + if bitcount in [17..24] then begin {3-byte bitfield: split into two parts} iPtr^.iVal := bitvalue & $0000FFFF; bitcount := bitcount - 16; bitvalue := bitvalue >> 16; @@ -2042,8 +2058,7 @@ var Expression(initializerExpression, [commach,rparench,rbracech]); if bitsize = 0 then begin iPtr := pointer(Malloc(sizeof(initializerRecord))); - iPtr^.next := variable^.iPtr; - variable^.iPtr := iPtr; + InsertInitializerRecord(iPtr, tp^.size); iPtr^.isConstant := isConstant; iPtr^.count := 1; iPtr^.bitdisp := 0; @@ -2320,8 +2335,7 @@ var {handle auto variables} if bitsize <> 0 then begin iPtr := pointer(Malloc(sizeof(initializerRecord))); - iPtr^.next := variable^.iPtr; - variable^.iPtr := iPtr; + InsertInitializerRecord(iPtr, 0); {TODO should size be 0?} iPtr^.isConstant := isConstant; iPtr^.count := 1; iPtr^.bitdisp := bitdisp; @@ -2367,6 +2381,7 @@ var ktp: typePtr; {array type with definedTypes removed} lSuppressMacroExpansions: boolean;{local copy of suppressMacroExpansions} skipToNext: boolean; {skip to next array/struct element?} + startingDisp: longint; {disp at start of this term} stringElementType: typePtr; {element type of string literal} stringLength: integer; {elements in a string literal} @@ -2423,8 +2438,6 @@ var {fill a single value} while count <> 0 do begin iPtr := pointer(Calloc(sizeof(initializerRecord))); - iPtr^.next := variable^.iPtr; - variable^.iPtr := iPtr; iPtr^.isConstant := variable^.storage in [external,global,private]; {iPtr^.bitdisp := 0;} {iPtr^.bitsize := 0;} @@ -2461,6 +2474,7 @@ var iPtr^.count := 16384; count := count-16384; end; {else} + InsertInitializerRecord(iPtr, tp^.size * iPtr^.count); end; {while} end; {Fill} @@ -2498,6 +2512,7 @@ var {TODO fill?} goto 1; end; {if} + startingDisp := disp; if kind = arrayType then begin ktp := tp^.atype; while ktp^.kind = definedType do @@ -2522,13 +2537,12 @@ var end; {else if} with ktp^ do begin iPtr := pointer(Malloc(sizeof(initializerRecord))); - iPtr^.next := variable^.iPtr; - variable^.iPtr := iPtr; iPtr^.count := 1; iPtr^.bitdisp := 0; iPtr^.bitsize := 0; iPtr^.isStructOrUnion := false; if (variable^.storage in [external,global,private]) then begin + InsertInitializerRecord(iPtr, token.sval^.length); iPtr^.isConstant := true; iPtr^.basetype := cgString; iPtr^.sval := token.sval; @@ -2543,6 +2557,8 @@ var end; {else if} end {if} else begin + InsertInitializerRecord(iPtr, + tp^.elements * stringElementType^.size); iPtr^.isConstant := false; new(ep); iPtr^.iTree := ep; @@ -2573,8 +2589,10 @@ var Error(183); count := 0; end {if} - else + else begin count := expressionValue; + disp := startingDisp + count * ktp^.size; + end; {else} Match(rbrackch, 24); {TODO if first designator (or expanding array size) and not nestedDesignator then fill in rest with zeros} if token.kind in [dotch,lbrackch] then begin @@ -2647,6 +2665,7 @@ var bitCount := (bitCount+7) div 8; count := count-bitCount; bitCount := 0; + disp := startingDisp + tp^.size - count; end; {if} InitializeTerm(ip^.itype, ip^.bitsize, ip^.bitdisp, false, false); if ip^.bitSize <> 0 then begin @@ -2679,6 +2698,7 @@ var bitCount := (bitCount+7) div 8; count := count-bitCount; bitCount := 0; + disp := startingDisp + tp^.size - count; end; {if} if count > 0 then if variable^.storage in [external,global,private] then @@ -2717,6 +2737,7 @@ var begin {Initializer} bitcount := 0; {set up for bit fields} bitvalue := 0; +disp := 0; {start at beginning of the object} errorFound := false; {no errors found so far} luseGlobalPool := useGlobalPool; {use global memory for global vars} useGlobalPool := (variable^.storage in [external,global,private]) @@ -4489,6 +4510,11 @@ var begin {Initialize} + if disp <> iptr^.disp then + if count = iptr^.count then begin + writeln('Mismatched disp from ',id^.name^,': ', iptr^.disp:1, ' vs ', disp:1); + Error(57); + end; {debug} while itype^.kind = definedType do itype := itype^.dType; case itype^.kind of From d1edc8821d913a26df805b5fc92302f6ef723459 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Sat, 26 Nov 2022 19:58:01 -0600 Subject: [PATCH 04/39] Record the type being initialized in auto initializer records. --- CCommon.pas | 5 ++++- Parser.pas | 7 +++++++ 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/CCommon.pas b/CCommon.pas index fff416c..7509810 100644 --- a/CCommon.pas +++ b/CCommon.pas @@ -327,7 +327,10 @@ type bitsize: integer; {width in bits; 0 for byte sizes} isStructOrUnion: boolean; {is this a struct or union initializer?} case isConstant: boolean of {is this a constant initializer?} - false: (iTree: tokenPtr); + false: ( + iType: typePtr; {type being initialized} + iTree: tokenPtr; {initializer expression} + ); true : ( {Note: qVal.lo must overlap iVal} case basetype: baseTypeEnum of cgByte, diff --git a/Parser.pas b/Parser.pas index 16f861f..f449371 100644 --- a/Parser.pas +++ b/Parser.pas @@ -2348,6 +2348,7 @@ var end; {else} iPtr^.isConstant := false; iPtr^.iTree := initializerTree; + iPtr^.iType := tp; iPtr^.bitdisp := bitdisp; iPtr^.bitsize := bitsize; end; {else} @@ -2465,6 +2466,7 @@ var tk^.token.class := intConstant; tk^.token.ival := 0; iPtr^.iTree := tk; + iPtr^.iType := tp; end; {else} if count < 16384 then begin iPtr^.count := long(count).lsw; @@ -2562,6 +2564,7 @@ var iPtr^.isConstant := false; new(ep); iPtr^.iTree := ep; + iPtr^.iType := tp; ep^.next := nil; ep^.left := nil; ep^.middle := nil; @@ -4520,6 +4523,10 @@ var case itype^.kind of scalarType,pointerType,enumType,functionType: begin + if not CompTypes(itype, iptr^.itype) then begin + writeln('Incompatible initializer type'); + Error(57); + end; {debug} tree := iptr^.itree; if tree = nil then goto 2; {don't generate code in error case} LoadAddress; {load the destination address} From 968844fb38c4f98864720f0305ca1e0e2918e728 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Sat, 26 Nov 2022 20:24:33 -0600 Subject: [PATCH 05/39] Make auto initialization use the type and disp in initializer record. This simplifies the code a good bit, as well as enabling out-of-order initialization using designated initializers. --- Parser.pas | 140 +++++++---------------------------------------------- 1 file changed, 17 insertions(+), 123 deletions(-) diff --git a/Parser.pas b/Parser.pas index f449371..a3b626e 100644 --- a/Parser.pas +++ b/Parser.pas @@ -4420,32 +4420,24 @@ var ldoDispose: boolean; {local copy of doDispose} - procedure Initialize (id: identPtr; disp: longint; itype: typePtr); + procedure Initialize (id: identPtr); - { initialize a variable } + { initialize (part of) a variable using the initializer iPtr } { } { parameters: } { id - pointer to the identifier } - { disp - disp past the identifier to initialize } - { itype - type of the variable to initialize } { } { variables: } { count - number of times to re-use the initializer } - { ip - pointer to the initializer record to use } + { iPtr - pointer to the initializer record to use } label 1,2; var + disp: longint; {displacement to initialize at} elements: longint; {# array elements} - fp: identPtr; {for tracing field lists} + itype: typePtr; {the type being initialized} size: integer; {fill size} - union: boolean; {are we doing a union?} - startDisp,endDisp: longint; {disp at start/end of struct/union} - - {bit field manipulation} - {----------------------} - bitcount: integer; {# if bits so far} - bitsize,bitdisp: integer; {defines size, location of a bit field} {assignment conversion} {---------------------} @@ -4513,20 +4505,13 @@ var begin {Initialize} - if disp <> iptr^.disp then - if count = iptr^.count then begin - writeln('Mismatched disp from ',id^.name^,': ', iptr^.disp:1, ' vs ', disp:1); - Error(57); - end; {debug} + itype := iPtr^.iType; + disp := iPtr^.disp; while itype^.kind = definedType do itype := itype^.dType; case itype^.kind of scalarType,pointerType,enumType,functionType: begin - if not CompTypes(itype, iptr^.itype) then begin - writeln('Incompatible initializer type'); - Error(57); - end; {debug} tree := iptr^.itree; if tree = nil then goto 2; {don't generate code in error case} LoadAddress; {load the destination address} @@ -4612,52 +4597,10 @@ var if isCompoundLiteral then AddOperation; end; {if} - iPtr := iPtr^.next; - goto 1; end; {if} - itype := itype^.atype; - if ZeroFill(elements, itype, count, iPtr) then begin - if itype^.kind = enumType then - size := cgWordSize - else - size := TypeSize(itype^.baseType); - size := size * long(elements).lsw; - LoadAddress; - Gen0t(pc_stk, cgULong); - Gen1t(pc_ldc, size, cgWord); - Gen0t(pc_stk, cgWord); - Gen0t(pc_bno, cgULong); - Gen1tName(pc_cup, -1, cgVoid, @'~ZERO'); - if isCompoundLiteral then - AddOperation; - disp := disp + size; - count := count - long(elements).lsw; - if count = 0 then begin - iPtr := iPtr^.next; - if iPtr <> nil then - count := iPtr^.count; - end; {if} - end {if} - else begin - while elements <> 0 do begin - Initialize(id, disp, itype); - if itype^.kind in [scalarType,pointerType,enumType] then begin - count := count-1; - if count = 0 then begin - iPtr := iPtr^.next; - if iPtr <> nil then - count := iPtr^.count; - end; {if} - end; {if} - disp := disp+itype^.size; - elements := elements-1; - end; {while} - end; {else} 1: end; structType,unionType: begin - startDisp := disp; - endDisp := disp + itype^.size; if iPtr^.isStructOrUnion then begin LoadAddress; {load the destination address} GenerateCode(iptr^.iTree); {load the struct address} @@ -4669,64 +4612,7 @@ var Gen0t(pc_pop, UsualUnaryConversions); if isCompoundLiteral then AddOperation; - end {if} - else begin - union := itype^.kind = unionType; - fp := itype^.fieldList; - while fp <> nil do begin - itype := fp^.itype; - disp := startDisp + fp^.disp; - bitdisp := fp^.bitdisp; - bitsize := fp^.bitsize; -{ writeln('Initialize: disp = ', disp:3, '; fp^. Disp = ', fp^.disp:3, 'itype^.size = ', itype^.size:1); {debug} -{ writeln(' bitDisp = ', bitDisp:3, '; fp^.bitDisp = ', fp^.bitDisp:3); {debug} -{ writeln(' bitSize = ', bitSize:3, '; fp^.bitSize = ', fp^.bitSize:3); {debug} - Initialize(id, disp, itype); - if bitsize = 0 then begin - if bitcount <> 0 then begin - bitcount := 0; - end {if} - else if fp^.bitSize <> 0 then begin - bitcount := 8; - while (fp <> nil) and (bitcount > 0) do begin - bitcount := bitcount - fp^.bitSize; - if bitcount > 0 then - if fp^.next <> nil then - if fp^.next^.bitSize <> 0 then - fp := fp^.next - else - bitcount := 0; - end; {while} - bitcount := 0; - end; {else if} - end {if} - else if fp^.bitSize = 0 then begin - bitsize := 0; - end {else if} - else begin - bitcount := bitsize + bitdisp; - end; {else} - if itype^.kind in [scalarType,pointerType,enumType] then begin - count := count-1; - if count = 0 then begin - iPtr := iPtr^.next; - if iPtr <> nil then begin - count := iPtr^.count; - bitsize := iPtr^.bitsize; - bitdisp := iPtr^.bitdisp; - end; {if} - end; {if} - end; {if} - if union then - fp := nil - else begin - fp := fp^.next; - while (fp <> nil) and fp^.anonMemberField do - fp := fp^.next; - end; {else} - end; {while} - end; {else} - disp := endDisp; + end; {if} end; otherwise: Error(57); @@ -4750,7 +4636,15 @@ if variable^.class <> staticsy then begin if (statementList <> nil) and not statementList^.doingDeclaration then if lineNumber <> 0 then RecordLineNumber(line); - Initialize(variable, 0, variable^.itype); + while iPtr <> nil do begin + Initialize(variable); + if count = 1 then begin + iPtr := iPtr^.next; + count := iPtr^.count; + end {if} + else + count := count - 1; + end; {while} end; {if} if isCompoundLiteral then begin while treeCount > 1 do begin From 5f8a6baa94fe90cdb9438b4e33938b30860bfcef Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Sat, 26 Nov 2022 20:29:31 -0600 Subject: [PATCH 06/39] Get rid of an unnecessary field in initializer records. The "isStructOrUnion" information can now be determined simply by the type in the record. --- CCommon.pas | 1 - Parser.pas | 32 +++++++++++--------------------- 2 files changed, 11 insertions(+), 22 deletions(-) diff --git a/CCommon.pas b/CCommon.pas index 7509810..af35a38 100644 --- a/CCommon.pas +++ b/CCommon.pas @@ -325,7 +325,6 @@ type count: integer; {# of duplicate records} bitdisp: integer; {disp in byte (field lists only)} bitsize: integer; {width in bits; 0 for byte sizes} - isStructOrUnion: boolean; {is this a struct or union initializer?} case isConstant: boolean of {is this a constant initializer?} false: ( iType: typePtr; {type being initialized} diff --git a/Parser.pas b/Parser.pas index a3b626e..5464e2a 100644 --- a/Parser.pas +++ b/Parser.pas @@ -1901,7 +1901,6 @@ var iPtr^.count := 1; iPtr^.bitdisp := 0; iPtr^.bitsize := 0; - iPtr^.isStructOrUnion := false; iPtr^.iVal := bitvalue; if bitcount <= 8 then iPtr^.basetype := cgUByte @@ -2063,7 +2062,6 @@ var iPtr^.count := 1; iPtr^.bitdisp := 0; iPtr^.bitsize := 0; - iPtr^.isStructOrUnion := false; end; {if} etype := expressionType; AssignmentConversion(tp, expressionType, isConstant, expressionValue, @@ -2328,9 +2326,7 @@ var DisposeTree(initializerTree); goto 1; end; {if} - end {if} - else if tp^.kind in [structType,unionType] then - iPtr^.isStructOrUnion := true; + end; {if} {handle auto variables} if bitsize <> 0 then begin @@ -2340,7 +2336,6 @@ var iPtr^.count := 1; iPtr^.bitdisp := bitdisp; iPtr^.bitsize := bitsize; - iPtr^.isStructOrUnion := false; end; {if} if variable^.storage in [external,global,private] then begin Error(41); @@ -2442,7 +2437,6 @@ var iPtr^.isConstant := variable^.storage in [external,global,private]; {iPtr^.bitdisp := 0;} {iPtr^.bitsize := 0;} - {iPtr^.isStructOrUnion := false;} if iPtr^.isConstant then begin if tp^.kind = scalarType then iPtr^.basetype := tp^.baseType @@ -2542,7 +2536,6 @@ var iPtr^.count := 1; iPtr^.bitdisp := 0; iPtr^.bitsize := 0; - iPtr^.isStructOrUnion := false; if (variable^.storage in [external,global,private]) then begin InsertInitializerRecord(iPtr, token.sval^.length); iPtr^.isConstant := true; @@ -4601,19 +4594,17 @@ var 1: end; structType,unionType: begin - if iPtr^.isStructOrUnion then begin - LoadAddress; {load the destination address} - GenerateCode(iptr^.iTree); {load the struct address} + LoadAddress; {load the destination address} + GenerateCode(iptr^.iTree); {load the struct address} {do the assignment} - AssignmentConversion(itype, expressionType, isConstant, val, - true, false); - with expressionType^ do - Gen2(pc_mov, long(size).msw, long(size).lsw); - Gen0t(pc_pop, UsualUnaryConversions); - if isCompoundLiteral then - AddOperation; - end; {if} - end; + AssignmentConversion(itype, expressionType, isConstant, val, + true, false); + with expressionType^ do + Gen2(pc_mov, long(size).msw, long(size).lsw); + Gen0t(pc_pop, UsualUnaryConversions); + if isCompoundLiteral then + AddOperation; + end; {if} otherwise: Error(57); end; {case} @@ -4700,7 +4691,6 @@ iPtr := pointer(GCalloc(sizeof(initializerRecord))); iPtr^.count := 1; {iPtr^.bitdisp := 0;} {iPtr^.bitsize := 0;} -{iPtr^.isStructOrUnion := false;} iPtr^.isConstant := true; iPtr^.basetype := cgString; iPtr^.sval := sval; From 335e8be75e1f005341220356f27c86b677b38365 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Sat, 26 Nov 2022 20:37:13 -0600 Subject: [PATCH 07/39] Rename the procedure for initializing one element of an auto variable. "InitializeOneElement" is more descriptive of what it does now. We also skip passing the variable, which is always the same. --- Parser.pas | 16 +++++++--------- 1 file changed, 7 insertions(+), 9 deletions(-) diff --git a/Parser.pas b/Parser.pas index 5464e2a..3b0290d 100644 --- a/Parser.pas +++ b/Parser.pas @@ -4413,14 +4413,12 @@ var ldoDispose: boolean; {local copy of doDispose} - procedure Initialize (id: identPtr); + procedure InitializeOneElement; { initialize (part of) a variable using the initializer iPtr } { } - { parameters: } - { id - pointer to the identifier } - { } { variables: } + { variable - the variable to initialize } { count - number of times to re-use the initializer } { iPtr - pointer to the initializer record to use } @@ -4444,8 +4442,8 @@ var { Load the address of the operand } begin {LoadAddress} - if id^.storage = stackFrame then - Gen2(pc_lda, id^.lln, ord(disp)) + if variable^.storage = stackFrame then + Gen2(pc_lda, variable^.lln, ord(disp)) else Error(57); end; {LoadAddress} @@ -4497,7 +4495,7 @@ var end; {AddOperation} - begin {Initialize} + begin {InitializeOneElement} itype := iPtr^.iType; disp := iPtr^.disp; while itype^.kind = definedType do @@ -4608,7 +4606,7 @@ var otherwise: Error(57); end; {case} - end; {Initialize} + end; {InitializeOneElement} begin {AutoInit} @@ -4628,7 +4626,7 @@ if variable^.class <> staticsy then begin if lineNumber <> 0 then RecordLineNumber(line); while iPtr <> nil do begin - Initialize(variable); + InitializeOneElement; if count = 1 then begin iPtr := iPtr^.next; count := iPtr^.count; From 5df94c953e41211ffd6b793b48ec904a1affeb9c Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Sat, 26 Nov 2022 21:09:53 -0600 Subject: [PATCH 08/39] Fix handling of initializer counts in AutoInit. This was broken by the previous changes to it. --- Parser.pas | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/Parser.pas b/Parser.pas index 3b0290d..267bb28 100644 --- a/Parser.pas +++ b/Parser.pas @@ -4406,7 +4406,6 @@ procedure AutoInit {variable: identPtr; line: longint; { isCompoundLiteral - initializing a compound literal? } var - count: integer; {initializer counter} iPtr: initializerPtr; {pointer to the next initializer} codeCount: longint; {number of initializer expressions} treeCount: integer; {current number of distinct trees} @@ -4422,9 +4421,10 @@ var { count - number of times to re-use the initializer } { iPtr - pointer to the initializer record to use } - label 1,2; + label 1,2,3; var + count: integer; {initializer counter} disp: longint; {displacement to initialize at} elements: longint; {# array elements} itype: typePtr; {the type being initialized} @@ -4498,9 +4498,10 @@ var begin {InitializeOneElement} itype := iPtr^.iType; disp := iPtr^.disp; + count := iPtr^.count; while itype^.kind = definedType do itype := itype^.dType; - case itype^.kind of +3: case itype^.kind of scalarType,pointerType,enumType,functionType: begin tree := iptr^.itree; @@ -4606,12 +4607,16 @@ var otherwise: Error(57); end; {case} + if count <> 1 then begin + count := count - 1; + disp := disp + itype^.size; + goto 3; + end; {if} end; {InitializeOneElement} begin {AutoInit} iPtr := variable^.iPtr; -count := iPtr^.count; if isCompoundLiteral then begin treeCount := 0; codeCount := 0; @@ -4627,12 +4632,7 @@ if variable^.class <> staticsy then begin RecordLineNumber(line); while iPtr <> nil do begin InitializeOneElement; - if count = 1 then begin - iPtr := iPtr^.next; - count := iPtr^.count; - end {if} - else - count := count - 1; + iPtr := iPtr^.next; end; {while} end; {if} if isCompoundLiteral then begin From aa6b82a136486c4f70b03fb4f8538a5de9e3fe9f Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Sat, 26 Nov 2022 23:03:20 -0600 Subject: [PATCH 09/39] Ensure array designators are processed at the level with braces. --- Parser.pas | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/Parser.pas b/Parser.pas index 267bb28..edd2426 100644 --- a/Parser.pas +++ b/Parser.pas @@ -1862,6 +1862,7 @@ var iPtr,jPtr,kPtr: initializerPtr; {for reversing the list} ip: identList; {used to place an id in the list} luseGlobalPool: boolean; {local copy of useGlobalPool} + skipComma: boolean; {skip an expected comma} procedure InsertInitializerRecord (iPtr: initializerPtr; size: longint); @@ -2506,6 +2507,7 @@ var if token.kind in [dotch,lbrackch] then if not (braces or nestedDesignator) then begin {TODO fill?} + skipComma := true; goto 1; end; {if} startingDisp := disp; @@ -2578,6 +2580,10 @@ var repeat skipToNext := false; if token.kind = lbrackch then begin + if not (braces or nestedDesignator) then begin + skipComma := true; + goto 1; + end; {if} NextToken; Expression(arrayExpression, [rbrackch]); if (expressionValue < 0) @@ -2603,8 +2609,11 @@ var count := count+1; if (count = maxCount) and not braces then done := true - else if token.kind = commach then begin - NextToken; + else if (token.kind = commach) or skipComma then begin + if skipComma then + skipComma := false + else + NextToken; done := token.kind = rbracech; if not done then if count = maxCount then @@ -2735,6 +2744,7 @@ bitcount := 0; {set up for bit fields} bitvalue := 0; disp := 0; {start at beginning of the object} errorFound := false; {no errors found so far} +skipComma := false; luseGlobalPool := useGlobalPool; {use global memory for global vars} useGlobalPool := (variable^.storage in [external,global,private]) or useGlobalPool; From 58d8edf1eee19cb474f2c8c32ae16891bf5addfc Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Sun, 27 Nov 2022 16:48:58 -0600 Subject: [PATCH 10/39] Handle filling of array elements without explicit initializers. At this point, designated initializers for arrays are at least largely working. --- Parser.pas | 47 ++++++++++++++++++++++++++++++++++------------- 1 file changed, 34 insertions(+), 13 deletions(-) diff --git a/Parser.pas b/Parser.pas index edd2426..1cf9ed6 100644 --- a/Parser.pas +++ b/Parser.pas @@ -2372,11 +2372,14 @@ var braces: boolean; {is the initializer inclosed in braces?} count,maxCount: longint; {for tracking the size of an initializer} ep: tokenPtr; {for forming string expression} + fillSize: longint; {size to fill with zeros} iPtr: initializerPtr; {for creating an initializer entry} ip: identPtr; {for tracing field lists} kind: typeKind; {base type of an initializer} ktp: typePtr; {array type with definedTypes removed} lSuppressMacroExpansions: boolean;{local copy of suppressMacroExpansions} + maxDisp: longint; {maximum disp value so far} + newDisp: longint; {new disp set by a designator} skipToNext: boolean; {skip to next array/struct element?} startingDisp: longint; {disp at start of this term} stringElementType: typePtr; {element type of string literal} @@ -2576,27 +2579,40 @@ var begin count := 0; {get the expressions|initializers} maxCount := tp^.elements; + maxDisp := disp; if token.kind <> rbracech then repeat skipToNext := false; if token.kind = lbrackch then begin - if not (braces or nestedDesignator) then begin + if not (braces or (nestedDesignator and (disp=startingDisp))) + then begin skipComma := true; goto 1; end; {if} NextToken; Expression(arrayExpression, [rbrackch]); if (expressionValue < 0) - or ((maxCount <> 0) and (expressionValue >= maxCount)) then begin + or ((maxCount <> 0) and (expressionValue >= maxCount)) then + begin Error(183); count := 0; end {if} else begin count := expressionValue; - disp := startingDisp + count * ktp^.size; end; {else} Match(rbrackch, 24); - {TODO if first designator (or expanding array size) and not nestedDesignator then fill in rest with zeros} + newDisp := startingDisp + count * ktp^.size; + if not nestedDesignator then begin + fillSize := newDisp - maxDisp; + if token.kind in [lbrackch,dotch] then + fillSize := fillSize + ktp^.size; + if fillSize > 0 then begin + disp := maxDisp; + Fill(fillSize, charPtr); + maxDisp := disp; + end; {if} + end; {if} + disp := newDisp; if token.kind in [dotch,lbrackch] then begin InitializeTerm(ktp, 0, 0, false, true); skipToNext := true; @@ -2606,6 +2622,8 @@ var end; {if} if not skipToNext then InitializeTerm(ktp, 0, 0, false, false); + if disp > maxDisp then + maxDisp := disp; count := count+1; if (count = maxCount) and not braces then done := true @@ -2625,16 +2643,19 @@ var else done := true; until done or (token.kind = eofsy); - if maxCount <> 0 then begin - count := maxCount-count; - if count <> 0 then {if there weren't enough initializers...} - if not nestedDesignator then - Fill(count,ktp); { fill in the blank spots} - end {if} - else begin - tp^.elements := count; {set the array size} + if maxCount = 0 then begin {set the array size} + maxCount := (maxDisp - startingDisp + ktp^.size - 1) div ktp^.size; + tp^.elements := maxCount; RecomputeSizes(variable^.itype); - end; {else} + end; {if} + if not nestedDesignator then begin + disp := startingDisp + maxCount * ktp^.size; + if disp > maxDisp then begin {if there weren't enough initializers...} + fillSize := disp - maxDisp; + disp := maxDisp; + Fill(fillSize, charPtr); { fill in the blank spots} + end; {if} + end; {if} end {else if} else begin From 6260a27b117cbe2a433cb57c0989e889d7d366a5 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Sun, 27 Nov 2022 16:49:43 -0600 Subject: [PATCH 11/39] Use 16-bit operations to zero out a range of bytes. --- Parser.pas | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/Parser.pas b/Parser.pas index 1cf9ed6..cbabd9c 100644 --- a/Parser.pas +++ b/Parser.pas @@ -4527,12 +4527,12 @@ var begin {InitializeOneElement} - itype := iPtr^.iType; disp := iPtr^.disp; count := iPtr^.count; +3: itype := iPtr^.iType; while itype^.kind = definedType do itype := itype^.dType; -3: case itype^.kind of + case itype^.kind of scalarType,pointerType,enumType,functionType: begin tree := iptr^.itree; @@ -4557,6 +4557,14 @@ var else isConstant := false; end; {else} + + if isConstant then {zero-initialize two bytes at a time} + if val = 0 then + if count > 1 then + if itype^.size = 1 then begin + itype := shortPtr; + count := count - 1; + end; {if} { if isConstant then if tree^.token.class = intConstant then From def9e56e8e0ec17c3b873d589b02d5719f3e4e2a Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Sun, 27 Nov 2022 17:30:36 -0600 Subject: [PATCH 12/39] Fill logic for when to fill uninitialized data with zeros. This could maybe be simplified to just fill on levels with braces, but I want to consider that after implementing designated initializers for structs and unions. --- Parser.pas | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/Parser.pas b/Parser.pas index cbabd9c..9c83c31 100644 --- a/Parser.pas +++ b/Parser.pas @@ -2353,7 +2353,7 @@ var procedure InitializeTerm (tp: typePtr; bitsize,bitdisp: integer; - main, nestedDesignator: boolean); + main, nestedDesignator, noFill: boolean); { initialize one level of the type } { } @@ -2364,6 +2364,7 @@ var { main - is this a call from the main level? } { nestedDesignator - handling second or later level of } { designator in a designator list? } + { noFill - if set, do not fill empty space with zeros } label 1; @@ -2380,6 +2381,7 @@ var lSuppressMacroExpansions: boolean;{local copy of suppressMacroExpansions} maxDisp: longint; {maximum disp value so far} newDisp: longint; {new disp set by a designator} + setNoFill: boolean; {set noFill on recursive calls?} skipToNext: boolean; {skip to next array/struct element?} startingDisp: longint; {disp at start of this term} stringElementType: typePtr; {element type of string literal} @@ -2499,6 +2501,7 @@ var if token.kind = lbracech then begin NextToken; braces := true; + noFill := false; end; {if} {handle arrays} @@ -2514,6 +2517,7 @@ var goto 1; end; {if} startingDisp := disp; + setNoFill := noFill; if kind = arrayType then begin ktp := tp^.atype; while ktp^.kind = definedType do @@ -2602,7 +2606,7 @@ var end; {else} Match(rbrackch, 24); newDisp := startingDisp + count * ktp^.size; - if not nestedDesignator then begin + if not noFill then begin fillSize := newDisp - maxDisp; if token.kind in [lbrackch,dotch] then fillSize := fillSize + ktp^.size; @@ -2612,16 +2616,17 @@ var maxDisp := disp; end; {if} end; {if} + setNoFill := true; disp := newDisp; if token.kind in [dotch,lbrackch] then begin - InitializeTerm(ktp, 0, 0, false, true); + InitializeTerm(ktp, 0, 0, false, true, true); skipToNext := true; end {if} else Match(eqch, 182); end; {if} if not skipToNext then - InitializeTerm(ktp, 0, 0, false, false); + InitializeTerm(ktp, 0, 0, false, false, setNoFill); if disp > maxDisp then maxDisp := disp; count := count+1; @@ -2648,7 +2653,7 @@ var tp^.elements := maxCount; RecomputeSizes(variable^.itype); end; {if} - if not nestedDesignator then begin + if not noFill then begin disp := startingDisp + maxCount * ktp^.size; if disp > maxDisp then begin {if there weren't enough initializers...} fillSize := disp - maxDisp; @@ -2693,7 +2698,8 @@ var bitCount := 0; disp := startingDisp + tp^.size - count; end; {if} - InitializeTerm(ip^.itype, ip^.bitsize, ip^.bitdisp, false, false); + InitializeTerm(ip^.itype, ip^.bitsize, ip^.bitdisp, false, false, + setNoFill); if ip^.bitSize <> 0 then begin bitCount := bitCount + ip^.bitSize; if bitCount > maxBitField then begin @@ -2775,7 +2781,7 @@ if not (token.kind in [lbracech,stringConst]) then Error(27); errorFound := true; end; {if} -InitializeTerm(variable^.itype, 0, 0, true, false); {do the initialization} +InitializeTerm(variable^.itype, 0, 0, true, false, false); {do the initialization} variable^.state := initialized; {mark the variable as initialized} iPtr := variable^.iPtr; {reverse the initializer list} jPtr := nil; From 250a6361c19d9ddb197d17f6ddc2c56ac1a25a70 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Sun, 27 Nov 2022 23:20:52 -0600 Subject: [PATCH 13/39] Basic code to handle struct/union designators. This does not deal with filling yet. --- Parser.pas | 85 ++++++++++++++++++++++++++++++++++++------------------ 1 file changed, 57 insertions(+), 28 deletions(-) diff --git a/Parser.pas b/Parser.pas index 9c83c31..ef8b296 100644 --- a/Parser.pas +++ b/Parser.pas @@ -2366,7 +2366,7 @@ var { designator in a designator list? } { noFill - if set, do not fill empty space with zeros } - label 1; + label 1,2; var bitCount: integer; {# of bits in a union} @@ -2374,6 +2374,7 @@ var count,maxCount: longint; {for tracking the size of an initializer} ep: tokenPtr; {for forming string expression} fillSize: longint; {size to fill with zeros} + hasNestedDesignator: boolean; {nested designator in current designation?} iPtr: initializerPtr; {for creating an initializer entry} ip: identPtr; {for tracing field lists} kind: typeKind; {base type of an initializer} @@ -2382,7 +2383,6 @@ var maxDisp: longint; {maximum disp value so far} newDisp: longint; {new disp set by a designator} setNoFill: boolean; {set noFill on recursive calls?} - skipToNext: boolean; {skip to next array/struct element?} startingDisp: longint; {disp at start of this term} stringElementType: typePtr; {element type of string literal} stringLength: integer; {elements in a string literal} @@ -2586,7 +2586,7 @@ var maxDisp := disp; if token.kind <> rbracech then repeat - skipToNext := false; + hasNestedDesignator := false; if token.kind = lbrackch then begin if not (braces or (nestedDesignator and (disp=startingDisp))) then begin @@ -2618,15 +2618,13 @@ var end; {if} setNoFill := true; disp := newDisp; - if token.kind in [dotch,lbrackch] then begin - InitializeTerm(ktp, 0, 0, false, true, true); - skipToNext := true; - end {if} + if token.kind in [dotch,lbrackch] then + hasNestedDesignator := true else Match(eqch, 182); end; {if} - if not skipToNext then - InitializeTerm(ktp, 0, 0, false, false, setNoFill); + InitializeTerm(ktp, 0, 0, false, hasNestedDesignator, + setNoFill or hasNestedDesignator); if disp > maxDisp then maxDisp := disp; count := count+1; @@ -2675,21 +2673,47 @@ var count := tp^.size; ip := tp^.fieldList; bitCount := 0; + maxDisp := disp; lSuppressMacroExpansions := suppressMacroExpansions; - while (ip <> nil) and (ip^.itype^.size > 0) do begin - if ip^.isForwardDeclared then + while true do begin + if (ip <> nil) and ip^.isForwardDeclared then ResolveForwardReference(ip); - if token.kind = rbracech then begin {initialize this field to 0} - suppressMacroExpansions := true; {inhibit token echo} - PutBackToken(token, false); - PutBackToken(token, false); - token.kind := intconst; - token.class := intConstant; - token.ival := 0; - PutBackToken(token, false); - token.kind := lbracech; - token.class := reservedSymbol; + if token.kind = rbracech then {fill remainder with zeros} + goto 2; + hasNestedDesignator := false; + if token.kind = dotch then begin + if not (braces or (nestedDesignator and (disp=startingDisp))) + then begin + skipComma := true; + goto 1; + end; {if} + NextToken; + if token.kind = ident then begin + ip := tp^.fieldList; + done := false; + while (ip <> nil) and not done do + if ip^.name^ = token.name^ then + done := true + else + ip := ip^.next; + if ip = nil then + Error(81); + NextToken; + {TODO if ip is an anonymous member field ...} + {TODO fill} + if token.kind in [dotch,lbrackch] then begin + hasNestedDesignator := true; + end {if} + else + Match(eqch, 182); + end {if} + else begin + Error(9); + ip := nil; + end; {else} end; {if} + if (ip = nil) or (ip^.itype^.size = 0) then + goto 2; if ip^.bitSize = 0 then if bitCount > 0 then begin InitializeBitField; @@ -2698,8 +2722,9 @@ var bitCount := 0; disp := startingDisp + tp^.size - count; end; {if} - InitializeTerm(ip^.itype, ip^.bitsize, ip^.bitdisp, false, false, - setNoFill); + disp := startingDisp + ip^.disp; + InitializeTerm(ip^.itype, ip^.bitsize, ip^.bitdisp, false, + hasNestedDesignator, setNoFill or hasNestedDesignator); if ip^.bitSize <> 0 then begin bitCount := bitCount + ip^.bitSize; if bitCount > maxBitField then begin @@ -2710,6 +2735,8 @@ var else begin count := count-ip^.itype^.size; end; {else} + if disp > maxDisp then + maxDisp := disp; { writeln('Initializer: ', ip^.bitsize:10, ip^.bitdisp:10, bitCount:10); {debug} if kind = unionType then ip := nil @@ -2718,20 +2745,22 @@ var while (ip <> nil) and ip^.anonMemberField do ip := ip^.next; end; {else} - if token.kind = commach then begin - if ip <> nil then - NextToken; - end {if} + if ((ip = nil) or (ip^.itype^.size = 0)) and not braces then + goto 2; + {TODO need other code to disallow dual commas before right brace?} + if token.kind = commach then + NextToken else if token.kind <> rbracech then ip := nil; end; {while} - if bitCount > 0 then begin +2: if bitCount > 0 then begin InitializeBitField; bitCount := (bitCount+7) div 8; count := count-bitCount; bitCount := 0; disp := startingDisp + tp^.size - count; end; {if} + {TODO fill as appropriate in auto case too} if count > 0 then if variable^.storage in [external,global,private] then Fill(count, sCharPtr); From c261e14d5622ac009549ee063b354aa8cc84ef7c Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Sun, 27 Nov 2022 23:54:24 -0600 Subject: [PATCH 14/39] Basic support for mixing array and struct designators. --- Parser.pas | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Parser.pas b/Parser.pas index ef8b296..6d14b55 100644 --- a/Parser.pas +++ b/Parser.pas @@ -2587,13 +2587,13 @@ var if token.kind <> rbracech then repeat hasNestedDesignator := false; - if token.kind = lbrackch then begin + if token.kind in [lbrackch,dotch] then begin if not (braces or (nestedDesignator and (disp=startingDisp))) then begin skipComma := true; goto 1; end; {if} - NextToken; + Match(lbrackch, 35); Expression(arrayExpression, [rbrackch]); if (expressionValue < 0) or ((maxCount <> 0) and (expressionValue >= maxCount)) then @@ -2681,13 +2681,13 @@ var if token.kind = rbracech then {fill remainder with zeros} goto 2; hasNestedDesignator := false; - if token.kind = dotch then begin + if token.kind in [dotch,lbrackch] then begin if not (braces or (nestedDesignator and (disp=startingDisp))) then begin skipComma := true; goto 1; end; {if} - NextToken; + Match(dotch, 35); if token.kind = ident then begin ip := tp^.fieldList; done := false; From adfa7c04c1e189ef680fa01c084638318bae6f14 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Mon, 28 Nov 2022 18:45:58 -0600 Subject: [PATCH 15/39] Support for filling uninitialized data in structs/unions during initialization. --- Parser.pas | 54 +++++++++++++++++++++++++++++------------------------- 1 file changed, 29 insertions(+), 25 deletions(-) diff --git a/Parser.pas b/Parser.pas index 6d14b55..df956e5 100644 --- a/Parser.pas +++ b/Parser.pas @@ -2605,10 +2605,14 @@ var count := expressionValue; end; {else} Match(rbrackch, 24); + if token.kind in [dotch,lbrackch] then + hasNestedDesignator := true + else + Match(eqch, 182); newDisp := startingDisp + count * ktp^.size; if not noFill then begin fillSize := newDisp - maxDisp; - if token.kind in [lbrackch,dotch] then + if hasNestedDesignator then fillSize := fillSize + ktp^.size; if fillSize > 0 then begin disp := maxDisp; @@ -2618,10 +2622,6 @@ var end; {if} setNoFill := true; disp := newDisp; - if token.kind in [dotch,lbrackch] then - hasNestedDesignator := true - else - Match(eqch, 182); end; {if} InitializeTerm(ktp, 0, 0, false, hasNestedDesignator, setNoFill or hasNestedDesignator); @@ -2670,7 +2670,6 @@ var {handle structures and unions} else if kind in [structType, unionType] then begin if braces or (not main) then begin - count := tp^.size; ip := tp^.fieldList; bitCount := 0; maxDisp := disp; @@ -2700,27 +2699,34 @@ var Error(81); NextToken; {TODO if ip is an anonymous member field ...} - {TODO fill} - if token.kind in [dotch,lbrackch] then begin - hasNestedDesignator := true; - end {if} + if token.kind in [dotch,lbrackch] then + hasNestedDesignator := true else Match(eqch, 182); + newDisp := startingDisp + ip^.disp; + if not noFill then begin + fillSize := newDisp - maxDisp; + if hasNestedDesignator and (ip^.bitsize = 0) then + fillSize := fillSize + ip^.itype^.size; + if fillSize > 0 then begin + disp := maxDisp; + Fill(fillSize, charPtr); + maxDisp := disp; + end; {if} + end; {if} end {if} else begin Error(9); - ip := nil; + goto 2; end; {else} end; {if} if (ip = nil) or (ip^.itype^.size = 0) then goto 2; + {TODO zero padding in bitfields} if ip^.bitSize = 0 then if bitCount > 0 then begin InitializeBitField; - bitCount := (bitCount+7) div 8; - count := count-bitCount; bitCount := 0; - disp := startingDisp + tp^.size - count; end; {if} disp := startingDisp + ip^.disp; InitializeTerm(ip^.itype, ip^.bitsize, ip^.bitdisp, false, @@ -2728,13 +2734,9 @@ var if ip^.bitSize <> 0 then begin bitCount := bitCount + ip^.bitSize; if bitCount > maxBitField then begin - count := count - (maxBitField div 8); bitCount := ip^.bitSize; end; {if} - end {if} - else begin - count := count-ip^.itype^.size; - end; {else} + end; {if} if disp > maxDisp then maxDisp := disp; { writeln('Initializer: ', ip^.bitsize:10, ip^.bitdisp:10, bitCount:10); {debug} @@ -2756,14 +2758,16 @@ var 2: if bitCount > 0 then begin InitializeBitField; bitCount := (bitCount+7) div 8; - count := count-bitCount; bitCount := 0; - disp := startingDisp + tp^.size - count; end; {if} - {TODO fill as appropriate in auto case too} - if count > 0 then - if variable^.storage in [external,global,private] then - Fill(count, sCharPtr); + if not noFill then begin + disp := startingDisp + tp^.size; + if disp > maxDisp then begin {if there weren't enough initializers...} + fillSize := disp - maxDisp; + disp := maxDisp; + Fill(fillSize, charPtr); { fill in the blank spots} + end; {if} + end; {if} suppressMacroExpansions := lSuppressMacroExpansions; end {if} else {struct/union assignment initializer} From a3c4eeb8f6371025d33cc0b5daa9cbca37ee03e2 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Mon, 28 Nov 2022 18:49:49 -0600 Subject: [PATCH 16/39] Rework bit-field initialization. This generally simplifies things, and always generates individual initializer records for each explicit initialization of a bit-field (which was previously done for automatic initialization, but not static). This should work correctly for automatic initialization, but needs corresponding code changes in GenSymbols for static initialization. --- Parser.pas | 155 ++++++++++++++--------------------------------------- 1 file changed, 39 insertions(+), 116 deletions(-) diff --git a/Parser.pas b/Parser.pas index df956e5..8667dce 100644 --- a/Parser.pas +++ b/Parser.pas @@ -1854,8 +1854,6 @@ procedure Initializer (var variable: identPtr); { variable - ptr to the identifier begin initialized } var - bitcount: integer; {# if bits initialized} - bitvalue: longint; {bit field initializer value} disp: longint; {disp within overall object being initialized} done: boolean; {for loop termination} errorFound: boolean; {used to remove bad initializations} @@ -1882,46 +1880,6 @@ var end; {InsertInitializerRecord} - procedure InitializeBitField; - - { If bit fields have been initialized, fill them in } - { } - { Inputs: } - { bitcount - # of bits initialized } - { bitvalue - value of initializer } - - var - iPtr: initializerPtr; {for creating an initializer entry} - - begin {InitializeBitField} - if bitcount <> 0 then begin {skip if there has been no initializer} -{ writeln('InitializeBitField; bitcount = ', bitcount:1); {debug} - {create the initializer entry} - iPtr := pointer(Malloc(sizeof(initializerRecord))); - iPtr^.isConstant := isConstant; - iPtr^.count := 1; - iPtr^.bitdisp := 0; - iPtr^.bitsize := 0; - iPtr^.iVal := bitvalue; - if bitcount <= 8 then - iPtr^.basetype := cgUByte - else if bitcount <= 24 then - iPtr^.basetype := cgUWord - else - iPtr^.basetype := cgULong; - InsertInitializerRecord(iPtr, TypeSize(iPtr^.basetype)); - if bitcount in [17..24] then begin {3-byte bitfield: split into two parts} - iPtr^.iVal := bitvalue & $0000FFFF; - bitcount := bitcount - 16; - bitvalue := bitvalue >> 16; - InitializeBitField; - end; - bitcount := 0; {reset the bit field values} - bitvalue := 0; - end; {if} - end; {InitializeBitField} - - procedure GetInitializerValue (tp: typePtr; bitsize,bitdisp: integer); { get the value of an initializer from a single expression } @@ -1931,10 +1889,9 @@ var { bitsize - size of bit field (0 for non-bit fields) } { bitdisp - disp of bit field; unused if bitsize = 0 } - label 1,2,3; + label 1,2; var - bitmask: longint; {used to add a value to a bit field} bKind: baseTypeEnum; {type of constant} etype: typePtr; {expression type} i: integer; {loop variable} @@ -1943,6 +1900,7 @@ var kind: tokenEnum; {kind of constant} offset, offset2: longint; {integer offset from a pointer} operator: tokenEnum; {operator for constant pointers} + size: longint; {size of item being initialized} tKind: typeKind; {type of constant} tree: tokenPtr; {for evaluating pointer constants} @@ -2056,31 +2014,30 @@ var Expression(autoInitializerExpression, [commach,rparench,rbracech]) else Expression(initializerExpression, [commach,rparench,rbracech]); - if bitsize = 0 then begin - iPtr := pointer(Malloc(sizeof(initializerRecord))); - InsertInitializerRecord(iPtr, tp^.size); - iPtr^.isConstant := isConstant; - iPtr^.count := 1; - iPtr^.bitdisp := 0; - iPtr^.bitsize := 0; - end; {if} + iPtr := pointer(Malloc(sizeof(initializerRecord))); + if bitsize <> 0 then + size := (bitdisp + bitsize + 7) div 8 + else + size := tp^.size; + InsertInitializerRecord(iPtr, size); + iPtr^.isConstant := isConstant; + iPtr^.count := 1; + iPtr^.bitdisp := bitdisp; + iPtr^.bitsize := bitsize; etype := expressionType; AssignmentConversion(tp, expressionType, isConstant, expressionValue, false, false); if variable^.storage = external then variable^.storage := global; if isConstant and (variable^.storage in [external,global,private]) then begin - if bitsize = 0 then begin - if etype^.baseType in [cgQuad,cgUQuad] then begin - iPtr^.qVal := llExpressionValue; - end {if} - else begin - iPtr^.qval.hi := 0; - iPtr^.iVal := expressionValue; - end; {else} - iPtr^.basetype := tp^.baseType; - InitializeBitField; - end; {if} + if etype^.baseType in [cgQuad,cgUQuad] then begin + iPtr^.qVal := llExpressionValue; + end {if} + else begin + iPtr^.qval.hi := 0; + iPtr^.iVal := expressionValue; + end; {else} + iPtr^.basetype := tp^.baseType; case tp^.kind of scalarType: begin @@ -2099,7 +2056,7 @@ var iPtr^.qVal.hi := -1 else iPtr^.qVal.hi := 0; - goto 3; + goto 2; end; {if} if bKind in [cgReal,cgDouble,cgComp,cgExtended] then begin if etype^.baseType in [cgByte..cgULong] then @@ -2107,26 +2064,10 @@ var else if etype^.baseType in [cgReal,cgDouble,cgComp,cgExtended] then iPtr^.rval := realExpressionValue; - goto 3; + goto 2; end; {if} Error(47); errorFound := true; - goto 2; - -3: if bitsize <> 0 then begin - - {set up a bit field value} - if bitdisp < bitcount then - InitializeBitField; - bitmask := 0; - for i := 1 to bitsize do - bitmask := (bitmask << 1) | 1; - bitmask := bitmask & expressionValue; - for i := 1 to bitdisp do - bitmask := bitmask << 1; - bitvalue := bitvalue | bitmask; - bitcount := bitcount + bitsize; - end; {if} end; arrayType: begin @@ -2330,14 +2271,6 @@ var end; {if} {handle auto variables} - if bitsize <> 0 then begin - iPtr := pointer(Malloc(sizeof(initializerRecord))); - InsertInitializerRecord(iPtr, 0); {TODO should size be 0?} - iPtr^.isConstant := isConstant; - iPtr^.count := 1; - iPtr^.bitdisp := bitdisp; - iPtr^.bitsize := bitsize; - end; {if} if variable^.storage in [external,global,private] then begin Error(41); errorFound := true; @@ -2345,8 +2278,6 @@ var iPtr^.isConstant := false; iPtr^.iTree := initializerTree; iPtr^.iType := tp; - iPtr^.bitdisp := bitdisp; - iPtr^.bitsize := bitsize; end; {else} 1: end; {GetInitializerValue} @@ -2369,7 +2300,8 @@ var label 1,2; var - bitCount: integer; {# of bits in a union} + bfp: identPtr; {pointer to bit-field in field list} + bfsize: integer; {number of bytes used by bit-field} braces: boolean; {is the initializer inclosed in braces?} count,maxCount: longint; {for tracking the size of an initializer} ep: tokenPtr; {for forming string expression} @@ -2403,8 +2335,6 @@ var ip: identPtr; {pointer to next field in a structure} begin {Fill} -{ writeln('Fill tp^.kind = ', ord(tp^.kind):1, '; count = ', count:1); {debug} - InitializeBitField; {if needed, do the bit field} if tp^.kind = arrayType then {fill an array} @@ -2671,7 +2601,6 @@ var else if kind in [structType, unionType] then begin if braces or (not main) then begin ip := tp^.fieldList; - bitCount := 0; maxDisp := disp; lSuppressMacroExpansions := suppressMacroExpansions; while true do begin @@ -2722,24 +2651,25 @@ var end; {if} if (ip = nil) or (ip^.itype^.size = 0) then goto 2; - {TODO zero padding in bitfields} - if ip^.bitSize = 0 then - if bitCount > 0 then begin - InitializeBitField; - bitCount := 0; - end; {if} disp := startingDisp + ip^.disp; + if ip^.bitsize <> 0 then begin {zero out padding bits in bitfields} + bfp := ip; + while (bfp^.next <> nil) and (bfp^.next^.disp = bfp^.disp) + and (bfp^.next^.bitsize <> 0) do + bfp := bfp^.next; + bfsize := (bfp^.bitdisp + bfp^.bitsize + 7) div 8; + if disp + bfsize > maxDisp then + if (bfp <> ip) or (ip^.bitdisp <> 0) + or (ip^.bitsize mod 8 <> 0) then begin + Fill(bfsize, charPtr); + maxDisp := disp; + disp := startingDisp + ip^.disp; + end; {if} + end; {if} InitializeTerm(ip^.itype, ip^.bitsize, ip^.bitdisp, false, hasNestedDesignator, setNoFill or hasNestedDesignator); - if ip^.bitSize <> 0 then begin - bitCount := bitCount + ip^.bitSize; - if bitCount > maxBitField then begin - bitCount := ip^.bitSize; - end; {if} - end; {if} if disp > maxDisp then maxDisp := disp; -{ writeln('Initializer: ', ip^.bitsize:10, ip^.bitdisp:10, bitCount:10); {debug} if kind = unionType then ip := nil else begin @@ -2755,12 +2685,7 @@ var else if token.kind <> rbracech then ip := nil; end; {while} -2: if bitCount > 0 then begin - InitializeBitField; - bitCount := (bitCount+7) div 8; - bitCount := 0; - end; {if} - if not noFill then begin +2: if not noFill then begin disp := startingDisp + tp^.size; if disp > maxDisp then begin {if there weren't enough initializers...} fillSize := disp - maxDisp; @@ -2800,8 +2725,6 @@ var end; {InitializeTerm} begin {Initializer} -bitcount := 0; {set up for bit fields} -bitvalue := 0; disp := 0; {start at beginning of the object} errorFound := false; {no errors found so far} skipComma := false; From 4621336c3b3b7f64363796e0e135f0803a633072 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Mon, 28 Nov 2022 20:14:30 -0600 Subject: [PATCH 17/39] Give anonymous structs/unions unique internal names. This will help deal with initialization of them. --- Parser.pas | 29 ++++++++++++++++++----------- Symbol.pas | 2 +- 2 files changed, 19 insertions(+), 12 deletions(-) diff --git a/Parser.pas b/Parser.pas index 8667dce..57d5557 100644 --- a/Parser.pas +++ b/Parser.pas @@ -182,6 +182,7 @@ type end; var + anonNumber: integer; {number for next anonymous struct/union} firstCompoundStatement: boolean; {are we doing a function level compound statement?} fType: typePtr; {return type of the current function} functionName: stringPtr; {name of the current function} @@ -2827,7 +2828,11 @@ var label 1; + type + anonNameString = packed array [0..11] of char; + var + anonName: ^anonNameString; {name for anonymous struct/union field} bitDisp: integer; {current bit disp} disp: longint; {current byte disp} done: boolean; {for loop termination} @@ -2857,16 +2862,14 @@ var tfl: identPtr; {for traversing field list} begin {AddField} - if variable^.name^ <> '~anonymous' then begin - tfl := fl; {(check for dups)} - while tfl <> nil do begin - if tfl^.name^ = variable^.name^ then begin - Error(42); - goto 1; - end; {if} - tfl := tfl^.next; - end; {while} - end; {if} + tfl := fl; {(check for dups)} + while tfl <> nil do begin + if tfl^.name^ = variable^.name^ then begin + Error(42); + goto 1; + end; {if} + tfl := tfl^.next; + end; {while} 1: variable^.next := fl; if anonMember <> nil then begin variable^.anonMemberField := true; @@ -2908,7 +2911,10 @@ var and ((structsy in fieldDeclSpecifiers.declarationModifiers) or (unionsy in fieldDeclSpecifiers.declarationModifiers)) then begin - variable := NewSymbol(@'~anonymous', tPtr, ident, + anonName := pointer(Malloc(sizeof(anonNameString))); + anonName^ := concat('~anon', cnvis(anonNumber)); + anonNumber := anonNumber+1; + variable := NewSymbol(anonName, tPtr, ident, fieldListSpace, defined, false); anonMember := true; TermHeader; {cannot record anon member in .sym file} @@ -4758,6 +4764,7 @@ doingForLoopClause1 := false; {not doing a for loop} fIsNoreturn := false; {not doing a noreturn function} compoundLiteralNumber := 1; {no compound literals yet} compoundLiteralToAllocate := nil; {no compound literals needing space yet} +anonNumber := 0; {no anonymous structs/unions yet} {init syntactic classes of tokens} {See C17 section 6.7 ff.} diff --git a/Symbol.pas b/Symbol.pas index ad8eeaa..5a65dd7 100644 --- a/Symbol.pas +++ b/Symbol.pas @@ -1287,7 +1287,7 @@ var if ip = nil then ip := defaultStruct^.fieldList; while ip <> nil do begin - if ip^.name^ <> '~anonymous' then + if ip^.name^[1] <> '~' then GenSymbol(ip, none); ip := ip^.next; end; {while} From 39250629bdeeaa1bb13ca75958ff2a7c5d13e660 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Mon, 28 Nov 2022 20:55:47 -0600 Subject: [PATCH 18/39] Support designated initialization of anonymous member fields. As noted previously, there is some ambiguity in the standards about how anonymous structs/unions participate in initialization. ORCA/C follows the model that they do participate as structs or unions, and designated initialization of them is implemented accordingly. This currently has a slight issue in that extra copies of the anonymous member field name will be printed in #pragma expand output. --- Parser.pas | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/Parser.pas b/Parser.pas index 57d5557..a1b8c5f 100644 --- a/Parser.pas +++ b/Parser.pas @@ -2627,8 +2627,15 @@ var ip := ip^.next; if ip = nil then Error(81); - NextToken; - {TODO if ip is an anonymous member field ...} + if ip^.anonMemberField then begin + PutBackToken(token, false); + token.kind := dotch; + token.class := reservedSymbol; + token.isDigraph := false; + ip := ip^.anonMember; + end {if} + else + NextToken; if token.kind in [dotch,lbrackch] then hasNestedDesignator := true else From dc305a86b207cf2da85ede5a034b3d9a59cf5348 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Mon, 28 Nov 2022 21:22:56 -0600 Subject: [PATCH 19/39] Add flag to suppress printing of put-back tokens with #pragma expand. This is currently used in a couple places in the designated initializer code (solving the problem with #pragma expand in the last commit). It could probably be used elsewhere too, but for now it is not. --- Parser.pas | 38 +++++++++++++++++--------------------- Scanner.pas | 40 ++++++++++++++++++++++++++-------------- 2 files changed, 43 insertions(+), 35 deletions(-) diff --git a/Parser.pas b/Parser.pas index a1b8c5f..e14c049 100644 --- a/Parser.pas +++ b/Parser.pas @@ -988,7 +988,7 @@ case token.kind of lToken := token; NextToken; tToken := token; - PutBackToken(token, true); + PutBackToken(token, true, false); token := lToken; suppressMacroExpansions := lSuppressMacroExpansions; if tToken.kind = colonch then begin @@ -1110,12 +1110,12 @@ Gen1(dc_lab, stPtr^.continueLab); {define the continue label} tl := stPtr^.e3List; {place the expression back in the list} if tl <> nil then begin - PutBackToken(token, false); + PutBackToken(token, false, false); ltoken.kind := semicolonch; ltoken.class := reservedSymbol; - PutBackToken(ltoken, false); + PutBackToken(ltoken, false, false); while tl <> nil do begin - PutBackToken(tl^.token, false); + PutBackToken(tl^.token, false, false); tk := tl; tl := tl^.next; dispose(tk); @@ -1463,12 +1463,12 @@ var NextToken; suppressMacroExpansions := lSuppressMacroExpansions; if token.kind = rparench then begin - PutBackToken(token, false); + PutBackToken(token, false, false); NextToken; tPtr2^.prototyped := true; end else begin - PutBackToken(token, false); + PutBackToken(token, false, false); token.kind := voidsy; token.class := reservedSymbol; end; {else} @@ -1861,7 +1861,6 @@ var iPtr,jPtr,kPtr: initializerPtr; {for reversing the list} ip: identList; {used to place an id in the list} luseGlobalPool: boolean; {local copy of useGlobalPool} - skipComma: boolean; {skip an expected comma} procedure InsertInitializerRecord (iPtr: initializerPtr; size: longint); @@ -2442,11 +2441,8 @@ var {check for designators that need to} {be handled at an outer level } if token.kind in [dotch,lbrackch] then - if not (braces or nestedDesignator) then begin - {TODO fill?} - skipComma := true; + if not (braces or nestedDesignator) then goto 1; - end; {if} startingDisp := disp; setNoFill := noFill; if kind = arrayType then begin @@ -2521,7 +2517,9 @@ var if token.kind in [lbrackch,dotch] then begin if not (braces or (nestedDesignator and (disp=startingDisp))) then begin - skipComma := true; + PutBackToken(token, false, true); + token.kind := commach; + token.class := reservedSymbol; goto 1; end; {if} Match(lbrackch, 35); @@ -2561,11 +2559,8 @@ var count := count+1; if (count = maxCount) and not braces then done := true - else if (token.kind = commach) or skipComma then begin - if skipComma then - skipComma := false - else - NextToken; + else if (token.kind = commach) then begin + NextToken; done := token.kind = rbracech; if not done then if count = maxCount then @@ -2613,7 +2608,9 @@ var if token.kind in [dotch,lbrackch] then begin if not (braces or (nestedDesignator and (disp=startingDisp))) then begin - skipComma := true; + PutBackToken(token, false, true); + token.kind := commach; + token.class := reservedSymbol; goto 1; end; {if} Match(dotch, 35); @@ -2628,7 +2625,7 @@ var if ip = nil then Error(81); if ip^.anonMemberField then begin - PutBackToken(token, false); + PutBackToken(token, false, true); token.kind := dotch; token.class := reservedSymbol; token.isDigraph := false; @@ -2735,7 +2732,6 @@ var begin {Initializer} disp := 0; {start at beginning of the object} errorFound := false; {no errors found so far} -skipComma := false; luseGlobalPool := useGlobalPool; {use global memory for global vars} useGlobalPool := (variable^.storage in [external,global,private]) or useGlobalPool; @@ -4357,7 +4353,7 @@ case statementList^.kind of NextToken; suppressMacroExpansions := lSuppressMacroExpansions; nToken := token; - PutBackToken(nToken, false); + PutBackToken(nToken, false, false); token := lToken; if nToken.kind <> colonch then DoDeclaration(false) diff --git a/Scanner.pas b/Scanner.pas index 86a8f8e..951c107 100644 --- a/Scanner.pas +++ b/Scanner.pas @@ -49,6 +49,7 @@ type next: tokenListRecordPtr; {next element in list} token: tokenType; {token} expandEnabled: boolean; {can this token be macro expanded?} + suppressPrint: boolean; {suppress printing with #pragma expand?} tokenStart,tokenEnd: ptr; {token start/end markers} end; macroRecordPtr = ^macroRecord; @@ -153,13 +154,15 @@ procedure NextToken; { Read the next token from the file. } -procedure PutBackToken (var token: tokenType; expandEnabled: boolean); +procedure PutBackToken (var token: tokenType; expandEnabled: boolean; + suppressPrint: boolean); { place a token into the token stream } { } { parameters: } { token - token to put back into the token stream } { expandEnabled - can macro expansion be performed? } +{ suppressPrint - suppress printing with #pragma expand? } procedure TermScanner; @@ -510,13 +513,15 @@ macroFound := mPtr; end; {IsDefined} -procedure PutBackToken {var token: tokenType; expandEnabled: boolean}; +procedure PutBackToken {var token: tokenType; expandEnabled: boolean; + suppressPrint: boolean}; { place a token into the token stream } { } { parameters: } { token - token to put back into the token stream } { expandEnabled - can macro expansion be performed? } +{ suppressPrint - suppress printing with #pragma expand? } var tPtr: tokenListRecordPtr; {work pointer} @@ -527,6 +532,7 @@ tPtr^.next := tokenList; tokenList := tPtr; tPtr^.token := token; tPtr^.expandEnabled := expandEnabled; +tPtr^.suppressPrint := suppressPrint; tPtr^.tokenStart := tokenStart; tPtr^.tokenEnd := tokenEnd; end; {PutBackToken} @@ -1628,7 +1634,7 @@ else end; {for} token.sval^.str[len+1] := chr(0); token.sval^.length := len+1; -PutBackToken(token, true); +PutBackToken(token, true, false); end; {BuildStringToken} @@ -1917,7 +1923,7 @@ if macro^.parameters >= 0 then begin {find the values of the parameters} Error(14); if token.kind <> rparench then begin {insist on a closing ')'} if not gettingFileName then {put back the source stream token} - PutBackToken(token, true); + PutBackToken(token, true, false); Error(12); end; {if} preprocessing := lPreprocessing; @@ -1925,7 +1931,7 @@ if macro^.parameters >= 0 then begin {find the values of the parameters} else begin Error(13); if not gettingFileName then {put back the source stream token} - PutBackToken(token, true); + PutBackToken(token, true, false); end; {else} end; {if} if macro^.readOnly then begin {handle special macros} @@ -2040,7 +2046,7 @@ if macro^.readOnly then begin {handle special macros} end; {case} if macro^.algorithm <> 8 then {if not _Pragma} - PutBackToken(token, true); + PutBackToken(token, true, false); end {if} else begin @@ -2128,11 +2134,11 @@ else begin if expandEnabled then if tcPtr^.token.name^ = macro^.name^ then expandEnabled := false; - PutBackToken(tcPtr^.token, expandEnabled); + PutBackToken(tcPtr^.token, expandEnabled, false); end; {else} end {if} else - PutBackToken(tcPtr^.token, true); + PutBackToken(tcPtr^.token, true, false); tcPtr := tcPtr^.next; end; {while} end; {else} @@ -2147,7 +2153,7 @@ else begin expandEnabled := false; tokenStart := tlPtr^.tokenStart; tokenEnd := tlPtr^.tokenEnd; - PutBackToken(tlPtr^.token, expandEnabled); + PutBackToken(tlPtr^.token, expandEnabled, false); end; {else} lastPtr := tlPtr; tlPtr := tlPtr^.next; @@ -3438,7 +3444,7 @@ if ch in ['a','d','e','i','l','p','u','w'] then begin end; {if} if token.name^ <> 'STDC' then begin {Allow macro expansion, other than for STDC } - PutBackToken(token, true); + PutBackToken(token, true, false); NextToken; end; {if} if token.name^ = 'keep' then @@ -4903,6 +4909,7 @@ var tPtr: tokenListRecordPtr; {for removing tokens from putback buffer} tToken: tokenType; {for merging tokens} sPtr,tsPtr: gstringPtr; {for forming string constants} + suppressPrint: boolean; {suppress printing the token?} lLastWasReturn: boolean; {local copy of lastWasReturn} codePoint: longint; {Unicode character value} chFromUCN: integer; {character given by UCN (converted)} @@ -5166,6 +5173,7 @@ if tokenList <> nil then begin {get a token put back by a macro} tokenList := tPtr^.next; expandEnabled := tPtr^.expandEnabled; tokenExpandEnabled := expandEnabled; + suppressPrint := tPtr^.suppressPrint; token := tPtr^.token; tokenStart := tPtr^.tokenStart; tokenEnd := tPtr^.tokenEnd; @@ -5226,7 +5234,9 @@ if tokenList <> nil then begin {get a token put back by a macro} expandMacros := lExpandMacros; end; {if} goto 2; - end; {if} + end {if} +else + suppressPrint := false; 5: {skip white space} while charKinds[ord(ch)] in [illegal,ch_white,ch_eol,ch_pound] do begin if charKinds[ord(ch)] = ch_pound then begin @@ -5740,7 +5750,7 @@ if (token.kind = stringconst) and not mergingStrings {handle adjacent strings} done := false; end {if} else begin - PutBackToken(token, tokenExpandEnabled); + PutBackToken(token, tokenExpandEnabled, false); done := true; end; {else} token := tToken; @@ -5755,8 +5765,10 @@ if doingPPExpression then begin if token.kind = typedef then token.kind := ident; end; {if} -if printMacroExpansions and not suppressMacroExpansions then - PrintToken(token); {print the token stream} +if printMacroExpansions then + if not suppressMacroExpansions then + if not suppressPrint then + PrintToken(token); {print the token stream} if token.kind = otherch then if not (skipping or preprocessing or suppressMacroExpansions) or doingPPExpression then From bde70e0885bdf7ebeaf9fce59b641c7339d2bf9c Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Mon, 28 Nov 2022 21:40:26 -0600 Subject: [PATCH 20/39] Simplify fill-with-zeros logic. It now just fills on levels with braces (or at the end of a string). --- Parser.pas | 22 ++++++++-------------- 1 file changed, 8 insertions(+), 14 deletions(-) diff --git a/Parser.pas b/Parser.pas index e14c049..972b479 100644 --- a/Parser.pas +++ b/Parser.pas @@ -2284,7 +2284,7 @@ var procedure InitializeTerm (tp: typePtr; bitsize,bitdisp: integer; - main, nestedDesignator, noFill: boolean); + main, nestedDesignator: boolean); { initialize one level of the type } { } @@ -2295,7 +2295,6 @@ var { main - is this a call from the main level? } { nestedDesignator - handling second or later level of } { designator in a designator list? } - { noFill - if set, do not fill empty space with zeros } label 1,2; @@ -2314,7 +2313,6 @@ var lSuppressMacroExpansions: boolean;{local copy of suppressMacroExpansions} maxDisp: longint; {maximum disp value so far} newDisp: longint; {new disp set by a designator} - setNoFill: boolean; {set noFill on recursive calls?} startingDisp: longint; {disp at start of this term} stringElementType: typePtr; {element type of string literal} stringLength: integer; {elements in a string literal} @@ -2431,7 +2429,6 @@ var if token.kind = lbracech then begin NextToken; braces := true; - noFill := false; end; {if} {handle arrays} @@ -2444,7 +2441,6 @@ var if not (braces or nestedDesignator) then goto 1; startingDisp := disp; - setNoFill := noFill; if kind = arrayType then begin ktp := tp^.atype; while ktp^.kind = definedType do @@ -2539,7 +2535,7 @@ var else Match(eqch, 182); newDisp := startingDisp + count * ktp^.size; - if not noFill then begin + if braces then begin fillSize := newDisp - maxDisp; if hasNestedDesignator then fillSize := fillSize + ktp^.size; @@ -2549,11 +2545,9 @@ var maxDisp := disp; end; {if} end; {if} - setNoFill := true; disp := newDisp; end; {if} - InitializeTerm(ktp, 0, 0, false, hasNestedDesignator, - setNoFill or hasNestedDesignator); + InitializeTerm(ktp, 0, 0, false, hasNestedDesignator); if disp > maxDisp then maxDisp := disp; count := count+1; @@ -2577,7 +2571,7 @@ var tp^.elements := maxCount; RecomputeSizes(variable^.itype); end; {if} - if not noFill then begin + if braces then begin disp := startingDisp + maxCount * ktp^.size; if disp > maxDisp then begin {if there weren't enough initializers...} fillSize := disp - maxDisp; @@ -2638,7 +2632,7 @@ var else Match(eqch, 182); newDisp := startingDisp + ip^.disp; - if not noFill then begin + if braces then begin fillSize := newDisp - maxDisp; if hasNestedDesignator and (ip^.bitsize = 0) then fillSize := fillSize + ip^.itype^.size; @@ -2672,7 +2666,7 @@ var end; {if} end; {if} InitializeTerm(ip^.itype, ip^.bitsize, ip^.bitdisp, false, - hasNestedDesignator, setNoFill or hasNestedDesignator); + hasNestedDesignator); if disp > maxDisp then maxDisp := disp; if kind = unionType then @@ -2690,7 +2684,7 @@ var else if token.kind <> rbracech then ip := nil; end; {while} -2: if not noFill then begin +2: if braces then begin disp := startingDisp + tp^.size; if disp > maxDisp then begin {if there weren't enough initializers...} fillSize := disp - maxDisp; @@ -2741,7 +2735,7 @@ if not (token.kind in [lbracech,stringConst]) then Error(27); errorFound := true; end; {if} -InitializeTerm(variable^.itype, 0, 0, true, false, false); {do the initialization} +InitializeTerm(variable^.itype, 0, 0, true, false); {do the initialization} variable^.state := initialized; {mark the variable as initialized} iPtr := variable^.iPtr; {reverse the initializer list} jPtr := nil; From 50e3a8ea3004460b71dfb22eb48d20eff32ae2fc Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Mon, 28 Nov 2022 21:44:30 -0600 Subject: [PATCH 21/39] Avoid dereferencing nil. --- Parser.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Parser.pas b/Parser.pas index 972b479..551d284 100644 --- a/Parser.pas +++ b/Parser.pas @@ -2618,7 +2618,7 @@ var ip := ip^.next; if ip = nil then Error(81); - if ip^.anonMemberField then begin + if (ip <> nil) and ip^.anonMemberField then begin PutBackToken(token, false, true); token.kind := dotch; token.class := reservedSymbol; From 4a8b5b25c793955a35d208d287fab39df6feb759 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Mon, 28 Nov 2022 21:59:08 -0600 Subject: [PATCH 22/39] Use a variable to indicate storage duration for initialization. --- Parser.pas | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/Parser.pas b/Parser.pas index 551d284..347f03c 100644 --- a/Parser.pas +++ b/Parser.pas @@ -1860,6 +1860,7 @@ var errorFound: boolean; {used to remove bad initializations} iPtr,jPtr,kPtr: initializerPtr; {for reversing the list} ip: identList; {used to place an id in the list} + isStatic: boolean; {static storage duration (or automatic)?} luseGlobalPool: boolean; {local copy of useGlobalPool} @@ -2010,7 +2011,7 @@ var begin {GetInitializerValue} - if variable^.storage = stackFrame then + if not isStatic then Expression(autoInitializerExpression, [commach,rparench,rbracech]) else Expression(initializerExpression, [commach,rparench,rbracech]); @@ -2029,7 +2030,7 @@ var false, false); if variable^.storage = external then variable^.storage := global; - if isConstant and (variable^.storage in [external,global,private]) then begin + if isConstant and isStatic then begin if etype^.baseType in [cgQuad,cgUQuad] then begin iPtr^.qVal := llExpressionValue; end {if} @@ -2135,7 +2136,7 @@ var and (bitsize = 0) then begin iPtr^.basetype := ccPointer; - if variable^.storage in [external,global,private] then begin + if isStatic then begin {do pointer constants with + or -} iPtr^.isConstant := true; @@ -2271,7 +2272,7 @@ var end; {if} {handle auto variables} - if variable^.storage in [external,global,private] then begin + if isStatic then begin Error(41); errorFound := true; end; {else} @@ -2340,7 +2341,7 @@ var else if tp^.kind = structType then begin {fill a structure} - if variable^.storage in [external,global,private] then + if isStatic then Fill(count * tp^.size, sCharPtr) else begin i := count; @@ -2358,7 +2359,7 @@ var else if tp^.kind = unionType then begin {fill a union} - if variable^.storage in [external,global,private] then + if isStatic then Fill(count * tp^.size, sCharPtr) else Fill(count, tp^.fieldList^.iType); @@ -2368,7 +2369,7 @@ var {fill a single value} while count <> 0 do begin iPtr := pointer(Calloc(sizeof(initializerRecord))); - iPtr^.isConstant := variable^.storage in [external,global,private]; + iPtr^.isConstant := isStatic; {iPtr^.bitdisp := 0;} {iPtr^.bitsize := 0;} if iPtr^.isConstant then begin @@ -2468,7 +2469,7 @@ var iPtr^.count := 1; iPtr^.bitdisp := 0; iPtr^.bitsize := 0; - if (variable^.storage in [external,global,private]) then begin + if isStatic then begin InsertInitializerRecord(iPtr, token.sval^.length); iPtr^.isConstant := true; iPtr^.basetype := cgString; @@ -2726,9 +2727,10 @@ var begin {Initializer} disp := 0; {start at beginning of the object} errorFound := false; {no errors found so far} + {static or automatic initialization?} +isStatic := variable^.storage in [external,global,private]; luseGlobalPool := useGlobalPool; {use global memory for global vars} -useGlobalPool := (variable^.storage in [external,global,private]) - or useGlobalPool; +useGlobalPool := isStatic or useGlobalPool; {make sure a required '{' is there} if not (token.kind in [lbracech,stringConst]) then if variable^.itype^.kind = arrayType then begin From c58d84689a7ac88bf617707793ddb8718c805195 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Mon, 28 Nov 2022 22:11:24 -0600 Subject: [PATCH 23/39] Explicitly set disp for every array element. This is needed to properly deal with arrays of structures with unnamed bit-fields at the end. --- Parser.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Parser.pas b/Parser.pas index 347f03c..c3514e4 100644 --- a/Parser.pas +++ b/Parser.pas @@ -2546,8 +2546,8 @@ var maxDisp := disp; end; {if} end; {if} - disp := newDisp; end; {if} + disp := startingDisp + count * ktp^.size; InitializeTerm(ktp, 0, 0, false, hasNestedDesignator); if disp > maxDisp then maxDisp := disp; From ac741e26ab2797a0f0e7a3d9394d211b5ed39944 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Tue, 29 Nov 2022 13:19:59 -0600 Subject: [PATCH 24/39] Allow nested auto structs/unions to be initialized with an expression of the same type. When the expression is initially parsed, we do not necessarily know whether it is the initializer for the struct/union or for its first member. That needs to be determined based on the type. To support that, a new function is added to evaluate the expression separately from using it to initialize an object. --- Parser.pas | 50 ++++++++++++++++++++++++++++++++++++++++++++------ cc.notes | 2 ++ 2 files changed, 46 insertions(+), 6 deletions(-) diff --git a/Parser.pas b/Parser.pas index c3514e4..eb3ec91 100644 --- a/Parser.pas +++ b/Parser.pas @@ -1858,6 +1858,7 @@ var disp: longint; {disp within overall object being initialized} done: boolean; {for loop termination} errorFound: boolean; {used to remove bad initializations} + haveExpression: boolean; {has an expression been parsed but not used?} iPtr,jPtr,kPtr: initializerPtr; {for reversing the list} ip: identList; {used to place an id in the list} isStatic: boolean; {static storage duration (or automatic)?} @@ -1881,6 +1882,18 @@ var end; {InsertInitializerRecord} + procedure GetInitializerExpression; + + { get the expression for an initializer } + + begin {GetInitializerExpression} + if not isStatic then + Expression(autoInitializerExpression, [commach,rparench,rbracech]) + else + Expression(initializerExpression, [commach,rparench,rbracech]); + end; {GetInitializerExpression} + + procedure GetInitializerValue (tp: typePtr; bitsize,bitdisp: integer); { get the value of an initializer from a single expression } @@ -2011,10 +2024,12 @@ var begin {GetInitializerValue} - if not isStatic then - Expression(autoInitializerExpression, [commach,rparench,rbracech]) - else - Expression(initializerExpression, [commach,rparench,rbracech]); + if not haveExpression then + GetInitializerExpression + else begin + NextToken; + haveExpression := false; + end; {else} iPtr := pointer(Malloc(sizeof(initializerRecord))); if bitsize <> 0 then size := (bitdisp + bitsize + 7) div 8 @@ -2590,6 +2605,26 @@ var {handle structures and unions} else if kind in [structType, unionType] then begin + if not braces then + if not nestedDesignator then + if not isStatic then + if (token.kind in startExpression-[stringconst]) then begin + if not haveExpression then begin + GetInitializerExpression; + haveExpression := true; + PutBackToken(token, false, true); + token.kind := ident; {dummy expression-starting token} + token.class := identifier; + token.name := @'__'; + token.symbolPtr := nil; + while expressionType^.kind = definedType do + expressionType := expressionType^.dType; + end; {if} + if CompTypes(tp, expressionType) then begin + GetInitializerValue(tp, 0, 0); + goto 1; + end; {if} + end; {if} if braces or (not main) then begin ip := tp^.fieldList; maxDisp := disp; @@ -2695,8 +2730,10 @@ var end; {if} suppressMacroExpansions := lSuppressMacroExpansions; end {if} - else {struct/union assignment initializer} - GetInitializerValue(tp, bitsize, bitdisp); + else begin {struct/union assignment initializer} + Error(47); + errorFound := true; + end; {else} end {else if} {handle single-valued types} @@ -2727,6 +2764,7 @@ var begin {Initializer} disp := 0; {start at beginning of the object} errorFound := false; {no errors found so far} +haveExpression := false; {no expression parsed yet} {static or automatic initialization?} isStatic := variable^.storage in [external,global,private]; luseGlobalPool := useGlobalPool; {use global memory for global vars} diff --git a/cc.notes b/cc.notes index 4ec4255..44fc397 100644 --- a/cc.notes +++ b/cc.notes @@ -1976,6 +1976,8 @@ int foo(int[42]); 220. In certain cases where a header starts or ends in the middle of a declaration, it would not be represented correctly in the .sym file. This could cause errors or misbehavior on subsequent compiles. +221. Structures with unnamed bit-fields were sometimes initialized incorrectly. + -- Bugs from C 2.1.0 that have been fixed ----------------------------------- 1. In some situations, fread() reread the first 1K or so of the file. From 1f468c437f501b0e38f227aa3481a0bd31da3629 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Tue, 29 Nov 2022 13:20:30 -0600 Subject: [PATCH 25/39] Set errorFound to true for most errors during initialization. --- Parser.pas | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/Parser.pas b/Parser.pas index eb3ec91..9a4170f 100644 --- a/Parser.pas +++ b/Parser.pas @@ -2540,6 +2540,7 @@ var or ((maxCount <> 0) and (expressionValue >= maxCount)) then begin Error(183); + errorFound := true; count := 0; end {if} else begin @@ -2576,6 +2577,7 @@ var if count = maxCount then if not (token.kind = lbrackch) then begin Error(183); + errorFound := true; count := 0; end; {if} end {else if} @@ -2652,8 +2654,10 @@ var done := true else ip := ip^.next; - if ip = nil then + if ip = nil then begin Error(81); + errorFound := true; + end; {if} if (ip <> nil) and ip^.anonMemberField then begin PutBackToken(token, false, true); token.kind := dotch; @@ -2681,6 +2685,7 @@ var end {if} else begin Error(9); + errorFound := true; goto 2; end; {else} end; {if} From e7940db4c8336c3ad09b334b1436658d05f2a1b0 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Tue, 29 Nov 2022 21:15:42 -0600 Subject: [PATCH 26/39] Allow initializers where a string literal begins a longer expression. This is needed to support cases like: char s[5] = {"abc"[1]}; --- Parser.pas | 113 +++++++++++++++++++++++++++++------------------------ 1 file changed, 61 insertions(+), 52 deletions(-) diff --git a/Parser.pas b/Parser.pas index 9a4170f..c00ce7e 100644 --- a/Parser.pas +++ b/Parser.pas @@ -1863,6 +1863,7 @@ var ip: identList; {used to place an id in the list} isStatic: boolean; {static storage duration (or automatic)?} luseGlobalPool: boolean; {local copy of useGlobalPool} + tToken: tokenType; {temporary copy of token} procedure InsertInitializerRecord (iPtr: initializerPtr; size: longint); @@ -2329,6 +2330,7 @@ var lSuppressMacroExpansions: boolean;{local copy of suppressMacroExpansions} maxDisp: longint; {maximum disp value so far} newDisp: longint; {new disp set by a designator} + nextTokenKind: tokenEnum; {kind of next token} startingDisp: longint; {disp at start of this term} stringElementType: typePtr; {element type of string literal} stringLength: integer; {elements in a string literal} @@ -2464,60 +2466,68 @@ var kind := ktp^.kind; {handle string constants} - if token.kind = stringConst then + if (token.kind = stringConst) and (kind = scalarType) then begin stringElementType := StringType(token.prefix)^.aType; - if (token.kind = stringConst) and (kind = scalarType) and - (((ktp^.baseType in [cgByte,cgUByte]) - and (stringElementType = charPtr)) - or CompTypes(ktp,stringElementType)) then begin - stringLength := token.sval^.length div ord(stringElementType^.size); - if tp^.elements = 0 then begin - tp^.elements := stringLength; - RecomputeSizes(variable^.itype); - end {if} - else if tp^.elements < stringLength-1 then begin - Error(44); - errorFound := true; - end; {else if} - with ktp^ do begin - iPtr := pointer(Malloc(sizeof(initializerRecord))); - iPtr^.count := 1; - iPtr^.bitdisp := 0; - iPtr^.bitsize := 0; - if isStatic then begin - InsertInitializerRecord(iPtr, token.sval^.length); - iPtr^.isConstant := true; - iPtr^.basetype := cgString; - iPtr^.sval := token.sval; - count := tp^.elements - stringLength; - if count > 0 then - Fill(count, stringElementType) - else if count = -1 then begin - iPtr^.sval := pointer(GMalloc(token.sval^.length+2)); - CopyLongString(iPtr^.sval, token.sval); - iPtr^.sval^.length := - iPtr^.sval^.length - ord(stringElementType^.size); + if ((ktp^.baseType in [cgByte,cgUByte]) and (stringElementType^.size=1)) + or CompTypes(ktp,stringElementType) then begin + tToken := token; + NextToken; + nextTokenKind := token.kind; + PutBackToken(token, false, true); + token := tToken; + if nextTokenKind in [commach, rbracech, semicolonch] then begin + stringLength := + token.sval^.length div ord(stringElementType^.size); + if tp^.elements = 0 then begin + tp^.elements := stringLength; + RecomputeSizes(variable^.itype); + end {if} + else if tp^.elements < stringLength-1 then begin + Error(44); + errorFound := true; end; {else if} - end {if} - else begin - InsertInitializerRecord(iPtr, - tp^.elements * stringElementType^.size); - iPtr^.isConstant := false; - new(ep); - iPtr^.iTree := ep; - iPtr^.iType := tp; - ep^.next := nil; - ep^.left := nil; - ep^.middle := nil; - ep^.right := nil; - ep^.token := token; - end; {else} - end; {with} - NextToken; - end {if} + with ktp^ do begin + iPtr := pointer(Malloc(sizeof(initializerRecord))); + iPtr^.count := 1; + iPtr^.bitdisp := 0; + iPtr^.bitsize := 0; + if isStatic then begin + InsertInitializerRecord(iPtr, token.sval^.length); + iPtr^.isConstant := true; + iPtr^.basetype := cgString; + iPtr^.sval := token.sval; + count := tp^.elements - stringLength; + if count > 0 then + Fill(count, stringElementType) + else if count = -1 then begin + iPtr^.sval := pointer(GMalloc(token.sval^.length+2)); + CopyLongString(iPtr^.sval, token.sval); + iPtr^.sval^.length := + iPtr^.sval^.length - ord(stringElementType^.size); + end; {else if} + end {if} + else begin + InsertInitializerRecord(iPtr, + tp^.elements * stringElementType^.size); + iPtr^.isConstant := false; + new(ep); + iPtr^.iTree := ep; + iPtr^.iType := tp; + ep^.next := nil; + ep^.left := nil; + ep^.middle := nil; + ep^.right := nil; + ep^.token := token; + end; {else} + end; {with} + NextToken; + goto 1; + end; {if} + end; {if} + end; {if} {handle arrays not initialized with a string constant} - else if kind in + if kind in [scalarType,pointerType,enumType,arrayType,structType,unionType] then begin count := 0; {get the expressions|initializers} @@ -2749,7 +2759,7 @@ var Error(47); errorFound := true; end; {else} - +1: if braces then begin {if there was an opening brace then } if token.kind = commach then { insist on a closing brace } NextToken; @@ -2763,7 +2773,6 @@ var errorFound := true; end; {else} end; {if} -1: end; {InitializeTerm} begin {Initializer} From 94584b0f05fe35e8d22fe9d1690a0c3bc422e1e6 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Wed, 30 Nov 2022 17:57:21 -0600 Subject: [PATCH 27/39] Give error for arrays that are still 0 size after initialization. This prohibits empty initializers ({}) for arrays of unknown size, consistent with C23 requirements. Previous versions of C did not allow empty initializers at all, but ORCA/C historically did in some cases, so this patch still allows them for structs/unions/arrays of known size. --- Parser.pas | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/Parser.pas b/Parser.pas index c00ce7e..9eb58f2 100644 --- a/Parser.pas +++ b/Parser.pas @@ -2595,9 +2595,15 @@ var done := true; until done or (token.kind = eofsy); if maxCount = 0 then begin {set the array size} - maxCount := (maxDisp - startingDisp + ktp^.size - 1) div ktp^.size; - tp^.elements := maxCount; - RecomputeSizes(variable^.itype); + if maxDisp <> startingDisp then begin + maxCount := (maxDisp - startingDisp + ktp^.size-1) div ktp^.size; + tp^.elements := maxCount; + RecomputeSizes(variable^.itype); + end {if} + else begin + Error(49); + errorFound := true; + end; {else} end; {if} if braces then begin disp := startingDisp + maxCount * ktp^.size; From 51951721c5c3bbe0126b091354291cd7364cfe52 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Wed, 30 Nov 2022 18:37:28 -0600 Subject: [PATCH 28/39] Simplify Fill procedure. In the current design, it only needs to fill in a certain number of bytes, not a specific type. --- Parser.pas | 147 ++++++++++++++++++----------------------------------- 1 file changed, 50 insertions(+), 97 deletions(-) diff --git a/Parser.pas b/Parser.pas index 9eb58f2..40bab5d 100644 --- a/Parser.pas +++ b/Parser.pas @@ -2300,6 +2300,50 @@ var end; {GetInitializerValue} + procedure Fill (count: longint); + + { fill in space in an initialized data structure with 0 bytes } + { } + { parameters: } + { count - number of zero bytes to create } + + var + iPtr: initializerPtr; {for creating an initializer entry} + tk: tokenPtr; {expression record} + + begin {Fill} + while count <> 0 do begin + iPtr := pointer(Calloc(sizeof(initializerRecord))); + iPtr^.isConstant := isStatic; + {iPtr^.bitdisp := 0;} + {iPtr^.bitsize := 0;} + if iPtr^.isConstant then + iPtr^.basetype := cgUByte + else begin + new(tk); + tk^.next := nil; + tk^.left := nil; + tk^.middle := nil; + tk^.right := nil; + tk^.token.kind := intconst; + tk^.token.class := intConstant; + tk^.token.ival := 0; + iPtr^.iTree := tk; + iPtr^.iType := charPtr; + end; {else} + if count <= maxint then begin + iPtr^.count := ord(count); + count := 0; + end {if} + else begin + iPtr^.count := maxint; + count := count-maxint; + end; {else} + InsertInitializerRecord(iPtr, iPtr^.count); + end; {while} + end; {Fill} + + procedure InitializeTerm (tp: typePtr; bitsize,bitdisp: integer; main, nestedDesignator: boolean); @@ -2334,97 +2378,6 @@ var startingDisp: longint; {disp at start of this term} stringElementType: typePtr; {element type of string literal} stringLength: integer; {elements in a string literal} - - - procedure Fill (count: longint; tp: typePtr); - - { fill in unspecified space in an initialized array with 0 } - { } - { parameters: } - { count - ^ elements of this type to create } - { tp - ptr to type of elements to create } - - var - i: longint; {loop variable} - iPtr: initializerPtr; {for creating an initializer entry} - tk: tokenPtr; {expression record} - ip: identPtr; {pointer to next field in a structure} - - begin {Fill} - if tp^.kind = arrayType then - - {fill an array} - Fill(count*tp^.elements ,tp^.aType) - else if tp^.kind = structType then begin - - {fill a structure} - if isStatic then - Fill(count * tp^.size, sCharPtr) - else begin - i := count; - while i <> 0 do begin - ip := tp^.fieldList; - while ip <> nil do begin - if not ip^.anonMemberField then - Fill(1, ip^.iType); - ip := ip^.next; - end; {while} - i := i-1; - end; {while} - end; {else} - end {else if} - else if tp^.kind = unionType then begin - - {fill a union} - if isStatic then - Fill(count * tp^.size, sCharPtr) - else - Fill(count, tp^.fieldList^.iType); - end {else if} - else - - {fill a single value} - while count <> 0 do begin - iPtr := pointer(Calloc(sizeof(initializerRecord))); - iPtr^.isConstant := isStatic; - {iPtr^.bitdisp := 0;} - {iPtr^.bitsize := 0;} - if iPtr^.isConstant then begin - if tp^.kind = scalarType then - iPtr^.basetype := tp^.baseType - else if tp^.kind = pointertype then begin - iPtr^.basetype := cgULong; - {iPtr^.iVal := 0;} - end {else if} - else begin - iPtr^.basetype := cgWord; - Error(47); - errorFound := true; - end; {else} - end {if} - else begin - new(tk); - tk^.next := nil; - tk^.left := nil; - tk^.middle := nil; - tk^.right := nil; - tk^.token.kind := intconst; - tk^.token.class := intConstant; - tk^.token.ival := 0; - iPtr^.iTree := tk; - iPtr^.iType := tp; - end; {else} - if count < 16384 then begin - iPtr^.count := long(count).lsw; - count := 0; - end {if} - else begin - iPtr^.count := 16384; - count := count-16384; - end; {else} - InsertInitializerRecord(iPtr, tp^.size * iPtr^.count); - end; {while} - end; {Fill} procedure RecomputeSizes (tp: typePtr); @@ -2498,7 +2451,7 @@ var iPtr^.sval := token.sval; count := tp^.elements - stringLength; if count > 0 then - Fill(count, stringElementType) + Fill(count * stringElementType^.size) else if count = -1 then begin iPtr^.sval := pointer(GMalloc(token.sval^.length+2)); CopyLongString(iPtr^.sval, token.sval); @@ -2568,7 +2521,7 @@ var fillSize := fillSize + ktp^.size; if fillSize > 0 then begin disp := maxDisp; - Fill(fillSize, charPtr); + Fill(fillSize); maxDisp := disp; end; {if} end; {if} @@ -2610,7 +2563,7 @@ var if disp > maxDisp then begin {if there weren't enough initializers...} fillSize := disp - maxDisp; disp := maxDisp; - Fill(fillSize, charPtr); { fill in the blank spots} + Fill(fillSize); { fill in the blank spots} end; {if} end; {if} end {else if} @@ -2694,7 +2647,7 @@ var fillSize := fillSize + ip^.itype^.size; if fillSize > 0 then begin disp := maxDisp; - Fill(fillSize, charPtr); + Fill(fillSize); maxDisp := disp; end; {if} end; {if} @@ -2717,7 +2670,7 @@ var if disp + bfsize > maxDisp then if (bfp <> ip) or (ip^.bitdisp <> 0) or (ip^.bitsize mod 8 <> 0) then begin - Fill(bfsize, charPtr); + Fill(bfsize); maxDisp := disp; disp := startingDisp + ip^.disp; end; {if} @@ -2746,7 +2699,7 @@ var if disp > maxDisp then begin {if there weren't enough initializers...} fillSize := disp - maxDisp; disp := maxDisp; - Fill(fillSize, charPtr); { fill in the blank spots} + Fill(fillSize); { fill in the blank spots} end; {if} end; {if} suppressMacroExpansions := lSuppressMacroExpansions; From c1a188aa958cfdabbbd88803b3a4301ce6f82f18 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Wed, 30 Nov 2022 18:55:43 -0600 Subject: [PATCH 29/39] Add some comments in initialization code. --- Parser.pas | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/Parser.pas b/Parser.pas index 40bab5d..27daaeb 100644 --- a/Parser.pas +++ b/Parser.pas @@ -2402,7 +2402,6 @@ var braces := true; end; {if} - {handle arrays} while tp^.kind = definedType do tp := tp^.dType; kind := tp^.kind; @@ -2412,13 +2411,15 @@ var if not (braces or nestedDesignator) then goto 1; startingDisp := disp; + + {handle arrays} if kind = arrayType then begin ktp := tp^.atype; while ktp^.kind = definedType do ktp := ktp^.dType; kind := ktp^.kind; - {handle string constants} + {handle arrays initialized with a string constant} if (token.kind = stringConst) and (kind = scalarType) then begin stringElementType := StringType(token.prefix)^.aType; if ((ktp^.baseType in [cgByte,cgUByte]) and (stringElementType^.size=1)) @@ -2489,6 +2490,7 @@ var if token.kind <> rbracech then repeat hasNestedDesignator := false; + {handle designators} if token.kind in [lbrackch,dotch] then begin if not (braces or (nestedDesignator and (disp=startingDisp))) then begin @@ -2526,6 +2528,7 @@ var end; {if} end; {if} end; {if} + disp := startingDisp + count * ktp^.size; InitializeTerm(ktp, 0, 0, false, hasNestedDesignator); if disp > maxDisp then @@ -2576,6 +2579,8 @@ var {handle structures and unions} else if kind in [structType, unionType] then begin + + {handle initialization with an expression of struct/union type} if not braces then if not nestedDesignator then if not isStatic then @@ -2596,6 +2601,8 @@ var goto 1; end; {if} end; {if} + + {handle struct/union initialization with an initializer list} if braces or (not main) then begin ip := tp^.fieldList; maxDisp := disp; @@ -2606,6 +2613,7 @@ var if token.kind = rbracech then {fill remainder with zeros} goto 2; hasNestedDesignator := false; + {handle designators} if token.kind in [dotch,lbrackch] then begin if not (braces or (nestedDesignator and (disp=startingDisp))) then begin @@ -2658,6 +2666,7 @@ var goto 2; end; {else} end; {if} + if (ip = nil) or (ip^.itype^.size = 0) then goto 2; disp := startingDisp + ip^.disp; From 8ad58b0de7ad36364c00250fd280086881707da7 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Wed, 30 Nov 2022 19:07:38 -0600 Subject: [PATCH 30/39] Report an error for dual commas at end of struct/union initializer. This covers things like: struct {int a,b;} u = {1,2,,}; --- Parser.pas | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/Parser.pas b/Parser.pas index 27daaeb..bf680d5 100644 --- a/Parser.pas +++ b/Parser.pas @@ -2697,9 +2697,15 @@ var end; {else} if ((ip = nil) or (ip^.itype^.size = 0)) and not braces then goto 2; - {TODO need other code to disallow dual commas before right brace?} - if token.kind = commach then - NextToken + if token.kind = commach then begin + NextToken; + if token.kind = commach then + if ip = nil then + if braces then begin + Error(23); + errorFound := true; + end; {if} + end {if} else if token.kind <> rbracech then ip := nil; end; {while} From 48efd462ef36acbb3065b67bee10dd9f5cc6bdd1 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Thu, 1 Dec 2022 14:09:03 -0600 Subject: [PATCH 31/39] Allow designated initialization of fields named the same as typedefs. They are in separate name spaces, so this should be permitted. --- Parser.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Parser.pas b/Parser.pas index bf680d5..38163f0 100644 --- a/Parser.pas +++ b/Parser.pas @@ -2623,7 +2623,7 @@ var goto 1; end; {if} Match(dotch, 35); - if token.kind = ident then begin + if token.kind in [ident,typedef] then begin ip := tp^.fieldList; done := false; while (ip <> nil) and not done do From 28e119afb1514e74415ff68dffe2fa0aa5936143 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Fri, 2 Dec 2022 21:55:57 -0600 Subject: [PATCH 32/39] Rework static initialization to support new-style initializer records. Static initialization of arrays/structs/unions now essentially "executes" the initializer records to fill in a buffer (and keep track of relocations), then emits pcode to represent that initialized state. This supports overlapping and out-of-order initializer records, as can be produced by designated initialization. --- CCommon.pas | 2 +- Parser.pas | 6 ++ Symbol.asm | 16 +++ Symbol.pas | 305 ++++++++++++++++++++++++++++++++++++++++++++++------ 4 files changed, 296 insertions(+), 33 deletions(-) diff --git a/CCommon.pas b/CCommon.pas index af35a38..102d4a0 100644 --- a/CCommon.pas +++ b/CCommon.pas @@ -322,7 +322,7 @@ type initializerRecord = record next: initializerPtr; {next record in the chain} disp: longint; {disp within overall object being initialized} - count: integer; {# of duplicate records} + count: integer; {# of duplicate records (>1 for bytes only)} bitdisp: integer; {disp in byte (field lists only)} bitsize: integer; {width in bits; 0 for byte sizes} case isConstant: boolean of {is this a constant initializer?} diff --git a/Parser.pas b/Parser.pas index 38163f0..31f9b87 100644 --- a/Parser.pas +++ b/Parser.pas @@ -2774,6 +2774,12 @@ while iPtr <> nil do begin jPtr := kPtr; end; {while} variable^.iPtr := jPtr; +if isStatic then {if doing static initialization } + if variable^.itype^.kind in [structType,unionType,definedType,arrayType] + then begin + disp := 0; {...ensure unnamed members are 0} + Fill(variable^.itype^.size); + end; {if} if errorFound then {eliminate bad initializers} variable^.state := defined; useGlobalPool := luseGlobalPool; {restore useGlobalPool} diff --git a/Symbol.asm b/Symbol.asm index d01c3cf..03c5317 100644 --- a/Symbol.asm +++ b/Symbol.asm @@ -22,3 +22,19 @@ lb1 sta [table],Y return end + +**************************************************************** +* +* SaveBF - save a value to a bit-field +* +* Inputs: +* addr - address to copy to +* bitdisp - displacement past the address +* bitsize - number of bits +* val - value to copy +* +**************************************************************** +* +SaveBF private cc + jml ~SaveBF call ~SaveBF in ORCALib + end diff --git a/Symbol.pas b/Symbol.pas index 5a65dd7..a338e4c 100644 --- a/Symbol.pas +++ b/Symbol.pas @@ -295,9 +295,27 @@ function StringType(prefix: charStrPrefixEnum): typePtr; implementation +type + {From CGC.pas} + realrec = record {used to convert from real to in-SANE} + itsReal: extended; + inSANE: packed array[1..10] of byte; + inCOMP: packed array[1..8] of byte; + end; + var staticNum: packed array[1..6] of char; {static variable number} +{---------------------------------------------------------------} + + {GS memory manager} + {-----------------} + +procedure DisposeHandle (theHandle: handle); tool ($02, $10); + +function NewHandle (blockSize: longint; userID, memAttributes: integer; + memLocation: ptr): handle; tool($02, $09); + {- Imported from expression.pas --------------------------------} procedure GenerateCode (tree: tokenPtr); extern; @@ -325,6 +343,17 @@ function UsualUnaryConversions: baseTypeEnum; extern; { outputs: } { expressionType - set to result type } + +{- Imported from CGC.pas ---------------------------------------} + +procedure CnvSC (rec: realrec); extern; + +{ convert a real number to SANE comp format } +{ } +{ parameters: } +{ rec - record containing the value to convert; also } +{ has space for the result } + {---------------------------------------------------------------} procedure CnOut (i: integer); extern; @@ -396,6 +425,16 @@ procedure ClearTable (table: symbolTable); extern; { clear the symbol table to all zeros } +procedure SaveBF (addr: ptr; bitdisp, bitsize: integer; val: longint); extern; + +{ save a value to a bit-field } +{ } +{ parameters: } +{ addr - address to copy to } +{ bitdisp - displacement past the address } +{ bitsize - number of bits } +{ val - value to copy } + {---------------------------------------------------------------} @@ -663,6 +702,239 @@ procedure DoGlobals; { declare the ~globals and ~arrays segments } + procedure StaticInit (variable: identPtr); + + { statically initialize a variable } + + type + {record of pointer initializers} + relocPtr = ^relocationRecord; + relocationRecord = record + next: relocPtr; {next record} + initializer: initializerPtr; {the initializer} + disp: longint; {disp in overall data structure} + end; + + {pointers to each type} + bytePtr = ^byte; + wordPtr = ^integer; + longPtr = ^longint; + quadPtr = ^longlong; + realPtr = ^real; + doublePtr = ^double; + extendedPtr = ^extended; + + var + buffPtr: ptr; {pointer to data buffer} + buffHandle: handle; {handle to data buffer} + count: integer; {# of duplicate records} + disp: longint; {disp into buffer (for output)} + endDisp: longint; {ending disp for current chunk} + i: integer; {loop counter} + ip: initializerPtr; {used to trace initializer lists} + lastReloc, nextReloc: relocPtr; {for reversing relocs list} + realVal: realRec; {used for extended-to-comp conversion} + relocs: relocPtr; {list of records needing relocation} + + {pointers used to write data} + bp: bytePtr; + wp: wordPtr; + lp: longPtr; + qp: quadPtr; + rp: realPtr; + dp: doublePtr; + ep: extendedPtr; + + + procedure UpdateRelocs; + + { update relocation records to account for an initializer } + + var + disp: longint; {disp of current initializer} + done: boolean; {done with loop?} + endDisp: longint; {disp at end of current initializer} + last: ^relocPtr; {the pointer referring to rp} + rp: relocPtr; {reloc record being processed} + + begin {UpdateRelocs} + disp := ip^.disp; + if ip^.bitsize <> 0 then begin + endDisp := disp + (ip^.bitdisp + ip^.bitsize + 7) div 8; + disp := disp + ip^.bitdisp div 8; + end {if} + else if ip^.basetype = cgString then + endDisp := disp + ip^.sVal^.length + else + endDisp := disp + TypeSize(ip^.baseType); + last := @relocs; + rp := relocs; + done := false; + while (rp <> nil) and not done do begin + if rp^.disp + cgPointerSize <= disp then begin + {initializer is entirely after this reloc: no conflicts} + done := true; + end {if} + else if endDisp <= rp^.disp then begin + {initializer is entirely before this reloc} + last := @rp^.next; + rp := rp^.next; + end {else if} + else begin + {conflict: remove the conflicting reloc record} + last^ := rp^.next; + lp := pointer(ord4(buffPtr) + rp^.disp); + lp^ := 0; + dispose(rp); + rp := last^; + end; {else} + end; {while} + if ip^.basetype = ccPointer then begin + new(rp); + rp^.next := last^; + last^ := rp; + rp^.disp := ip^.disp; + rp^.initializer := ip; + end; {if} + end; {UpdateRelocs} + + begin {StaticInit} + {allocate buffer} + {(+3 for possible bitfield overhang)} + buffHandle := NewHandle(variable^.itype^.size+3, UserID, $8000, nil); + if ToolError <> 0 then TermError(5); + buffPtr := buffHandle^; + + relocs := nil; {evaluate initializers} + ip := variable^.iPtr; + while ip <> nil do begin + count := 0; + while count < ip^.count do begin + UpdateRelocs; + if ip^.bitsize <> 0 then begin + bp := pointer(ord4(buffPtr) + ip^.disp + count); + SaveBF(bp, ip^.bitdisp, ip^.bitsize, ip^.iVal); + end {if} + else + case ip^.basetype of + cgByte,cgUByte: begin + bp := pointer(ord4(buffPtr) + ip^.disp + count); + bp^ := ord(ip^.iVal) & $ff; + end; + + cgWord,cgUWord: begin + wp := pointer(ord4(buffPtr) + ip^.disp + count); + wp^ := ord(ip^.iVal); + end; + + cgLong,cgULong: begin + lp := pointer(ord4(buffPtr) + ip^.disp + count); + lp^ := ip^.iVal; + end; + + cgQuad,cgUQuad: begin + qp := pointer(ord4(buffPtr) + ip^.disp + count); + qp^ := ip^.qVal; + end; + + cgReal: begin + rp := pointer(ord4(buffPtr) + ip^.disp + count); + rp^ := ip^.rVal; + end; + + cgDouble: begin + dp := pointer(ord4(buffPtr) + ip^.disp + count); + dp^ := ip^.rVal; + end; + + cgExtended: begin + ep := pointer(ord4(buffPtr) + ip^.disp + count); + ep^ := ip^.rVal; + end; + + cgComp: begin + realVal.itsReal := ip^.rVal; + CnvSC(realVal); + for i := 1 to 8 do begin + bp := pointer(ord4(buffPtr) + ip^.disp + count + i-1); + bp^ := realVal.inCOMP[i]; + end; {for} + end; + + cgString: begin + for i := 1 to ip^.sVal^.length do begin + bp := pointer(ord4(buffPtr) + ip^.disp + count + i-1); + bp^ := ord(ip^.sVal^.str[i]); + end; {for} + end; + + ccPointer: ; {handled by UpdateRelocs} + + cgVoid: Error(57); + end; {case} + count := count + 1; {assumes count > 1 only for bytes} + end; {while} + ip := ip^.next; + end; {while} + + lastReloc := nil; {reverse the relocs list} + while relocs <> nil do begin + nextReloc := relocs^.next; + relocs^.next := lastReloc; + lastReloc := relocs; + relocs := nextReloc; + end; {while} + relocs := lastReloc; + + disp := 0; {generate the initialization data} + while disp < variable^.itype^.size do begin + if relocs = nil then + endDisp := variable^.itype^.size + else + endDisp := relocs^.disp; + while endDisp - disp >= 8 do begin + qp := pointer(ord4(buffPtr) + disp); + GenQ1(dc_cns, qp^, 1); + disp := disp + 8; + end; {while} + if endDisp - disp >= 4 then begin + lp := pointer(ord4(buffPtr) + disp); + GenL1(dc_cns, lp^, 1); + disp := disp + 4; + end; {if} + if endDisp - disp >= 2 then begin + wp := pointer(ord4(buffPtr) + disp); + Gen2t(dc_cns, wp^, 1, cgUWord); + disp := disp + 2; + end; {if} + if endDisp - disp >= 1 then begin + bp := pointer(ord4(buffPtr) + disp); + Gen2t(dc_cns, bp^, 1, cgUByte); + disp := disp + 1; + end; {if} + if relocs <> nil then begin + code^.optype := ccPointer; + code^.r := ord(relocs^.initializer^.pPlus); + code^.q := 1; + code^.pVal := relocs^.initializer^.pVal; + if relocs^.initializer^.isName then begin + code^.lab := relocs^.initializer^.pName; + code^.pstr := nil; + end {if} + else + code^.pstr := relocs^.initializer^.pstr; + Gen0(dc_cns); + lastReloc := relocs; + relocs := relocs^.next; + dispose(lastReloc); + disp := disp + cgPointerSize; + end; {if} + end; {while} + + DisposeHandle(buffHandle); + end; {StaticInit} + + procedure GenArrays; { define global arrays } @@ -697,38 +969,7 @@ procedure DoGlobals; end; {if} if sp^.state = initialized then begin Gen2Name(dc_glb, 0, ord(sp^.storage = private), sp^.name); - ip := sp^.iPtr; - while ip <> nil do begin - case ip^.basetype of - cgByte,cgUByte,cgWord,cgUWord: begin - lval := ip^.ival; - Gen2t(dc_cns, long(lval).lsw, ip^.count, ip^.basetype); - end; - cgLong,cgULong: - GenL1(dc_cns, ip^.ival, ip^.count); - cgQuad,cgUQuad: - GenQ1(dc_cns, ip^.qval, ip^.count); - cgReal,cgDouble,cgComp,cgExtended: - GenR1t(dc_cns, ip^.rval, ip^.count, ip^.basetype); - cgString: - GenS(dc_cns, ip^.sval); - ccPointer: begin - code^.optype := ccPointer; - code^.r := ord(ip^.pPlus); - code^.q := ip^.count; - code^.pVal := ip^.pVal; - if ip^.isName then begin - code^.lab := ip^.pName; - code^.pstr := nil; - end {if} - else - code^.pstr := ip^.pstr; - Gen0(dc_cns); - end; - otherwise: Error(57); - end; {case} - ip := ip^.next; - end; {while} + StaticInit(sp); end {if} else begin size := sp^.itype^.size; From d56cf7e666502e9bb9bee384680c706ed903165d Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Sat, 3 Dec 2022 00:14:15 -0600 Subject: [PATCH 33/39] Pass constant data to backend as pointers into buffer. This avoids needing to generate many intermediate code records representing the data at most 8 bytes at a time, which should reduce memory use and probably improve performance for large initialized arrays or structs. --- CGI.pas | 40 +++++++++++++++++++++++++++++++++++++++- DAG.pas | 3 ++- Native.pas | 18 +++++++++++++++--- Symbol.pas | 26 ++++---------------------- 4 files changed, 60 insertions(+), 27 deletions(-) diff --git a/CGI.pas b/CGI.pas index 6cb3227..0e0803b 100644 --- a/CGI.pas +++ b/CGI.pas @@ -279,7 +279,11 @@ type cgDouble, cgComp, cgExtended : (rval: extended); - cgString : (str: longStringPtr); + cgString : ( + case isByteSeq: boolean of + false : (str: longStringPtr); + true : (data: ptr; len: longint); + ); cgVoid, ccPointer : (pval: longint; pstr: longStringPtr); end; @@ -574,6 +578,16 @@ procedure GenS (fop: pcodes; str: longstringPtr); { str - pointer to string } +procedure GenBS (fop: pcodes; data: ptr; len: longint); + +{ generate an instruction that uses a byte sequence operand } +{ } +{ parameters: } +{ fop - operation code } +{ data - pointer to data } +{ data - length of data } + + procedure GenL1 (fop: pcodes; lval: longint; fp1: integer); { generate an instruction that uses a longint and an int } @@ -1230,6 +1244,30 @@ if codeGeneration then begin end; {GenS} +procedure GenBS {fop: pcodes; data: ptr; len: longint}; + +{ generate an instruction that uses a byte sequence operand } +{ } +{ parameters: } +{ fop - operation code } +{ data - pointer to data } +{ len - length of data } + +var + lcode: icptr; {local copy of code} + +begin {GenBS} +if codeGeneration then begin + lcode := code; + lcode^.optype := cgString; + lcode^.isByteSeq := true; + lcode^.data := data; + lcode^.len := len; + Gen0(fop); + end; {if} +end; {GenBS} + + procedure GenL1 {fop: pcodes; lval: longint; fp1: integer}; { generate an instruction that uses a longint and an int } diff --git a/DAG.pas b/DAG.pas index 3bb3981..13d6cca 100644 --- a/DAG.pas +++ b/DAG.pas @@ -202,7 +202,8 @@ else if (op1 <> nil) and (op2 <> nil) then or fastMath then CodesMatch := true; cgString: - CodesMatch := LongStrCmp(op1^.str, op2^.str); + if not (op1^.isByteSeq or op1^.isByteSeq) then + CodesMatch := LongStrCmp(op1^.str, op2^.str); cgVoid, ccPointer: if op1^.pval = op2^.pval then CodesMatch := LongStrCmp(op1^.str, op2^.str); diff --git a/Native.pas b/Native.pas index e4b231e..8cd5156 100644 --- a/Native.pas +++ b/Native.pas @@ -361,6 +361,7 @@ type rkind = (k1,k2,k3,k4); {cnv record types} var + bp: ^byte; {byte pointer} ch: char; {temp storage for string constants} cns: realRec; {for converting reals to bytes} cnv: record {for converting double, real to bytes} @@ -672,9 +673,20 @@ case mode of CnOut(cns.inSANE[j]); end; cgString : begin - sptr := icptr(name)^.str; - for j := 1 to sptr^.length do - CnOut(ord(sPtr^.str[j])); + if not icptr(name)^.isByteSeq then begin + sptr := icptr(name)^.str; + for j := 1 to sptr^.length do + CnOut(ord(sPtr^.str[j])); + end {if} + else begin + lval := 0; + while lval < icptr(name)^.len do begin + bp := pointer( + ord4(icptr(name)^.data) + lval); + CnOut(bp^); + lval := lval + 1; + end; + end; {else} end; ccPointer : begin if icptr(name)^.lab <> nil then begin diff --git a/Symbol.pas b/Symbol.pas index a338e4c..ffb8fba 100644 --- a/Symbol.pas +++ b/Symbol.pas @@ -801,7 +801,7 @@ procedure DoGlobals; begin {StaticInit} {allocate buffer} {(+3 for possible bitfield overhang)} - buffHandle := NewHandle(variable^.itype^.size+3, UserID, $8000, nil); + buffHandle := NewHandle(variable^.itype^.size+3, globalID, $8000, nil); if ToolError <> 0 then TermError(5); buffPtr := buffHandle^; @@ -892,25 +892,9 @@ procedure DoGlobals; endDisp := variable^.itype^.size else endDisp := relocs^.disp; - while endDisp - disp >= 8 do begin - qp := pointer(ord4(buffPtr) + disp); - GenQ1(dc_cns, qp^, 1); - disp := disp + 8; - end; {while} - if endDisp - disp >= 4 then begin - lp := pointer(ord4(buffPtr) + disp); - GenL1(dc_cns, lp^, 1); - disp := disp + 4; - end; {if} - if endDisp - disp >= 2 then begin - wp := pointer(ord4(buffPtr) + disp); - Gen2t(dc_cns, wp^, 1, cgUWord); - disp := disp + 2; - end; {if} - if endDisp - disp >= 1 then begin - bp := pointer(ord4(buffPtr) + disp); - Gen2t(dc_cns, bp^, 1, cgUByte); - disp := disp + 1; + if disp <> endDisp then begin + GenBS(dc_cns, pointer(ord4(buffPtr) + disp), endDisp - disp); + disp := endDisp; end; {if} if relocs <> nil then begin code^.optype := ccPointer; @@ -930,8 +914,6 @@ procedure DoGlobals; disp := disp + cgPointerSize; end; {if} end; {while} - - DisposeHandle(buffHandle); end; {StaticInit} From 945d5ce8559c989ada11bdf7de8aa01772038d0c Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Sat, 3 Dec 2022 15:30:31 -0600 Subject: [PATCH 34/39] Generate calls to ~ZERO to initialize large numbers of zero bytes. There is a tradeoff of code size vs. speed, since a sequence of STZ instructions is faster than a call to ~ZERO but could be quite large for a big array or struct. We now use ~ZERO for initializations of over 50 bytes to avoid excessive code bloat; the exact number chosen is somewhat arbitrary. --- Parser.pas | 49 +++++++++++++++++++------------------------------ 1 file changed, 19 insertions(+), 30 deletions(-) diff --git a/Parser.pas b/Parser.pas index 31f9b87..32ba8a3 100644 --- a/Parser.pas +++ b/Parser.pas @@ -4451,7 +4451,7 @@ var { count - number of times to re-use the initializer } { iPtr - pointer to the initializer record to use } - label 1,2,3; + label 1,2,3,4; var count: integer; {initializer counter} @@ -4479,31 +4479,6 @@ var end; {LoadAddress} - function ZeroFill (elements: longint; itype: typePtr; - count: integer; iPtr: initializerPtr): boolean; - - { See if an array can be zero filled } - { } - { parameters: } - { elements - elements in the array } - { itype - type of each array element } - { count - remaining initializer repetitions } - { iPtr - initializer record } - - begin {ZeroFill} - ZeroFill := false; - if not iPtr^.isConstant then - if itype^.kind in [scalarType,enumType] then - if count >= elements then - with iPtr^.itree^ do - if token.kind = intconst then - if token.ival = 0 then - {don't call ~ZERO for very small arrays} - if elements * itype^.size > 10 then - ZeroFill := true; - end; {ZeroFill} - - procedure AddOperation; { Deal with a new initializer expression in a compound } @@ -4557,12 +4532,25 @@ var isConstant := false; end; {else} - if isConstant then {zero-initialize two bytes at a time} + if isConstant then if val = 0 then if count > 1 then if itype^.size = 1 then begin - itype := shortPtr; - count := count - 1; + {call ~ZERO for > 50 zero bytes} + if count > 50 then begin + Gen0t(pc_stk, cgULong); + Gen1t(pc_ldc, count, cgWord); + Gen0t(pc_stk, cgWord); + Gen0t(pc_bno, cgWord); + Gen1tName(pc_cup, -1, cgVoid, @'~ZERO'); + if isCompoundLiteral then + AddOperation; + goto 4; + end {if} + else begin {zero-initialize two bytes at a time} + itype := shortPtr; + count := count - 1; + end; {else} end; {if} { if isConstant then @@ -4622,7 +4610,7 @@ var Gen0t(pc_stk, cgULong); Gen1t(pc_ldc, ord(elements), cgWord); Gen0t(pc_stk, cgWord); - Gen0t(pc_bno, cgULong); + Gen0t(pc_bno, cgWord); Gen1tName(pc_cup, -1, cgVoid, @'~ZERO'); if isCompoundLiteral then AddOperation; @@ -4650,6 +4638,7 @@ var disp := disp + itype^.size; goto 3; end; {if} +4: end; {InitializeOneElement} From 7c0492cfa40b5d585217bb44eefb3b13da8eb11e Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Sat, 3 Dec 2022 18:04:50 -0600 Subject: [PATCH 35/39] Document designated initializers in the release notes. --- cc.notes | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/cc.notes b/cc.notes index 44fc397..b1f0235 100644 --- a/cc.notes +++ b/cc.notes @@ -603,6 +603,37 @@ is equivalent to the directive The _Pragma("...") token sequence may be formed using preprocessor macros. +30. (C99) ORCA/C now supports designated initializers, which let you explicitly specify the array element or struct/union member that should be initialized by an expression within a braced initializer list. They have the form: + + designator-list = expression + +Designators may be of the form + + [ constant-expression ] + +to designate an element of an array, or + + . identifier + +to designate a specific field of a structure or union. A designator list may consist of one or more designators; successive designators correspond to successive levels of a nested data structure. + +Designated and non-designated initializers may be mixed within an initializer list. If a non-designated initializer follows a designated one, it applies to the next subobject after the designated one, and initialization continues forward in the usual order until it is complete or another designator is encountered. If a braced initializer list does not include initializers for all the elements of an array or all the named members of a structure, the other ones are initialized to 0 (the same as when not using designated initializers). + +Designated initializers make it possible to initialize subobjects in any order, and to initialize later subobjects without having to write an explicit initializer for earlier ones. Designated initializers also allow union members other than the first one to be initialized. It is also possible to initialize the same subobject multiple times, but in that case the initializer appearing latest in the initializer list will override any earlier ones. + +As an example, the declaration + + struct { + int i; + union { + long x; + char y; + } u; + short a[3]; + } s = {20, .a[0] = 9, .u.y = 'F', .i = 50, .a = {[1]=1,2}, .a[1] = 10}; + +sets s.i to 50, s.u.y to 'F', s.a[0] to 0, s.a[1] to 10, and s.a[2] to 2. + Multi-Character Character Constants ----------------------------------- From 20770f388ee6e28b6d5ef91eb909e742d1725a00 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Sat, 3 Dec 2022 18:50:26 -0600 Subject: [PATCH 36/39] Move memory allocation code to a new function in MM. --- MM.pas | 28 ++++++++++++++++++++++++++++ Symbol.pas | 15 +-------------- 2 files changed, 29 insertions(+), 14 deletions(-) diff --git a/MM.pas b/MM.pas index d8ff341..d4e44fd 100644 --- a/MM.pas +++ b/MM.pas @@ -23,6 +23,7 @@ { GCalloc - allocate & clear memory from the global pool } { GInit - initialize a global pool } { GMalloc - allocate memory from the global pool } +{ GLongMalloc - allocate global memory } { LInit - initialize a local pool } { LMalloc - allocate memory from the local pool } { Malloc - allocate memory } @@ -73,6 +74,15 @@ procedure GInit; { Initialize a global pool } +function GLongMalloc (bytes: longint): ptr; + +{ Allocate a potentially large amount of global memory. } +{ } +{ Parameters: } +{ bytes - number of bytes to allocate } +{ ptr - points to the first byte of the allocated memory } + + function GMalloc (bytes: integer): ptr; { Allocate memory from the global pool. } @@ -182,6 +192,24 @@ globalPtr := pointer(ord4(globalPtr) + bytes); end; {GMalloc} +function GLongMalloc {bytes: longint): ptr}; + +{ Allocate a potentially large amount of global memory. } +{ } +{ Parameters: } +{ bytes - number of bytes to allocate } +{ ptr - points to the first byte of the allocated memory } + +var + myhandle: handle; {for dereferencing the block} + +begin {GLongMalloc} +myhandle := NewHandle(bytes, globalID, $C000, nil); +if ToolError <> 0 then TermError(5); +GLongMalloc := myhandle^; +end; {GLongMalloc} + + procedure LInit; { Initialize a local pool } diff --git a/Symbol.pas b/Symbol.pas index ffb8fba..ab69c14 100644 --- a/Symbol.pas +++ b/Symbol.pas @@ -306,16 +306,6 @@ type var staticNum: packed array[1..6] of char; {static variable number} -{---------------------------------------------------------------} - - {GS memory manager} - {-----------------} - -procedure DisposeHandle (theHandle: handle); tool ($02, $10); - -function NewHandle (blockSize: longint; userID, memAttributes: integer; - memLocation: ptr): handle; tool($02, $09); - {- Imported from expression.pas --------------------------------} procedure GenerateCode (tree: tokenPtr); extern; @@ -726,7 +716,6 @@ procedure DoGlobals; var buffPtr: ptr; {pointer to data buffer} - buffHandle: handle; {handle to data buffer} count: integer; {# of duplicate records} disp: longint; {disp into buffer (for output)} endDisp: longint; {ending disp for current chunk} @@ -801,9 +790,7 @@ procedure DoGlobals; begin {StaticInit} {allocate buffer} {(+3 for possible bitfield overhang)} - buffHandle := NewHandle(variable^.itype^.size+3, globalID, $8000, nil); - if ToolError <> 0 then TermError(5); - buffPtr := buffHandle^; + buffPtr := GLongMalloc(variable^.itype^.size+3); relocs := nil; {evaluate initializers} ip := variable^.iPtr; From 36c70f9107074e884daa762151fbf95ce761ca36 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Sun, 4 Dec 2022 16:23:33 -0600 Subject: [PATCH 37/39] Move ResolveForwardReference call to apply to the field being initialized. --- Parser.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Parser.pas b/Parser.pas index 32ba8a3..7d344c8 100644 --- a/Parser.pas +++ b/Parser.pas @@ -2608,8 +2608,6 @@ var maxDisp := disp; lSuppressMacroExpansions := suppressMacroExpansions; while true do begin - if (ip <> nil) and ip^.isForwardDeclared then - ResolveForwardReference(ip); if token.kind = rbracech then {fill remainder with zeros} goto 2; hasNestedDesignator := false; @@ -2669,6 +2667,8 @@ var if (ip = nil) or (ip^.itype^.size = 0) then goto 2; + if ip^.isForwardDeclared then + ResolveForwardReference(ip); disp := startingDisp + ip^.disp; if ip^.bitsize <> 0 then begin {zero out padding bits in bitfields} bfp := ip; From 736e7575cff86e5b3b9aa267f4dc12eccef5a709 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Sun, 4 Dec 2022 16:36:16 -0600 Subject: [PATCH 38/39] Fix issues with type conversions in static initialization. *Initialization of floating-point variables from unsigned long expressions with value > LONG_MAX would give the wrong value. *Initialization of floating-point variables from (unsigned) long long expressions would give the wrong value. *Initialization of _Bool variables should give 0 or 1, as per the usual rules for conversion to _Bool. *Initialization of integer variables from floating-point expressions should be allowed, applying the usual conversions. --- Parser.pas | 36 +++++++++++++++++++++++++++++++++--- Tests/Conformance/c99bool.c | 10 ++++++++++ cc.notes | 4 ++++ 3 files changed, 47 insertions(+), 3 deletions(-) diff --git a/Parser.pas b/Parser.pas index 7d344c8..4e7e388 100644 --- a/Parser.pas +++ b/Parser.pas @@ -220,6 +220,16 @@ function slt64(a,b: longlong): boolean; extern; function sgt64(a,b: longlong): boolean; extern; +{-- External conversion functions; imported from CGC.pas -------} + +procedure CnvXLL (var result: longlong; val: extended); extern; + +procedure CnvXULL (var result: longlong; val: extended); extern; + +function CnvLLX (val: longlong): extended; extern; + +function CnvULLX (val: longlong): extended; extern; + {-- Parser Utility Procedures ----------------------------------} procedure Match {kind: tokenEnum; err: integer}; @@ -2073,16 +2083,36 @@ var iPtr^.qVal.hi := -1 else iPtr^.qVal.hi := 0; + if tp^.cType = ctBool then + iPtr^.iVal := ord(expressionValue <> 0); goto 2; end; {if} if bKind in [cgReal,cgDouble,cgComp,cgExtended] then begin - if etype^.baseType in [cgByte..cgULong] then - iPtr^.rVal := expressionValue + if etype^.baseType in [cgByte..cgULong] then begin + iPtr^.rVal := expressionValue; + if etype^.baseType = cgULong then + if expressionValue < 0 then + iPtr^.rVal := iPtr^.rVal + 4294967296.0; + end {if} else if etype^.baseType in [cgReal,cgDouble,cgComp,cgExtended] then - iPtr^.rval := realExpressionValue; + iPtr^.rval := realExpressionValue + else if eType^.baseType = cgQuad then + iPtr^.rVal := CnvLLX(llExpressionValue) + else if eType^.baseType = cgUQuad then + iPtr^.rVal := CnvULLX(llExpressionValue); goto 2; end; {if} + if (etype^.baseType in [cgReal,cgDouble,cgComp,cgExtended]) + and (bKind in [cgByte..cgULong,cgQuad,cgUQuad]) then begin + if tp^.cType = ctBool then + iPtr^.iVal := ord(realExpressionValue <> 0) + else if bKind = cgUQuad then + CnvXULL(iPtr^.qVal, realExpressionValue) + else + CnvXLL(iPtr^.qVal, realExpressionValue); + goto 2; + end; Error(47); errorFound := true; end; diff --git a/Tests/Conformance/c99bool.c b/Tests/Conformance/c99bool.c index 78d6e76..8492cfd 100644 --- a/Tests/Conformance/c99bool.c +++ b/Tests/Conformance/c99bool.c @@ -85,6 +85,16 @@ int main(void) { if (s.a || !s.b) goto Fail; + + _Bool b1 = 123; + _Bool b2 = -123.5; + _Bool b3 = 0.0; + static _Bool b4 = 0x100000000; + static _Bool b5 = 0.0001; + static _Bool b6 = -0.0; + + if (b1 != 1 || b2 != 1 || b3 != 0 || b4 != 1 || b5 != 1 || b6 != 0) + goto Fail; printf ("Passed Conformance Test c99bool\n"); return 0; diff --git a/cc.notes b/cc.notes index b1f0235..225f627 100644 --- a/cc.notes +++ b/cc.notes @@ -2009,6 +2009,10 @@ int foo(int[42]); 221. Structures with unnamed bit-fields were sometimes initialized incorrectly. +222. If an expression of type unsigned long and value greater than LONG_MAX was used in the initializer for a floating-point variable with static storage duration, the wrong value would be produced. + +223. Expressions of floating-point type could not be used in initializers for integer variables with static storage duration. This should be allowed, with a conversion performed as in the case of assignment. + -- Bugs from C 2.1.0 that have been fixed ----------------------------------- 1. In some situations, fread() reread the first 1K or so of the file. From f5f63563c62acd030374f21fefa4dd9c78dba460 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Sun, 4 Dec 2022 21:26:40 -0600 Subject: [PATCH 39/39] Add tests for designated initializers. --- Tests/Conformance/DOIT3 | 1 + Tests/Conformance/c11anonsu.c | 16 +++ Tests/Conformance/c99desinit.c | 208 +++++++++++++++++++++++++++++++++ 3 files changed, 225 insertions(+) create mode 100644 Tests/Conformance/c99desinit.c diff --git a/Tests/Conformance/DOIT3 b/Tests/Conformance/DOIT3 index aab0864..7bd9246 100644 --- a/Tests/Conformance/DOIT3 +++ b/Tests/Conformance/DOIT3 @@ -24,6 +24,7 @@ {1} c99tgmath.c {1} c99pragma.c {1} c99inline.c +{1} c99desinit.c {1} c11generic.c {1} c11align.c {1} c11noret.c diff --git a/Tests/Conformance/c11anonsu.c b/Tests/Conformance/c11anonsu.c index 9ba786d..42df0ca 100644 --- a/Tests/Conformance/c11anonsu.c +++ b/Tests/Conformance/c11anonsu.c @@ -55,6 +55,22 @@ int main(void) { if (s2p->d != 123.5) goto Fail; + struct S s3 = {.b = 10, 20, .a=30}; + + if (s3.a != 30) + goto Fail; + if (s3.b != 10) + goto Fail; + if (s3.c != 20) + goto Fail; + + struct S s4 = {.a=30, 10, 20.5, .d = 123.5}; + + if (s4.a != 30) + goto Fail; + if (s4.d != 123.5) + goto Fail; + if (sizeof(struct S) != sizeof(struct T)) goto Fail; diff --git a/Tests/Conformance/c99desinit.c b/Tests/Conformance/c99desinit.c new file mode 100644 index 0000000..4033b6b --- /dev/null +++ b/Tests/Conformance/c99desinit.c @@ -0,0 +1,208 @@ +/* + * Test of designated initializers (C99). + */ + +#include +#include +#include + +#ifndef __ORCAC__ +typedef long long comp; +#endif + +struct S1 { + int i; + union { + long x; + char y; + } u; + short a[3]; +} s1 = {8, .a[0] = 9, .u.y = 'F', .i = 50, .a = {[1]=1,2}, .a[1] = 10}; + +struct S2 { + char c; + unsigned char uc; + signed char sc; + short s; + unsigned short us; + int i; + unsigned int ui; + long l; + unsigned long ul; + long long ll; + unsigned long long ull; + _Bool b; + float f; + double d; + long double ld; + comp cp; + void *p; +} s2 = {.p = &s2, .i = 123.4, .ui = 70, -123456, 123456, .c = 'd', 'e', 'f', + .us = 78, .s = 40.1, .ll = 1234567890, 0x800000001, 123, 123.5, + .cp = 9876543210, .d = -456.5, -789.5, + }; + +struct S3 { + float f; + double d; + long double ld; +} s3 = {-123456LL, 3000000000U, 12345678900ULL}; + +char s4[] = {{123}, [3] = {'x'}}; + +struct S5 { + int :16; + signed int a:4; + signed int b:6; + signed int c:6; + int :0; + unsigned d:9; + int :12; + unsigned e:4; + unsigned f:16; + long g; + int :15; +} s5 = {-4, -5, 3, .g = 123456789, .d = 455, 8, 42345}; + +char *s6[4] = {s4, s4+1, [0]=0, [1]=s4+2, &s4[3], s4+4}; + +union U9 { + union U9 *p; + char s[6]; +} s9 = {&s9, .s = {"abcde"}, .s[1] = 'x'}; + +union U9 s10 = {&s9, .s = {"abcde"}, .s[1] = 'x', .p = &s10}; + +union U9 s11 = {&s9, .s[1] = 'x'}; + +struct S13 { + struct S13a { + struct S13b { + struct S13c { + int a; + int b; + } z; + } y; + } x; +} s13 = {13, .x.y.z = {.b = 14}}; + +int f1(int i) {return i * 2 + 1;} + +int main(void) { + struct S1 a1 = + {8, .a[0] = 9, .u.y = 'F', .i = 50, .a = {[1]=1,2}, .a[1] = 10}; + + struct S2 a2 = + {.p = &s2, .i = 123.4, .ui = 70, -123456, 123456, .c = 'd', 'e', 'f', + .us = 78, .s = 40.1, .ll = 1234567890, 0x800000001, 123, 123.5, + .cp = 9876543210, .d = -456.5, -789.5, + }; + + struct S3 a3 = {-123456LL, 3000000000U, 12345678900ULL}; + + char a4[] = {{123}, [3] = {'x'}}; + + struct S5 a5 = {-4, -5, 3, .g = 123456789, .d = 455, 8, 42345}; + + char *a6[4] = {s4, s4+1, [0]=0, [1]=s4+2, &s4[3], s4+4}; + + char a7[] = {"foo"[0], [1] = "foo"[2], "foo"[3]}; + + char a8[] = {"foo" != 0, [1] = "foo" == 0}; + + union U9 a9 = {&s9, .s = {"abcde"}, .s[1] = 'x'}; + + union U9 a10 = {&s9, .s = {"abcde"}, .s[1] = 'x', .p = &s10}; + + union U9 a11 = {&s9, .s[1] = 'x'}; + + struct S3 a12 = {.ld = f1(1)-8, .f = f1(2)*7, f1(3)+10}; + + struct S13 a13 = {s13.x.y}; + + if (s1.i!=50 || s1.u.y!='F' || s1.a[0]!=0 || s1.a[1]!=10 || s1.a[2]!=2) + goto Fail; + + if (a1.i!=50 || a1.u.y!='F' || a1.a[0]!=0 || a1.a[1]!=10 || a1.a[2]!=2) + goto Fail; + + if (s2.c != 'd' || s2.uc != 'e' || s2.sc != 'f' || s2.s != 40 + || s2.us != 78 || s2.i != 123 || s2.ui != 70 || s2.l != -123456 + || s2.ul != 123456 || s2.ll != 1234567890 + || s2.ull != 0x800000001 || s2.b != 1 || s2.f != 123.5 + || s2.d != -456.5 || s2.ld != -789.5 || s2.cp != 9876543210 + || s2.p != &s2) + goto Fail; + + if (a2.c != 'd' || a2.uc != 'e' || a2.sc != 'f' || a2.s != 40 + || a2.us != 78 || a2.i != 123 || a2.ui != 70 || a2.l != -123456 + || a2.ul != 123456 || a2.ll != 1234567890 + || a2.ull != 0x800000001 || a2.b != 1 || a2.f != 123.5 + || a2.d != -456.5 || a2.ld != -789.5 || a2.cp != 9876543210 + || a2.p != &s2) + goto Fail; + + if (s3.f != -123456.0 || s3.d != 3000000000.0 || s3.ld != 12345678900.0) + goto Fail; + + if (a3.f != -123456.0 || a3.d != 3000000000.0 || a3.ld != 12345678900.0) + goto Fail; + + if (sizeof(s4) != 4 || s4[0] != 123 || s4[1] != 0 || s4[2] != 0 + || s4[3] != 'x') + goto Fail; + + if (sizeof(a4) != 4 || a4[0] != 123 || a4[1] != 0 || a4[2] != 0 + || a4[3] != 'x') + goto Fail; + + if (s5.a != -4 || s5.b != -5 || s5.c != 3 || s5.d != 455 || s5.e != 8 + || s5.f != 42345 || s5.g != 123456789) + goto Fail; + + if (a5.a != -4 || a5.b != -5 || a5.c != 3 || a5.d != 455 || a5.e != 8 + || a5.f != 42345 || a5.g != 123456789) + goto Fail; + + if (s6[0] != 0 || s6[1] != &s4[2] || s6[2] != &s4[3] || s6[3] != s4+4) + goto Fail; + + if (a6[0] != 0 || a6[1] != &s4[2] || a6[2] != &s4[3] || a6[3] != s4+4) + goto Fail; + + if (sizeof(a7) != 3 || a7[0] != 'f' || a7[1] != 'o' || a7[2] != 0) + goto Fail; + + if (sizeof(a8) != 2 || a8[0] != 1 || a8[1] != 0) + goto Fail; + + if (strcmp(s9.s, "axcde") != 0) + goto Fail; + + if (strcmp(a9.s, "axcde") != 0) + goto Fail; + + if (s10.p != &s10) + goto Fail; + + if (a10.p != &s10) + goto Fail; + + if (s11.s[1] != 'x') + goto Fail; + + if (a11.s[1] != 'x') + goto Fail; + + if (a12.f != 35 || a12.d != 17 || a12.ld != -5) + goto Fail; + + if (a13.x.y.z.a != 0 || a13.x.y.z.b != 14) + goto Fail; + + printf ("Passed Conformance Test c99desinit\n"); + return 0; + +Fail: + printf ("Failed Conformance Test c99desinit\n"); +}