diff --git a/ORCACDefs/stdarg.h b/ORCACDefs/stdarg.h index 8459cd9..dc74811 100644 --- a/ORCACDefs/stdarg.h +++ b/ORCACDefs/stdarg.h @@ -14,6 +14,11 @@ * * Thanks to Doug Gwyn for the new va_start & va_arg declarations. * +***************************************************************** +* +* Modified October 2021 for better standards conformance. +* This version will only work with ORCA/C 2.2.0 B6 or later. +* ****************************************************************/ #ifndef __stdarg__ @@ -25,12 +30,12 @@ typedef char *__va_list[2]; #endif typedef __va_list va_list; -#define va_end(a) __va_end(a) -#define va_start(ap,LastFixedParm) ((void) ((ap)[0] = (ap)[1] = (char *) (&LastFixedParm + 1))) -#define va_arg(ap,type) _Generic(*(type *)0, \ +#define va_end(ap) __record_va_info(ap) +#define va_start(ap,LastFixedParm) ((void) ((ap)[0] = (char *) (&LastFixedParm + 1), (ap)[1] = (char *)&__orcac_va_info)) +#define va_arg(ap,type) _Generic(*(type *)0, \ double: (type)((long double *)((ap)[0] += sizeof(long double)))[-1], \ default: ((type *)((ap)[0] += sizeof(type)))[-1]) -void __va_end(va_list); +void __record_va_info(va_list); #endif diff --git a/Parser.pas b/Parser.pas index 4174227..70ff539 100644 --- a/Parser.pas +++ b/Parser.pas @@ -186,6 +186,7 @@ var doingForLoopClause1: boolean; {doing the first clause of a for loop?} compoundLiteralNumber: integer; {number of compound literal} compoundLiteralToAllocate: identPtr; {compound literal that needs space allocated} + vaInfoLLN: integer; {label number of internal va info (0 for none)} {parameter processing variables} {------------------------------} @@ -362,6 +363,11 @@ if not doingFunction then begin {if so, finish it off} end; {else if} end; {if} Gen1(dc_lab, returnLabel); + if vaInfoLLN <> 0 then begin {clean up variable args, if any} + Gen2(pc_lda, vaInfoLLN, 0); + Gen0t(pc_stk, cgULong); + Gen1tName(pc_cup, -1, cgVoid, @'__va_end'); + end; {if} with fType^ do {generate the pc_ret instruction} case kind of scalarType : Gen0t(pc_ret, baseType); @@ -3884,6 +3890,18 @@ if isFunction then begin GenParameters(fnType^.parameterList); savedVolatile := volatile; functionTable := table; + if fnType^.varargs then begin {make internal va info for varargs funcs} + lp := NewSymbol(@'__orcac_va_info', vaInfoPtr, autosy, + variableSpace, declared); + lp^.lln := GetLocalLabel; + Gen2(dc_loc, lp^.lln, ord(vaInfoPtr^.size)); + Gen2(pc_lda, lastParameterLLN, lastParameterSize); + Gen2t(pc_cop, lp^.lln, 0, cgULong); + Gen2t(pc_str, lp^.lln, cgPointerSize, cgULong); + vaInfoLLN := lp^.lln; + end {if} + else + vaInfoLLN := 0; CompoundStatement(false); {process the statements} end; {else} end; {else} diff --git a/Symbol.pas b/Symbol.pas index 7578a64..b602aac 100644 --- a/Symbol.pas +++ b/Symbol.pas @@ -45,6 +45,8 @@ { boolPtr - pointer to the base type for _Bool } { voidPtr - pointer to the base type for void } { voidPtrPtr - typeless pointer, for some type casting } +{ charPtrPtr - pointer to type record for char * } +{ vaInfoPtr - pointer to type record for internal va info type } { stringTypePtr - pointer to the base type for string literals } { utf16StringTypePtr - pointer to the base type for UTF-16 } { string literals } @@ -82,11 +84,16 @@ var globalTable: symbolTablePtr; {global symbol table} functionTable: symbolTablePtr; {table for top level of current function} + {output from GenParameters} + lastParameterLLN: integer; {label number of last parameter (0 if none)} + lastParameterSize: integer; {size of last parameter} + {base types} charPtr,sCharPtr,uCharPtr,shortPtr,uShortPtr,intPtr,uIntPtr,int32Ptr, uInt32Ptr,longPtr,uLongPtr,longLongPtr,uLongLongPtr,boolPtr, floatPtr,doublePtr,compPtr,extendedPtr,stringTypePtr,utf16StringTypePtr, - utf32StringTypePtr,voidPtr,voidPtrPtr,constCharPtr,defaultStruct: typePtr; + utf32StringTypePtr,voidPtr,voidPtrPtr,charPtrPtr,vaInfoPtr,constCharPtr, + defaultStruct: typePtr; {---------------------------------------------------------------} @@ -134,6 +141,10 @@ procedure GenParameters (pp: parameterPtr); { } { parameters: } { pp - pointer to first parameter } +{ } +{ variables: } +{ lastParameterLLN - label number of last parameter } +{ lastParameterSize - size of last parameter } procedure GenSymbols (sym: symbolTablePtr; doGlobals: boolean); @@ -945,6 +956,10 @@ procedure GenParameters {pp: parameterPtr}; { } { parameters: } { pp - pointer to first parameter } +{ } +{ variables: } +{ lastParameterLLN - label number of last parameter } +{ lastParameterSize - size of last parameter } var i: 0..hashSize; {loop variable} @@ -954,6 +969,8 @@ var tk: tokenType; {symbol name token} begin {GenParameters} +pln := 0; +size := 0; if pp <> nil then begin {prototyped parameters} tk.kind := ident; tk.numString := nil; @@ -965,8 +982,10 @@ if pp <> nil then begin {prototyped parameters} sp := FindSymbol(tk, variableSpace, true, false); if sp = nil then sp := pp^.parameter; - if sp^.itype^.kind = arrayType then - Gen3(dc_prm, pln, cgPointerSize, sp^.pdisp) + if sp^.itype^.kind = arrayType then begin + size := cgPointerSize; + Gen3(dc_prm, pln, cgPointerSize, sp^.pdisp); + end {if} else begin size := long(sp^.itype^.size).lsw; if (size = 1) and (sp^.itype^.kind = scalarType) then @@ -982,9 +1001,12 @@ else begin {K&R parameters} sp := table^.buckets[i]; while sp <> nil do begin if sp^.storage = parameter then begin - sp^.pln := GetLocalLabel; - if sp^.itype^.kind = arrayType then - Gen3(dc_prm, sp^.lln, cgPointerSize, sp^.pdisp) + pln := GetLocalLabel; + sp^.pln := pln; + if sp^.itype^.kind = arrayType then begin + size := cgPointerSize; + Gen3(dc_prm, sp^.lln, cgPointerSize, sp^.pdisp); + end {if} else begin size := long(sp^.itype^.size).lsw; if (size = 1) and (sp^.itype^.kind = scalarType) then @@ -996,6 +1018,8 @@ else begin {K&R parameters} end; {while} end; {for} end; {else} +lastParameterLLN := pln; +lastParameterSize := size; end; {GenParameters} @@ -1605,6 +1629,23 @@ with voidPtrPtr^ do begin kind := pointerType; pType := voidPtr; end; {with} +new(charPtrPtr); {char *} +with charPtrPtr^ do begin + size := cgPointerSize; + saveDisp := 0; + qualifiers := []; + kind := pointerType; + pType := charPtr; + end; {with} +new(vaInfoPtr); {internal varargs info type (char*[2])} +with vaInfoPtr^ do begin + size := cgPointerSize*2; + saveDisp := 0; + qualifiers := []; + kind := arrayType; + aType := charPtrPtr; + elements := 2; + end; {with} new(defaultStruct); {default structure} with defaultStruct^ do begin {(for structures with errors)} size := cgWordSize; diff --git a/cc.notes b/cc.notes index 420ae4c..a04243f 100644 --- a/cc.notes +++ b/cc.notes @@ -216,6 +216,10 @@ Unions can be initialized by a brace-enclosed expression giving the initializer union nums {float f; int i;} x = {0.0}; +p. 297 + +Variable argument lists will now work even if stack repair code is enabled. + p. 311 If integer overflow occurs during signed integer multiplication, the resulting value is not predictable. Contrary to what the description in the manual implies, it will not necessarily be the low-order bits from the true product of the operands. @@ -304,6 +308,10 @@ p. 405 The discussion of _toupper should note that _toupper is an extension to ANSI C. +p. 406 + +va_end is now a macro, not a function. Also, the va_arg, va_end, and va_start macros will now work even if stack repair code is enabled. + p. 444,445 The control codes to turn the cursor on and off are no longer used in the .CONSOLE driver, which is what the current version of ORCA/C uses for all text output. In the .CONSOLE driver, the cursor is always off unless it is waiting for a character. @@ -1378,6 +1386,8 @@ int foo(int[42]); 169. If an assembly-language function (declared with the asm keyword) had a structure or union return type, ORCA/C would generate some spurious code at the beginning of the function, which might trash data used by its caller. +170. Variable argument processing could not be restarted by calling va_start() after va_end(). Also, the addresses of local variables would change when va_end() was called, invalidating any pointers to them. The implementation of variable arguments has been changed to fix these problems. The only remaining non-standard restriction is that if #pragma optimize bit 6 or #pragma debug bit 4 is set, calls to functions taking variable arguments are not allowed to pass extra arguments beyond the number that the function will use. + -- Bugs from C 2.1.0 that have been fixed ----------------------------------- 1. In some situations, fread() reread the first 1K or so of the file.