Revise variable argument handling to better comply with standards.

In the new implementation, variable arguments are not removed until the end of the function. This allows variable argument processing to be restarted, and it prevents the addresses of local variables from changing in the middle of the function. The requirement to turn off stack repair code around varargs functions is also removed.

This fixes #58.

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_end(ap) __record_va_info(ap)
-#define	va_start(ap,LastFixedParm) ((void) ((ap)[0] = (ap)[1] = (char *) (&LastFixedParm + 1)))
+#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, \
+#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

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}

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
+      if sp^.itype^.kind = arrayType then begin
-	 Gen3(dc_prm, pln, cgPointerSize, sp^.pdisp)
+         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;
+            pln := GetLocalLabel;
-            if sp^.itype^.kind = arrayType then
+            sp^.pln := pln;
-               Gen3(dc_prm, sp^.lln, cgPointerSize, sp^.pdisp)
+            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;

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.