Detect some erroneous numeric constants that were being allowed.

These include tokens like 0x, 0b, and 1.2LL.

Asm.pas

@@ -166,10 +166,8 @@ var
    { An error was found: skip to the end & quit                 }
 
    begin {Skip}
-   charKinds[ord('#')] := ch_pound;
    while not (token.kind in [rbracech,eofsy]) do
       NextToken;
-   charKinds[ord('#')] := illegal;
    goto 99;
    end; {Skip}
 
@@ -226,6 +224,7 @@ var
             size := longAddress;
          end {if}
       else begin
+         id^.used := true;
          operand.symbolPtr := id;
          if id^.storage in [stackFrame,parameter] then begin
             code^.slab := id^.lln;
@@ -329,7 +328,6 @@ while not (token.kind in [rbracech,eofsy]) do begin
 
    {find the label and op-code}
    CheckForComment;
-   charKinds[ord('#')] := ch_pound;     {allow # as a token}
    if token.kind <> ident then begin    {error if not an identifier}
       Error(9);
       Skip;
@@ -345,7 +343,6 @@ while not (token.kind in [rbracech,eofsy]) do begin
       opname := token;
       NextToken;
       end; {while}
-   charKinds[ord('#')] := illegal;      {don't allow # as a token}
 
    {identify the op-code}
    if length(opname.name^) = 3 then begin
@@ -568,13 +565,18 @@ while not (token.kind in [rbracech,eofsy]) do begin
    {handle data declarations}
    else if opc <= o_dcl then begin
       Exp([semicolonch], true);
-      code^.s := d_add;
-      if opc = o_dcb then
-         code^.r := ord(direct)
-      else if opc = o_dcw then
-         code^.r := ord(absolute)
-      else
+      if opc = o_dcb then begin
+         code^.s := d_dcb;
+         code^.r := ord(direct);
+         end {if}
+      else if opc = o_dcw then begin
+         code^.s := d_dcw;
+         code^.r := ord(absolute);
+         end {else if}
+      else begin
+         code^.s := d_dcl;
          code^.r := ord(longabsolute);
+         end; {else}
       end {if opc <= o_dcl}
 
    {handle the brk instruction}

C.Read.Me

@@ -0,0 +1,44 @@
+Welcome to ORCA/C 2.2.1!  This is a release containing updates from
+community members (Stephen Heumann and Kelvin Sherlock).
+
+ORCA/C 2.2 adds support for almost all of the new language and library
+features required by the C17 standard.  It also has several other new
+features, such as additional lint checks to help identify bugs and
+portability problems.  In addition to these new features, ORCA/C 2.2
+includes hundreds of bug fixes in the compiler and libraries.
+
+ORCA/C 2.2.1 includes additional bug fixes to ORCA/C 2.2.0.
+
+The ORCA/C manual has been fully updated to cover ORCA/C 2.2, so new
+users should simply refer to that.  Users familiar with older versions
+of ORCA/C can refer to the cc.notes file in the Release.Notes directory
+for a description of the changes between ORCA/C 2.0 and ORCA/C 2.2.1.
+
+ORCA/C 2.2.1 requires a real or emulated Apple IIGS with at least the
+following specifications:
+
+* 2 MB of RAM (3 MB or more recommended)
+* a hard drive or SSD
+* System 6.0.1 or later
+
+ORCA/C can also be run on modern Mac, Windows, or Linux systems as a
+cross compiler by using Golden Gate, a specialized emulation tool by
+Kelvin Sherlock.  It is available separately from Juiced.GS:
+https://juiced.gs/store/golden-gate/
+
+If you have any questions, or if you want to get involved in ORCA/C
+development, please get in touch.  The ORCA/C development project is
+hosted on GitHub, and bug reports or patches can be submitted there:
+https://github.com/byteworksinc/ORCA-C
+
+Thanks to:
+* Mike Westerfield, for writing ORCA/C, releasing the source code,
+  and permitting it to be updated by the community.
+* Kelvin Sherlock, for providing several patches and bug reports, and
+  for writing several useful tools for modern Apple II development.
+* Soenke Behrens, for compiling a list of ORCA/C bug reports and test
+  cases, which has helped me to identify and fix a number of bugs.
+* The developers of Csmith (http://embed.cs.utah.edu/csmith/), an
+  automated compiler testing tool that has helped to find several bugs.
+
+--Stephen Heumann (stephenheumann@gmail.com)

C.Samples/Benchmarks/FIB.cc

@@ -0,0 +1,46 @@
+/***************************************************************
+*
+*  Fibonacci
+*
+*  Recursively computes Fibonacci numbers to test the speed of
+*  function calls.
+*
+*  To get the best performance from the desktop development
+*  environment, be sure and turn debugging off from the
+*  Compile Dialog.  Use the Compile command from the Run menu
+*  to get the compile dialog.
+*
+****************************************************************/
+
+#pragma keep "FIB"
+#pragma optimize -1
+#pragma lint -1
+
+#include <stdio.h>
+
+#define NTIMES 10                       /* # iterations */
+#define NUMBER 23                       /* largest Fib # smaller than 32767 */
+
+
+int Fibonacci(int x)
+
+{
+if (x > 2)
+   return Fibonacci(x-1)+Fibonacci(x-2);
+else
+   return 1;
+}
+
+
+int main (void)
+
+{
+int value;
+unsigned i;
+
+printf("%d iterations:\n", NTIMES);
+for (i = 0; i < NTIMES; ++i)
+   value = Fibonacci(NUMBER);
+printf("Fibonacci(%d) = %d\n", NUMBER, value);
+return 0;
+}

C.Samples/Benchmarks/Float.cc

@@ -0,0 +1,51 @@
+/***************************************************************
+*
+*  Float
+*
+*  Test simple floating point operations.
+*
+*  To get the best performance from the desktop development
+*  environment, be sure and turn debugging off from the
+*  Compile Dialog.  Use the Compile command from the Run menu
+*  to get the compile dialog.
+*
+***************************************************************/
+
+#pragma keep "Float"
+#pragma optimize -1
+#pragma lint -1
+
+#include <stdio.h>
+
+#define const1 3.141597
+#define const2 1.7839032e4
+#define count 1000
+
+int main(void)
+
+{
+double a,b,c;
+int i;
+
+a = const1;
+b = const2;
+printf("%d iterations.\n", count);
+for (i = 0; i < count; ++i) {
+  c = a*b;
+  c = c/a;
+  c = a*b;
+  c = c/a;
+  c = a*b;
+  c = c/a;
+  c = a*b;
+  c = c/a;
+  c = a*b;
+  c = c/a;
+  c = a*b;
+  c = c/a;
+  c = a*b;
+  c = c/a;
+  }
+printf("Done.  C is %e.\n", c);
+return 0;
+}

C.Samples/Benchmarks/Gamm.cc

@@ -0,0 +1,114 @@
+/***************************************************************
+*
+*  Gamm
+*
+*  Test the speed of floating point operations in a mix tha
+*  is typical of scientific and engineering applications.
+*
+*  To get the best performance from the desktop development
+*  environment, be sure and turn debugging off from the
+*  Compile Dialog.  Use the Compile command from the Run menu
+*  to get the compile dialog.
+*
+***************************************************************/
+
+#pragma keep "Gamm"
+#pragma optimize -1
+#pragma lint -1
+
+#include <stdio.h>
+
+
+int main (void)
+
+{
+int five,i,j,n,rep,ten,thirty;
+float acc,acc1,divn,rn,root,x,y;
+float a[30], b[30], c[30];
+
+printf("Start timing 15000 Gamm units\n");
+n = 50;
+five = 5;
+ten = 10;
+thirty = 30;
+rn = n;
+divn = 1.0/rn;
+x = 0.1;
+acc = 0.0;
+
+/* initialize a and b */
+y = 1.0;
+for (i = 0; i < thirty; ++i) {
+  a[i] = i+1;
+  b[i] = -y;
+  y = -y;
+  };
+
+/* one pass thru this loop corresponds to 300 gamm units */
+for (rep = 0; rep < n; ++rep) {
+  /* first addition/subtraction loop */
+  i = 29;
+  for (j = 0; j < 30; ++j) {
+    c[i] = a[i]+b[i];
+    --i;
+    };
+  /* first polynomial loop */
+  y = 1.0;
+  for (i = 0; i < 10; ++i)
+    y = (y+c[i])*x;
+  acc1 = y*divn;
+  /* first maximum element loop */
+  y = c[10];
+  for (i = 10; i < 20; ++i)
+    if (c[i] > y)
+      y = c[i];
+  /* first square root loop */
+  root = 1.0;
+  for (i = 0; i < 5; ++i)
+    root = 0.5*(root+y/root);
+  acc1 = acc1+root*divn;
+  /* second addition/subtraction loop */
+  for (i = 0; i < 30; ++i)
+    a[i] = c[i]-b[i];
+  /* second polynomial loop */
+  y = 0.0;
+  for (i = 0; i < 10; ++i)
+    y = (y+a[i])*x;
+  /* second square root loop */
+  root = 1.0;
+  for (i = 1; i < 5; ++i)
+    root = 0.5*(root+y/root);
+  acc1 = acc1+root*divn;
+  /* first multiplication loop */
+  for (i = 0; i < thirty; ++i)
+    c[i] = c[i]*b[i];
+  /* second maximum element loop */
+  y = c[19];
+  for (i = 20; i < thirty; ++i)
+    if (c[i] > y)
+      y = c[i];
+  /* third square root loop */
+  root = 1.0;
+  for (i = 0; i < 5; ++i)
+    root = 0.5*(root+y/root);
+  acc1 = acc1+root*divn;
+  /* third polynomial loop */
+  y = 0.0;
+  for (i = 0; i < 10; ++i)
+    y = (y+c[i])*x;
+  acc1 = acc1+y*divn;
+  /* third maximum element loop */
+  y = c[0];
+  for (i = 1; i < 10; ++i);
+    if (c[i] > y)
+      y = c[i];
+  /* fourth square root loop */
+  root = 1.0;
+  for (i = 0; i < 5; ++i)
+    root = 0.5*(root+y/root);
+  acc1 = acc1+root*divn;
+  acc = acc+acc1;
+  }
+printf("%12d  %12.7e  %12.7e\n", n, acc, acc1);
+return 0;
+}

C.Samples/Benchmarks/IMath.cc

@@ -0,0 +1,56 @@
+/***************************************************************
+*
+*  Integer Math
+*
+*  Test the speed of the four basic integer math operations.
+*
+*  To get the best performance from the desktop development
+*  environment, be sure and turn debugging off from the
+*  Compile Dialog.  Use the Compile command from the Run menu
+*  to get the compile dialog.
+*
+****************************************************************/
+
+#pragma keep "IMath"
+#pragma optimize -1
+#pragma lint -1
+
+#include <stdio.h>
+
+#define ITER 10000
+
+
+int main (void)
+
+{
+int a,b,c,d,e,f;
+unsigned i;
+
+printf("Start timing...\n");
+b = 1000;
+c = 10;
+d = 100;
+e = 5;
+f = 10;
+for (i = 0; i < ITER; ++i) {
+   a = b+c-d*e/f;
+   a = b+c-d*e/f;
+   a = b+c-d*e/f;
+   a = b+c-d*e/f;
+   a = b+c-d*e/f;
+   a = b+c-d*e/f;
+   a = b+c-d*e/f;
+   a = b+c-d*e/f;
+   a = b+c-d*e/f;
+   a = b+c-d*e/f;
+   a = b+c-d*e/f;
+   }
+if (a == 960) {
+   printf("Stop timing - correct result.\n");
+   return 0;
+   }
+else {
+   printf("INCORRECT RESULT.\n");
+   return -1;
+   }
+}

C.Samples/Benchmarks/Prime.cc

@@ -0,0 +1,50 @@
+/***************************************************************
+*
+*  This is probably the most famous benchmark in use today.
+*  It tests the speed that a compiler can do logic and looping
+*  operations.  While there are things that you can do to make
+*  this benchmark run faster under ORCA/C, we have not
+*  doctored it in any way - this is the original benchmark
+*  in its original form.
+*
+*  To get the best performance from the desktop development
+*  environment, be sure and turn debugging off from the
+*  Compile Dialog.  Use the Compile command from the Run menu
+*  to get the compile dialog.
+*
+***************************************************************/
+
+#pragma keep "Prime"
+#pragma optimize -1
+#pragma lint -1
+
+#include <stdio.h>
+
+#define true 1
+#define false 0
+#define size 8190
+
+char flags[size+1];
+
+void main (void)
+
+{
+int i,prime,k,count,iter;
+
+printf("10 iterations\n");
+for (iter = 1; iter <= 10; iter++) {
+   count = 0;
+   for (i = 0; i <= size; i++)
+      flags[i] = true;
+   for (i = 0; i <= size; i++) {
+      if (flags[i]) {
+         prime = i+i+3;
+      /* printf("\n%d", prime); */
+         for (k = i+prime; k <= size; k += prime)
+            flags[k] = false;
+         count++;
+         }
+      }
+   }
+   printf("\n%d primes.", count);
+}

C.Samples/Benchmarks/Quick.cc

@@ -0,0 +1,96 @@
+/***************************************************************
+*
+*  QuickSort
+*
+*  Creates an array of long integers, then sorts the array.
+*
+*  To get the best performance from the desktop development
+*  environment, be sure and turn debugging off from the
+*  Compile Dialog.  Use the Compile command from the Run menu
+*  to get the compile dialog.
+*
+***************************************************************/
+
+#pragma keep "Quick"
+#pragma optimize -1
+#pragma lint -1
+
+#include <stdio.h>
+#include <stdlib.h>
+
+#define maxNum 999                      /* size of array to sort - 1 */
+#define count 10                        /* # of iterations */
+#define modulus 0x00020000              /* for random number generator */
+#define c 13849
+#define a 25173
+
+typedef long arrayType[maxNum];
+
+arrayType buffer;                       /* array to sort */
+long seed;                              /* seed for random number generator */
+
+
+void Quick (int lo, int hi, arrayType base)
+
+{
+int i,j;
+long pivot,temp;
+
+if (hi > lo) {
+  pivot = base[hi];
+  i = lo-1;
+  j = hi;
+  do {
+    do ++i; while ((base[i] < pivot) && (j > i));
+    if (j > i)
+       do --j; while ((base[j] > pivot) && (j > i));
+    temp = base[i];
+    base[i] = base[j];
+    base[j] = temp;
+    }
+  while (j > i);
+  base[j] = base[i];
+  base[i] = base[hi];
+  base[hi] = temp;
+  Quick(lo, i-1, base);
+  Quick(i+1, hi, base);
+  }
+}
+
+
+long Random (long size)
+
+{
+seed = seed*a+c;
+return seed % size;
+}
+
+
+int main (void)
+
+{
+int i,j;                                /* loop variables */
+int pass;                               /* for checking the array */
+
+seed = 7;
+printf("Filling array and sorting %d times.\n", count);
+for (i = 0; i < count; ++i) {
+  for (j = 0; j < maxNum; ++j)
+    buffer[j] = labs(Random(modulus));
+  Quick(0, maxNum-1, buffer);
+  }
+printf("Done.\n");
+
+pass = 1;
+for (i = 0; i < maxNum-1; ++i)
+  if (buffer[i] > buffer[i+1])
+    pass = 0;
+if (pass) {
+  printf("The last array is sorted properly.\n");
+  return 0;
+  }
+else {
+  printf("The last array is NOT sorted properly!\n");
+  return -1;
+  }
+}

C.Samples/Benchmarks/Savage.cc

@@ -0,0 +1,35 @@
+/***************************************************************
+*
+*  Savage
+*
+*  Test the speed (and stability) of floating point functions.
+*
+*  To get the best performance from the desktop development
+*  environment, be sure and turn debugging off from the
+*  Compile Dialog.  Use the Compile command from the Run menu
+*  to get the compile dialog.
+*
+****************************************************************/
+
+#pragma keep "Savage"
+#pragma optimize -1
+#pragma lint -1
+
+#define loop 250
+
+#include <stdio.h>
+#include <math.h>
+
+int main (void)
+
+{
+int i;
+double sum;
+
+printf("Start...\n");
+sum = 1.0;
+for (i = 1; i < loop; ++i)
+   sum = tan(atan(exp(log(sqrt(sum*sum)))))+1.0;
+printf("sum = %e", sum);
+return 0;
+}

C.Samples/CDA.Samples/Calendar.cc

@@ -0,0 +1,288 @@
+/***************************************************************
+*
+*  Calendar
+*
+*  This classic desk accessory shows the calendar for the
+*  current date.  The arrow keys can be used to see calendars
+*  for previous or future months.
+*
+*  Commands (each is a single keystroke)
+*
+*       up-arrow        Look at the same month in the previous
+*                       year.
+*       down-arrow      Look at the same month in the next
+*                       year.
+*       left-arrow      Look at the previous month.
+*       right-arrow     Look at the next month.
+*       ? or /          Display help screen.
+*       ESC             Return to CDA main menu.
+*
+*  Mike Westerfield
+*
+*  Copyright 1987-1989
+*  Byte Works, Inc.
+*
+***************************************************************/
+
+#pragma keep "Calendar"
+#pragma cda "Calendar" Start ShutDown
+#pragma lint -1
+
+#include <stddef.h>
+#include <stdio.h>
+#include <time.h>
+#include <misctool.h>
+
+#define LEFT_ARROW	0x08		/* key codes for legal commands */
+#define DOWN_ARROW	0x0A
+#define UP_ARROW	0x0B
+#define RIGHT_ARROW	0x15
+#define ESC		0x1B
+#define SLASH		'/'
+#define QUESTION	'?'
+
+int ch;					/* ord of last character read */
+int month, year;			/* current month and year */
+
+/****************************************************************
+*
+*  Factor:  Computes the 'factor' for the first day of the
+*           month.  The factor is the number of days since
+*           31 Dec 0000.
+*
+****************************************************************/
+
+long Factor (long year, long month)
+
+{
+if (month < 2)
+    return 365 * year + 1 + 31 * month + (year - 1) / 4 -
+              ((year - 1) / 100 + 1) * 3 / 4;
+return 365 * year + 1 + 31 * month - ((month + 1) * 4 + 23) / 10 +
+              year / 4 - (year / 100 + 1) * 3 / 4;
+}
+
+/****************************************************************
+*
+*  GetKey:  Returns the ordinal value of the next key typed
+*           by the user.
+*
+****************************************************************/
+
+int GetKey (void)
+
+{
+char ch, *cp;
+
+cp = (char *) 0x00C000;			/* wait for keypress */
+while ((*cp & 0x80) == 0) ;
+ch = *cp;				/* save the key */
+cp = (char *) 0x00C010;			/* clear the strobe */
+*cp = 0;
+return ch & 0x7F;			/* return the key read */
+}
+
+/****************************************************************
+*
+*  GetThisMonth:  Reads the clock to obtain today's month
+*
+****************************************************************/
+
+void GetThisMonth (void)
+
+{
+time_t lt;				/* encoded time */
+struct tm *ct;				/* current time */
+
+lt = time(NULL);			/* get the coded time */
+ct = gmtime(&lt);			/* convert to a decoded time */
+year = ct->tm_year + 1900;		/* set the month/year */
+month = ct->tm_mon;
+}
+
+/****************************************************************
+*
+*  GotoXY:  Positions the cursor
+*
+****************************************************************/
+
+void GotoXY (int x, int y)
+
+{
+putchar(0x1E);
+putchar(0x20 + x);
+putchar(0x20 + y);
+}
+
+/****************************************************************
+*
+*  PrintCalendar:  Prints the calendar for the current
+*                  and year.
+*
+****************************************************************/
+
+void PrintCalendar (void)
+
+{
+#define TAB	26			/* disp of calendar from left edge */
+#define VTAB	5			/* disp of calendar from top */
+
+int startDay,				/* day of week for 1st day in month */
+    numDays,				/* # days in the month */
+    nextMonth, nextYear,		/* work variables */
+    i,					/* loop variable */
+    vt,					/* line # for next line of days */
+    pos;				/* day position for next date */
+
+/* Compute day of week for 1st day in month */
+startDay = (int) ((Factor (year, month) - 1) % 7);
+nextMonth = month+1;			/* compute # days in month */
+if (nextMonth == 12) {
+   nextMonth = 0;
+   nextYear = year+1;
+   }
+else
+   nextYear = year;
+numDays = (int) (Factor (nextYear, nextMonth) - Factor (year, month));
+
+putchar(12);				/* clear the screen */
+GotoXY(TAB+7, VTAB);			/* position cursor */
+switch (month) {			/* write the month */
+   case 0:  printf(" January ");     break;
+   case 1:  printf("February ");     break;
+   case 2:  printf("  March ");      break;
+   case 3:  printf("  April ");      break;
+   case 4:  printf("   May ");       break;
+   case 5:  printf("  June ");       break;
+   case 6:  printf("  July ");       break;
+   case 7:  printf(" August ");      break;
+   case 8:  printf("September ");    break;
+   case 9:  printf(" October ");     break;
+   case 10: printf("November ");     break;
+   case 11: printf("December ");
+   }
+printf("%d", year);			/* write the year */
+GotoXY(TAB, VTAB+2);			/* write the day header line */
+printf("Sun Mon Tue Wed Thu Fri Sat");
+vt = VTAB+4;				/* set current date line */
+pos = 0;				/* set day position */
+GotoXY(TAB-1, vt);			/* position cursor for 1st line */
+for (i = 1; i <= startDay; i++) {	/* skip over blank days */
+   pos++;
+   printf("    ");
+   }
+
+/* Write the dates */
+for (i = 1; i <= numDays; i++) {
+   printf("%4d", i);
+   pos++;
+   if (pos == 7) {
+      pos = 0;
+      vt += 2;
+      GotoXY(TAB-1, vt);
+      }
+   }
+GotoXY(25, 23);				/* write instructions */
+printf("Hit ? for help,  or ESC to quit");
+}
+
+/****************************************************************
+*
+*  PrintHelp:  Print the help screen.
+*
+****************************************************************/
+
+void PrintHelp (void)
+
+{
+int ch;					/* dummy variable for reading keyboard */
+
+putchar(0x0C);				/* clear screen */
+printf( "This program recognizes the following single-keystroke commands:"
+        "\n\n"
+        "     key             action\n"
+        "     ---             ------\n"
+        "     up-arrow        Show the current month in the previous year.\n"
+        "     down-arrow      Show the current month in the next year.\n"
+        "     left-arrow      Show the previous month.\n"
+        "     right-arrow     Show the next month.\n"
+        "     ESC             exit the program.");
+
+GotoXY(0, 23);
+printf("Hit any key to return to the program.");
+ch = GetKey();
+}
+
+/**************************************************************
+*
+*  Start:  Body of calendar program
+*
+**************************************************************/
+
+void Start(void)
+
+{
+putchar('\006');			/* turn the cursor off */
+GetThisMonth();				/* find out what month it is */
+PrintCalendar();			/* print the calendar for this month */
+do {
+   ch = GetKey();			/* get a command */
+   switch (ch) {
+      case LEFT_ARROW: {
+         month--;
+         if (month < 0) {
+            month = 11;
+            year--;
+            }
+         PrintCalendar();
+         break;
+         }
+
+      case RIGHT_ARROW: {
+         month++;
+         if (month > 11) {
+            month = 0;
+            year++;
+            }
+         PrintCalendar();
+         break;
+         }
+
+      case UP_ARROW: {
+         year--;
+         PrintCalendar();
+         break;
+         }
+
+      case DOWN_ARROW: {
+         year++;
+         PrintCalendar();
+         break;
+         }
+
+      case QUESTION:
+      case SLASH: {
+         PrintHelp();
+         PrintCalendar();
+         break;
+         }
+
+      case ESC: return;
+
+      default:
+         SysBeep();
+      }
+   }
+while (1);
+}
+
+/*************************************************************
+*
+*  ShutDown: Does nothing
+*
+*************************************************************/
+
+void ShutDown(void)
+
+{
+}

C.Samples/CDA.Samples/Echo.cc

@@ -0,0 +1,44 @@
+/****************************************************************
+*
+*  Echo
+*
+*  This is about the simplest a classic desk accessory can be,
+*  providing a quick framework for developing your own.  It
+*  simply reads strings typed from the keyboard and echos
+*  them back to the screen.
+*
+*  Mike Westerfield
+*
+*  Copyright 1989
+*  Byte Works, Inc.
+*
+****************************************************************/
+
+#pragma keep "Echo"
+#pragma cda "Echo from C" Start ShutDown
+#pragma lint -1
+
+#include <stdio.h>
+#include <string.h>
+
+char str[256];
+
+
+void Start(void)
+
+{
+printf("This program echoes the strings you type from the keyboard.  To\n");
+printf("quit, hit the RETURN key at the beginning of a line.\n\n");
+
+do {
+   fgets(str, 256, stdin);		/* read a string */
+   printf("%s\n", str);			/* write the same string */
+   }
+while (strlen(str) > 1);		/* quit if the string is empty */
+}
+
+
+void ShutDown(void)
+
+{
+}

C.Samples/CDev.Samples/WorldCDev.cc

@@ -0,0 +1,71 @@
+/****************************************************************/
+/*								*/
+/*   Hello World CDev						*/
+/*								*/
+/*   Mike Westerfield						*/
+/*   October 1991						*/
+/*								*/
+/*   Copyright 1991						*/
+/*   Byte Works, Inc.						*/
+/*   All Rights Reserved.					*/
+/*								*/
+/****************************************************************/
+/*								*/
+/*   This CDev displays a text message.	 It can be used as a	*/
+/*   framework for developing your own CDevs.			*/
+/*								*/
+/*   For detailed information about CDevs, see Apple II File	*/
+/*   Type Notes for file type $D8.  Apple II File Type Notes	*/
+/*   are available from major online services, large users	*/
+/*   groups, or from APDA.					*/
+/*								*/
+/****************************************************************/
+
+#pragma keep "worldobj"
+#pragma cdev Driver
+#pragma lint -1
+
+#include <types.h>
+#include <control.h>
+#include <quickdraw.h>
+
+
+GrafPortPtr wPtr;			/* our window pointer */
+
+
+/*  DoAbout - Show the help info 				*/
+
+void DoAbout (void)
+
+{
+NewControl2(wPtr, 0x0009, 257L); 	/* draw the text (it's a stattext control) */
+}
+
+
+/*  DoCreate - Create the controls				*/
+
+void DoCreate (void)
+
+{
+NewControl2(wPtr, 0x0009, 256L); 	/* create the controls */
+}
+
+
+
+/*  Driver - main entry point					*/
+
+long Driver (long data2, long data1, int message)
+
+#define createCDev 7			/* message numbers */
+#define aboutCDev  8
+
+{
+wPtr = (void *) data1;			/* get our window pointer (most calls) */
+switch (message) {
+   case createCDev:	DoCreate();
+			break;
+   case aboutCDev:	DoAbout();
+			break;
+   }
+return 1;
+}

C.Samples/CDev.Samples/WorldCDev.make

@@ -0,0 +1,3 @@
+cmpl +t +e -x worldcdev.cc
+compile +t +e worldcdev.rez keep=WorldCDev
+filetype WorldCDev $C7

C.Samples/CDev.Samples/WorldCDev.rez

@@ -0,0 +1,110 @@
+#include "types.rez"
+
+/* This is the required resource to tell the control panel about the CDev */
+resource rCDEVFlags (0x1) {
+   0x00C0,
+   1,
+   1,
+   1,
+   0,
+   {0, 0, 110, 200},
+   "Hello World",
+   "Mike Westerfield",
+   "1.0"
+   };
+
+/* Code resource; the executable part of the CDev */
+read rCDevCode (0x1,convert) "worldobj";
+
+/* This is the icon displayed by the control panel */
+resource rIcon (0x1) {
+   0x8000,				/* color icon */
+   20,					/* height in pixels */
+   28,					/* width in pixels */
+   $"FFFFFFFFFFF1111111FFFFFFFFFF"
+   $"FFFFFFFF111111111111FFFFFFFF"
+   $"FFFFFF1111118881111881FFFFFF"
+   $"FFFFF111888888888818811FFFFF"
+   $"FFFF11118888888888118111FFFF"
+   $"FFF1111111888888811111111FFF"
+   $"FFF1111111888888111111111FFF"
+   $"FF111111111881181111111111FF"
+   $"FF111111111181111111111111FF"
+   $"FF111111111181111111111111FF"
+   $"FF111111118888881111111111FF"
+   $"FF111111118888888111111111FF"
+   $"FFF1111111888888811111111FFF"
+   $"FFF1111111188888111111111FFF"
+   $"FFFF11111111888811111111FFFF"
+   $"FFFFF111111118811111111FFFFF"
+   $"FFFFFF1111111181111111FFFFFF"
+   $"FFFFFFFF111111111111FFFFFFFF"
+   $"FFFFFFFFFF11111111FFFFFFFFFF"
+   $"FFFFFFFFFFFFFFFFFFFFFFFFFFFF",
+
+   $"00000000000FFFFFFF0000000000"
+   $"00000000FFFFFFFFFFFF00000000"
+   $"000000FFFFFFFFFFFFFFFF000000"
+   $"00000FFFFFFFFFFFFFFFFFF00000"
+   $"0000FFFFFFFFFFFFFFFFFFFF0000"
+   $"000FFFFFFFFFFFFFFFFFFFFFF000"
+   $"000FFFFFFFFFFFFFFFFFFFFFF000"
+   $"00FFFFFFFFFFFFFFFFFFFFFFFF00"
+   $"00FFFFFFFFFFFFFFFFFFFFFFFF00"
+   $"00FFFFFFFFFFFFFFFFFFFFFFFF00"
+   $"00FFFFFFFFFFFFFFFFFFFFFFFF00"
+   $"00FFFFFFFFFFFFFFFFFFFFFFFF00"
+   $"000FFFFFFFFFFFFFFFFFFFFFF000"
+   $"000FFFFFFFFFFFFFFFFFFFFFF000"
+   $"0000FFFFFFFFFFFFFFFFFFFF0000"
+   $"00000FFFFFFFFFFFFFFFFFF00000"
+   $"000000FFFFFFFFFFFFFFFF000000"
+   $"00000000FFFFFFFFFFFF00000000"
+   $"0000000000FFFFFFFF0000000000"
+   $"0000000000000000000000000000"
+   };
+
+/* The following resources define the various controls in the main display */
+resource rControlList (256) {
+   {
+      256,
+      };
+   };
+
+resource rControlTemplate (256) {
+   0x00000001,				/* control id */ 
+   {38,5,49,205},			/* control rectangle */
+   statTextControl {{			/* control type */
+      0x0000,				/* flags */
+      0x1002,				/* more flags */
+      0, 				/* ref con */
+      256,				/* text reference */
+      13 				/* text length */
+      }};
+   };
+resource rTextForLETextBox2 (256) {
+   "Hello, world."
+   };
+   
+/* The following resources define the controls for the help screen */
+resource rControlList (257) {
+   {
+      257,
+      };
+   };
+
+resource rControlTemplate (257) {
+   0x00000002,				/* control id */ 
+   {38,5,49,205},			/* control rectangle */
+   statTextControl {{			/* control type */
+      0x0000,				/* flags */
+      0x1002,				/* more flags */
+      0, 				/* ref con */
+      257,				/* text reference */
+      19 				/* text length */
+      }};
+   };
+resource rTextForLETextBox2 (257) {
+   "Put help info here."
+   };
+   

C.Samples/Desktop.Samples/Clock.cc

@@ -0,0 +1,163 @@
+/**************************************************************
+*
+*  This desk accessory brings up a simple clock.  It can be
+*  used as an outline when creating more complex desk accessories.
+*
+*  Original Pascal version by Phil Montoya
+*  C Translation by Mike Westerfield
+*
+*  Copyright 1987,1989
+*  Byte Works, Inc.
+*
+**************************************************************/
+
+#pragma keep "Clock"
+#pragma nda Open Close Action Init 60 0xFFFF "--Clock\\H**"
+#pragma lint -1
+
+#include <stddef.h>
+
+#include <quickdraw.h>
+#include <misctool.h>
+#include <event.h>
+#include <desk.h>
+#include <window.h>
+
+#define TRUE	1			/* boolean constants */
+#define FALSE	0
+
+int clockActive = 0;			/* are we already active flag */
+GrafPortPtr clockWinPtr; 		/* window pointer */
+
+char title[] = "\pClock";		/* window title */
+ParamList clockWin = {			/* new window record */
+   78,					/* paramLength */
+   0xC0A0,				/* wFrameBits */
+   title,				/* wTitle */
+   0L,					/* wRefCon */
+   {0,0,0,0},				/* wZoom */
+   NULL, 				/* wColor */
+   0,0,					/* wYOrigin,wXOrigin */
+   0,0,					/* wDataH,wDataW */
+   0,0,					/* wMaxH,wMaxW */
+   0,0,					/* wScrollVer,wScrollHor */
+   0,0,					/* wPageVer,wPageHor */
+   0,					/* wInfoRefCon */
+   0,					/* wInfoHeight */
+   NULL, 				/* wFrameDefProc */
+   NULL, 				/* wInfoDefProc */
+   NULL, 				/* wContDefProc */
+   {50,50,62,200},			/* wPosition */
+   (void *) -1L, 			/* wPlane */
+   NULL					/* wStorage */
+   };
+
+/***************************************************************
+*
+*  DrawTime - Reads the time and draws it in the window
+*
+***************************************************************/
+
+void DrawTime (void)
+
+{
+int i;					/* index variable */
+char timeString[21];			/* string to hold time */
+
+ReadAsciiTime(timeString);
+timeString[20] = 0;
+for (i = 0; i < 20; i++)
+    timeString[i] &= 0x7F;
+MoveTo(7, 10);
+DrawCString(timeString);
+}
+
+/***************************************************************
+*
+*  Open - opens the desk accessory if it is not already active
+*
+*  Outputs:
+*	GrafPortPtr - pointer to desk accessory window
+*
+***************************************************************/
+
+GrafPortPtr Open (void)
+
+{
+if (!clockActive) {
+   clockWinPtr = NewWindow(&clockWin);	/* open a window */
+   SetSysWindow(clockWinPtr);		/* set it to the system window */
+   clockActive = TRUE;			/* we are now active */
+   return clockWinPtr;			/* return our window pointer */
+   }
+}
+
+/***************************************************************
+*
+*  Close - closes the desk accessory if it is active
+*
+***************************************************************/
+
+void Close(void)
+
+{
+if (clockActive) {
+   CloseWindow(clockWinPtr);
+   clockActive = FALSE;
+   }
+}
+
+/***************************************************************
+*
+*  Action - Handle an action call
+*
+***************************************************************/
+
+void Action (long param, int code)
+
+{
+EventRecordPtr evPtr;
+GrafPortPtr currPort;
+
+switch (code) {
+
+   case eventAction: {
+      evPtr = (EventRecordPtr) param;
+      if (evPtr->what == updateEvt) {
+	 BeginUpdate(clockWinPtr);
+	 DrawTime();
+	 EndUpdate(clockWinPtr);
+	 }
+      return;
+      }
+
+   case runAction: {
+      currPort = GetPort();
+      SetPort(clockWinPtr);
+      DrawTime();
+      SetPort(currPort);
+      return;
+      }
+
+   default:
+      return;
+
+   }
+}
+
+/***************************************************************
+*
+*  Initialization
+*
+***************************************************************/
+
+void Init(int code)
+
+{
+if (code == 0) {
+   if (clockActive)
+      Close();
+   }
+else
+   clockActive = FALSE;
+}

C.Samples/Desktop.Samples/Frame.cc

@@ -0,0 +1,199 @@
+/****************************************************************
+*
+*  Frame
+*
+*  This desktop program is about as simple as they get.	 It
+*  brings up the Apple menu, a file menu with Quit and Close,
+*  and an edit menu with Undo, Cut, Copy, Paste and Clear.
+*  This is the minimum configuration for supporting desk
+*  accessories.	 (All of these menus have pre-assigned numbers,
+*  assigned by Apple.)
+*
+*  The purpose of this rather simple program is to show how
+*  easy a desktop program can be to write, and to give you a
+*  framework to use in developing your own programs.
+*
+*  Mike Westerfield
+*
+*  Copyright 1989
+*  Byte Works, Inc.
+*
+****************************************************************/
+
+#pragma keep "Frame"
+#pragma lint -1
+
+#include <orca.h>
+#include <stddef.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+#include <types.h>
+#include <quickdraw.h>
+#include <misctool.h>
+#include <event.h>
+#include <control.h>
+#include <window.h>
+#include <menu.h>
+#include <desk.h>
+#include <lineedit.h>
+#include <dialog.h>
+
+#define apple_About 257			/* Menu ID numbers */
+#define file_Quit   256
+
+enum alertKind {norml, stop, note, caution}; /* kinds of alerts */
+
+typedef	  int BOOL;			/* simulate boolean types */
+BOOL	  done;				/* tells if the program should stop */
+WmTaskRec lastEvent;			/* last event returned in event loop */
+
+
+/****************************************************************
+*
+* DoAlert - Create an alert box
+*
+* Input:
+*      kind - kind of alert
+*      msg  - alert message
+*
+****************************************************************/
+
+void DoAlert (enum alertKind kind, char *msg)
+
+{
+static ItemTemplate button =		/* button item */
+       { 1, 36, 15, 0, 0, buttonItem, "\pOK", 0, 0, NULL };
+
+static ItemTemplate message =		/* message item */
+       { 100, 5, 100, 90, 280, itemDisable+statText, NULL, 0, 0, NULL };
+
+static AlertTemplate alertRec =		/* alert box */
+       { 50, 180, 107, 460, 2, 0x80, 0x80, 0x80, 0x80, NULL, NULL, NULL };
+
+
+SetForeColor (0);			/* set text colors */
+SetBackColor (15);
+
+message.itemDescr = msg; 			 /* init. non-constant */
+alertRec.atItemList [0] = (ItemTempPtr) &button; /* template fields    */
+alertRec.atItemList [1] = (ItemTempPtr) &message;
+
+switch (kind) {
+   case norml:	   Alert (&alertRec, NULL);
+		   break;
+
+   case stop:	   StopAlert (&alertRec, NULL);
+		   break;
+
+   case note:	   NoteAlert (&alertRec, NULL);
+		   break;
+
+   case caution:   CautionAlert (&alertRec, NULL);
+		   break;
+
+   default:	   printf ("Error in DoAlert\n");
+		   exit (-1);
+		   break;
+   }
+}
+
+
+/****************************************************************
+*
+* MenuAbout - Create the About menu
+*
+****************************************************************/
+
+void MenuAbout (void)
+
+{
+DoAlert (note, "\pFrame 1.0\r"
+	       "Copyright 1989\r"
+	       "Byte Works, Inc.\r\r"
+	       "By Mike Westerfield");
+}
+
+
+/****************************************************************
+*
+* HandleMenu - Handle a menu selection
+*
+****************************************************************/
+
+void HandleMenu (int menuNum)
+
+{
+switch (menuNum) {
+   case apple_About:   MenuAbout ();
+		       break;
+
+   case file_Quit:     done = TRUE;
+		       break;
+
+   default:	       break;
+   }
+HiliteMenu (FALSE, (int) (lastEvent.wmTaskData >> 16));
+}
+
+
+/****************************************************************
+*
+* InitMenus - Initialize the menu bar
+*
+****************************************************************/
+
+void InitMenus (void)
+
+{
+InsertMenu (NewMenu (">> Edit \\N3\r"	/* create the edit menu */
+		     "--Undo\\N250V*Zz\r"
+		     "--Cut\\N251*Xx\r"
+		     "--Copy\\N252*Cc\r"
+		     "--Paste\\N253*Vv\r"
+		     "--Clear\\N254\r"
+		     ".\r"), 0);
+
+InsertMenu (NewMenu (">>  File \\N2\r"	/* create the file menu */
+		     "--Close\\N255V\r"
+		     "--Quit\\N256*Qq\r"
+		     ".\r"), 0);
+
+InsertMenu (NewMenu (">>@\\XN1\r"	/* create the Apple menu */
+		     "--About Frame\\N257V\r"
+		     ".\r"), 0);
+
+FixAppleMenu (1);			/* add desk accessories */
+FixMenuBar ();				/* draw the completed menu bar */
+DrawMenuBar ();
+}
+
+ 
+/****************************************************************
+*
+* Main Program
+*
+****************************************************************/
+
+int main (void)
+
+{
+int event;				/* event # returned by TaskMaster */
+
+startdesk (640);
+InitMenus ();				/* set up the menu bar */
+lastEvent.wmTaskMask = 0x1FFFL;		/* let Task Master do most stuff */
+ShowCursor ();				/* show the cursor */
+
+done = FALSE;				/* main event loop */
+do {
+   event = TaskMaster (0x076E, &lastEvent);
+   switch (event) {			/* handle the events we need to */
+       case wInSpecial:
+       case wInMenuBar:	   HandleMenu ((int) lastEvent.wmTaskData);
+       default:		   break;
+       }
+   }
+while (!done);
+enddesk ();
+}

C.Samples/Desktop.Samples/MiniCAD.cc

@@ -0,0 +1,374 @@
+/****************************************************************
+*
+*  MiniCAD
+*
+*  MiniCAD is a (very) simple CAD program based on the Frame
+*  program.  With MiniCAD, you can open new windows, close
+*  windows that are on the desktop, and draw lines using the
+*  mouse.  Multiple windows are supported.
+*
+*  Mike Westerfield
+*
+*  Copyright 1989
+*  Byte Works, Inc.
+*
+****************************************************************/
+
+#pragma keep "MiniCAD"
+#pragma lint -1
+
+#include <orca.h>
+#include <stddef.h>
+#include <stdlib.h>
+#include <stdio.h>
+
+#include <types.h>
+#include <quickdraw.h>
+#include <misctool.h>
+#include <event.h>
+#include <control.h>
+#include <window.h>
+#include <menu.h>
+#include <desk.h>
+#include <lineedit.h>
+#include <dialog.h>
+
+#define apple_About 257			/* Menu ID #s */
+#define file_Quit   256
+#define file_New    258
+#define file_Close  255
+
+#define maxWindows  4			/* max # of drawing windows */
+#define maxLines    50			/* max # of lines in a window */
+
+typedef int BOOL;			/* simulate boolean types */
+typedef struct { Point p1, p2; } lineRecord; /* line defined by its endpts */
+
+					/* holds info about 1 window */
+struct windowRecord { GrafPortPtr wPtr; /*   ptr to the window's port */
+		      char  *name;	/*   name of the window */
+		      int numLines;	/*   # lines in this window */
+		      lineRecord lines [maxLines]; /* lines in drawing */
+		      };
+
+enum alertKind {norml, stop, note, caution}; /* kinds of alerts */
+
+BOOL	  done;				/* tells if the program should stop  */
+WmTaskRec lastEvent;			/* last event returned in event loop */
+
+static struct windowRecord windows [maxWindows] = /* drawing windows */
+       { { NULL, "\pPaint 1" }, { NULL, "\pPaint 2" },
+	 { NULL, "\pPaint 3" }, { NULL, "\pPaint 4" } };
+
+static ParamList wParms =		/* parameters for NewWindow */
+       { 78, 0xDDA7, NULL, 0, 0, 615, 25, 188, NULL, 0, 0, 0, 0, 0, 0, 10, 10,
+	 0, 0, 0, 0, NULL, NULL, NULL, 25, 0, 188, 615, NULL, NULL };
+
+static ItemTemplate button =		/* button item */
+       { 1, 36, 15, 0, 0, buttonItem, "\pOK", 0, 0, NULL };
+
+static ItemTemplate message =		/* message item */
+       { 100, 5, 100, 90, 280, itemDisable+statText, NULL, 0, 0, NULL };
+
+static AlertTemplate alertRec =		/* alert box */
+       { 50, 180, 107, 460, 2, 0x80, 0x80, 0x80, 0x80, NULL, NULL, NULL };
+
+
+/****************************************************************
+*
+* DoAlert - Create an alert box
+*
+* Input:
+*      kind - kind of alert
+*      msg  - alert message
+*
+****************************************************************/
+
+void DoAlert (enum alertKind kind, char *msg)
+
+{
+SetForeColor (0);			/* set text colors */
+SetBackColor (15);
+
+message.itemDescr	= msg;			 /* init. non-constant */
+alertRec.atItemList [0] = (ItemTempPtr) &button; /*   template fields  */
+alertRec.atItemList [1] = (ItemTempPtr) &message;
+
+switch (kind) {
+   case norml:	   Alert (&alertRec, NULL);
+		   break;
+
+   case stop:	   StopAlert (&alertRec, NULL);
+		   break;
+
+   case note:	   NoteAlert (&alertRec, NULL);
+		   break;
+
+   case caution:   CautionAlert (&alertRec, NULL);
+		   break;
+
+   default:	   printf ("Error in DoAlert\n");
+		   exit (-1);
+		   break;
+   }
+}
+
+
+#pragma databank 1
+/****************************************************************
+*
+* DrawWindow - Draw the contents of the current window
+*
+****************************************************************/
+
+void DrawWindow (void)
+
+{
+int i;					/* window's index */
+int j;					/* loop variable */
+
+struct windowRecord *wp; 		/* work pointers */
+lineRecord *lp;
+
+i = GetWRefCon (GetPort());
+if (windows [i].numLines) {		/* skip the work if there */
+					/*   aren't any lines     */
+   SetPenMode (modeCopy);		/* set up to draw */
+   SetSolidPenPat (0);
+   SetPenSize (2, 1);
+   wp = &windows [i];			/* draw each of the lines */
+   for (j = 0; j < wp->numLines; ++j) {
+       lp = &(wp->lines [j]);
+       MoveTo (lp->p1.h, lp->p1.v);
+       LineTo (lp->p2.h, lp->p2.v);
+       }
+   }
+}
+#pragma databank 0
+
+
+/****************************************************************
+*
+* DoClose - Close the front drawing window, if there is one
+*
+****************************************************************/
+
+void DoClose (void)
+
+{
+int i;
+
+if (FrontWindow () != NULL) {
+   i = GetWRefCon (FrontWindow ());
+   CloseWindow (windows [i].wPtr);
+   windows [i].wPtr = NULL;
+   EnableMItem (file_New);
+   }
+}
+
+ 
+/****************************************************************
+*
+* MenuAbout - Create the About alert box
+*
+****************************************************************/
+
+void MenuAbout (void)
+
+{
+DoAlert (note, "\pMini-CAD 1.0\r"
+	       "Copyright 1989\r"
+	       "Byte Works, Inc.\r\r"
+	       "By Mike Westerfield");
+}
+
+
+/****************************************************************
+*
+* DoNew - Open a new drawing window
+*
+****************************************************************/
+
+void DoNew (void)
+
+{
+int i;					/* index variable */
+
+i = 0;					/* find an empty record */
+while (windows[i].wPtr != NULL)
+   ++i;
+windows[i].numLines = 0; 		/* no lines drawn yet */
+
+wParms.wTitle = (Pointer) windows[i].name; /* init. non-constant */
+wParms.wRefCon = i;			/* wParms fields */
+wParms.wContDefProc = (VoidProcPtr) DrawWindow;
+wParms.wPlane = (GrafPortPtr) topMost;
+
+windows[i].wPtr = NewWindow (&wParms);	/* open the window */
+if (toolerror()) {
+   DoAlert (stop, "\pError opening the window.");
+   windows [i].wPtr = NULL;
+   }
+else if (i == 3) 			/* don't allow more than 4 open windows */
+   DisableMItem (file_New);
+}
+
+
+/****************************************************************
+*
+* HandleMenu - Handle a menu selection
+*
+****************************************************************/
+
+void HandleMenu (int menuNum)
+
+{
+switch (menuNum) {
+   case apple_About:   MenuAbout();
+		       break;
+
+   case file_Quit:     done = TRUE;
+		       break;
+
+   case file_New:      DoNew ();
+		       break;
+
+   case file_Close:    DoClose ();
+   }
+HiliteMenu (FALSE, (int) (lastEvent.wmTaskData >> 16));
+}
+
+
+/****************************************************************
+*
+* InitMenus - Initialize the menu bar
+*
+****************************************************************/
+
+void InitMenus (void)
+
+{
+InsertMenu (NewMenu (">> Edit \\N3\r"	/* create the edit menu */
+		     "--Undo\\N250V*Zz\r"
+		     "--Cut\\N251*Xx\r"
+		     "--Copy\\N252*Cc\r"
+		     "--Paste\\N253*Vv\r"
+		     "--Clear\\N254\r"
+		     ".\r"), 0);
+
+InsertMenu (NewMenu (">>  File \\N2\r"	/* create the file menu */
+		     "--New\\N258*Nn\r"
+		     "--Close\\N255V\r"
+		     "--Quit\\N256*Qq\r"
+		     ".\r"), 0);
+
+InsertMenu (NewMenu (">>@\\XN1\r"	/* create the Apple menu */
+		     "--About...\\N257V\r"
+		     ".\r"), 0);
+
+FixAppleMenu (1);			/* add desk accessories */
+FixMenuBar ();				/* draw the completed menu bar */
+DrawMenuBar ();
+}
+
+ 
+/****************************************************************
+*
+* Sketch - Track the mouse, drawing lines to connect the points
+*
+****************************************************************/
+
+void Sketch (void)
+
+{
+Point endPoint;				/* the end point of the line */
+Point firstPoint;			/* the initial point */
+int i;					/* window index */
+int numLines;				/* copy of windows [i].numLines */
+EventRecord sEvent;			/* last event returned in event loop */
+
+/* get the window's index */
+i = GetWRefCon (FrontWindow());
+
+/* check for too many lines */
+if (windows [i].numLines == maxLines)
+   DoAlert (stop, "\pThe window is full -\rmore lines cannot be\radded.");
+else {
+   /* initialize the pen */
+   StartDrawing (FrontWindow());
+   SetSolidPenPat (15);
+   SetPenSize (2, 1);
+   SetPenMode (modeXOR);
+
+   /* record the initial pen location */
+   firstPoint = lastEvent.where;
+   GlobalToLocal (&firstPoint);
+   MoveTo (firstPoint.h, firstPoint.v);
+   LineTo (firstPoint.h, firstPoint.v);
+   endPoint = firstPoint;
+
+   /* follow the pen, rubber-banding the line */
+   while (!GetNextEvent (mUpMask, &sEvent)) {
+       GlobalToLocal (&sEvent.where);
+       if ((endPoint.h != sEvent.where.h) || (endPoint.v != sEvent.where.v)) {
+	   MoveTo (firstPoint.h, firstPoint.v);
+	   LineTo (endPoint.h, endPoint.v);
+	   MoveTo (firstPoint.h, firstPoint.v);
+	   LineTo (sEvent.where.h, sEvent.where.v);
+	   endPoint.h = sEvent.where.h;
+	   endPoint.v = sEvent.where.v;
+	   }
+       }
+
+   /* erase the last XORed line */
+   MoveTo (firstPoint.h, firstPoint.v);
+   LineTo (endPoint.h, endPoint.v);
+
+   /* if we have a line (not a point), record it in window's line list */
+   if ((firstPoint.h != endPoint.h) || (firstPoint.v != endPoint.v)) {
+       numLines = windows[i].numLines++;
+       windows [i].lines [numLines].p1 = firstPoint;
+       windows [i].lines [numLines].p2 = endPoint;
+       SetPenMode (modeCopy);
+       SetSolidPenPat (0);
+       MoveTo (firstPoint.h, firstPoint.v);
+       LineTo (endPoint.h, endPoint.v);
+       }
+   }
+}
+
+
+/****************************************************************
+*
+* Program begins here
+*
+****************************************************************/
+
+int main (void)
+
+{
+int event;				/* event #; returned by TaskMaster */
+
+startdesk (640);
+InitMenus ();				/* set up the menu bar */
+lastEvent.wmTaskMask = 0x1FFFL;		/* let task master do most stuff */
+ShowCursor ();				/* show the cursor */
+
+done = FALSE;				/* main event loop */
+do {
+   event = TaskMaster (0x076E, &lastEvent);
+   switch (event) {			/* handle the events we need to */
+       case wInSpecial:
+       case wInMenuBar:	   HandleMenu ((int) lastEvent.wmTaskData);
+			   break;
+
+       case wInGoAway :	   DoClose ();
+			   break;
+
+       case wInContent:	   Sketch ();
+       }
+   }
+while (!done);
+enddesk ();
+return 0;
+}

C.Samples/Graphic.Samples/Bounce.cc

@@ -0,0 +1,167 @@
+/****************************************************************
+*
+*  A simple graphics demo.
+*
+*  By Phil Montoya and Barbara Allred
+*
+*  Copyright 1987-1989
+*  Byte Works, Inc.
+*
+****************************************************************/
+
+#pragma keep "Bounce"
+#pragma lint -1
+
+#include <quickdraw.h>
+#include <orca.h>
+
+#define screenMode 640			/* 640x200 graphics Super HiRes display mode  */
+#define copyMode 0			/* pen copy mode */
+#define size 6				/* number of points */
+
+/* Global variables */
+
+static int curColor = white;		/* pen color */
+static int curSize  = 1;		/* no. points-1 */
+static int x[size];			/* initial points */
+static int y[size];
+static int xv[size], yv[size];		/* move and velocity arrays */
+static int maxX, maxY;			/* max X, Y coordinates */
+static int minX, minY;			/* min X, Y coordinates */
+static Rect r;				/* drawing rectangle */
+
+
+/****************************************************************
+*
+*  UpDate - Updates x and y by velocity factors and changes
+*           direction if necessary
+*
+*  Inputs:
+*       px  - X location
+*       pxv - X velocity
+*       py  - Y location
+*       pyv - Y velocity
+*
+****************************************************************/
+
+void UpDate (int *px, int *pxv, int *py, int *pyv)
+
+{
+*px += *pxv;				/* move x by velocity factor  */
+if ((*px < minX) || (*px > maxX)) {	/* if x is beyond border... */
+   *px -= *pxv;				/* ...move back */
+   *pxv = -(*pxv);			/* ...change directions */
+   }
+*py += *pyv;				/* move y by velocity factor */
+if ((*py < minY) || (*py > maxY)) {	/* if y is beyond border... */
+   *py -= *pyv;				/* ...move back */
+   *pyv = -(*pyv);			/* ...change directions */
+   }
+}
+
+
+/****************************************************************
+*
+*  NextPenColor - Changes the pen color
+*
+****************************************************************/
+
+void NextPenColor (void)
+
+{
+curColor++;				/* get next color */
+if (curColor > white)			/* if out of colors then start over */
+   curColor = black;
+SetSolidPenPat(curColor);		/* set the pen to this color */
+}
+
+
+/****************************************************************
+*
+*  Initialize - initialization for program
+*
+****************************************************************/
+
+void Initialize (void)
+
+{
+int i, j;
+
+SetPenSize(4, 2);			/* use a fatter pen */
+SetPenMode(copyMode);			/* use the copy pen mode */
+GetPortRect(&r);
+maxX = r.h2;   maxY = r.v2;		/* don't go beyond screen edges */
+minX = r.h1;   minY = r.v1;
+
+i = maxX - minX;			/* set initial points */
+j = maxX >> 1;
+x[0] = minX + j + 20;      x[1] = minX + j - 20;
+x[2] = x[3] = x[4] = x[5] = minX + j;
+
+i = maxY - minY;
+j = maxY >> 1;
+y[3] = minY + j + 10;      y[4] = minY + j - 10;
+y[0] = y[1] = y[2] = y[5] = minY + j;
+
+for (i = 0, j = 6; i < size; i++) {	/* set velocity factors */
+   if (i & 0x0001)			/* if i is odd... */
+       j = -j;
+   yv [i] = j;
+   xv [i] = -j;
+   j -= 2;
+   }
+}
+
+
+/****************************************************************
+*
+*  DrawShapes - This is the engine of the demo.
+*
+****************************************************************/
+
+void DrawShapes (void)
+
+{
+int i, j, k;
+
+for (k = white; k >= black; k--) {	/* cycle thru 16 screens */
+   SetSolidPenPat(k);			/* set the background color */
+   PaintRect(&r);
+
+   /* The number of shapes per screen depends on the size of the shape.    */
+   /* The more points a shape has the less times it will be drawn and      */
+   /* vice-versa. This keeps the time and density per screen approximately */
+   /* the same.                                                            */
+
+   for (i = 0; i <  (((size-curSize) * 38) + 75); i++) {
+                                              /* draw this series of shapes */
+       NextPenColor ();                       /* change pen colors */
+       MoveTo (x[curSize], y[curSize]);       /* initial from position */
+       UpDate (x+curSize, xv+curSize, y+curSize, yv+curSize);
+       for (j = 0; j < curSize; j++) {        /* draw this shape */
+           LineTo (x[j], y[j]);
+           UpDate (x+j, xv+j, y+j, yv+j);
+           }
+       }
+   curSize++;                                  /* next shape size */
+   if (curSize == size)
+       curSize = 1;
+   }
+}
+
+
+/****************************************************************
+*
+*  Program Begins Here
+*
+****************************************************************/
+
+int main (void)
+
+{
+startgraph(screenMode);			/* set up graphics screen */
+Initialize();				/* initialize global data */
+DrawShapes();				/* draw the shapes */
+endgraph();				/* shut down the graphics screen */
+return 0;
+}

C.Samples/Graphic.Samples/CallGSOS.cc

@@ -0,0 +1,94 @@
+/*****************************************************************
+*
+*   Call GS/OS
+*
+*   This program shows how to call GS/OS directly.  You should
+*   compare it with callp16.cc, which shows how to call ProDOS 16
+*   (an older operating system that is now a subset of GS/OS).
+*
+*   This program dumps the contents of a screen image file to the
+*   graphics screen.  It is assumed that the program callp16 was
+*   executed prior to running this program, and that you have
+*   made a note of the filename containing the screen dump that
+*   was created by callp16.
+*
+*   DO NOT EXECUTE THIS PROGRAM FROM THE DESKTOP.  It uses non-
+*   standard mechanisms for accessing the graphics screen.
+*
+*   By Barbara Allred and Mike Westerfield
+*
+*   Copyright 1989
+*   Byte Works, Inc.
+*
+*******************************************************************/
+
+#pragma keep "CallGSOS"
+#pragma debug 1				/* check stack overflows */
+#pragma lint -1
+
+#include <types.h>
+#include <stdlib.h>
+#include <orca.h>
+#include <quickdraw.h>
+#include <gsos.h>
+#include <stdio.h>
+#include <string.h>
+
+#define SCREENWIDTH 320			/* screen width in pixels */
+
+static GSString255 filename;		/* name of file having screen contents */
+
+					/* Data Control Blocks for GS/OS calls */
+OpenRecGS openDCB = { 15, 0, NULL, 1, 0};
+IORecGS readDCB = { 5, 0, (void *) 0x00E12000, 32768L, 0L, 0 };
+RefNumRecGS closeDCB = { 1, 0 };
+
+int main (void)
+
+{
+char *str;
+int i;
+
+/* Prompt user for the name of the file to load. */
+printf ("Please enter the name of the file containing the screen image:\n");
+scanf ("%s", filename.text);
+filename.length = strlen(filename.text);
+
+/* Initialize the pen and graphics screen. */
+startgraph(SCREENWIDTH);		/* start QuickDraw II */
+SetPenSize(4, 2);			/* use fatter pen */
+
+/* Open the file and then write its contents to the graphics screen. */
+openDCB.pathname = &filename;		/* open the file */
+OpenGS(&openDCB);
+if (i = toolerror()) {
+   MoveTo(50, 100);
+   SetSolidPenPat(black);
+   sprintf(str, "Unable to open file for screen dump: err = %d\n", i);
+   DrawCString(str);
+   goto Fail;
+   }
+
+readDCB.refNum = openDCB.refNum;	/* read the file, sending */
+ReadGS(&readDCB);			/*  contents to screen    */
+if (i = toolerror()) {
+   MoveTo(50, 100);
+   SetSolidPenPat(black);
+   sprintf(str, "Unable to read file for screen dump: err = %d\n", i);
+   DrawCString(str);
+   goto Fail;
+   }
+
+closeDCB.refNum = openDCB.refNum;	/* close the file */
+CloseGS (&closeDCB);
+
+/* Wrap up:  Wait for user to signal end, then shut down tools started. */
+Fail:
+SetSolidPenPat(black);			/* wait for user to signal end */
+str = "Press RETURN when ready to quit program";
+MoveTo(SCREENWIDTH-CStringWidth(str), 40);
+DrawCString(str);
+getchar(); getchar();
+endgraph();
+return 0;
+}

C.Samples/Graphic.Samples/CallP16.cc

@@ -0,0 +1,121 @@
+/*****************************************************************
+*
+*   Call ProDOS 16
+*
+*   This program draws ovals on the 16 color screen.  It then
+*   dumps the contents of the graphics screen to a file.  If the
+*   file is loaded and then stored to the graphics screen, the
+*   image dumped is displayed.
+*
+*   DO NOT EXECUTE THIS PROGRAM FROM THE DESKTOP.  It uses non-
+*   standard mechanisms for accessing the graphics screen.
+*
+*   By Barbara Allred and Mike Westerfield
+*
+*   Copyright 1989
+*   Byte Works, Inc.
+*
+*******************************************************************/
+
+#pragma keep "CallP16"
+#pragma debug 1				/* check stack overflows */
+
+#include <prodos.h>
+
+#pragma lint -1
+
+#include <quickdraw.h>
+#include <stdio.h>
+#include <string.h>
+#include <orca.h>
+
+Rect ovalRect, *ovalPtr = &ovalRect;	/* bounds rectangle for ovals */
+
+					/* Data Control Blocks for ProDOS 16 calls */
+FileRec createDCB = { NULL, 0x00E3, 0x06, 0, 0x01, 0, 0 };
+OpenRec openDCB;
+FileIORec writeDCB;
+
+
+int main (void)
+
+{
+#define SCREENWIDTH 320			/* screen width in pixels */
+
+int x = 40;				/* horizontal location in global coords */
+int y = 20;				/* vertical location in global coords */
+int color;				/* initial pen color */
+char *str;				/* work pointer */
+
+char filename [L_tmpnam+1] = "";	/* name of file receiving screen dump */
+char *fn;
+
+/* Start Quick Draw II */
+startgraph(SCREENWIDTH);
+SetPenSize(4, 2);			/* use fatter pen */
+
+/* Draw ovals in different colors on the screen. */
+for (color = 0; color < 15; color++) {
+   ovalRect.v1 = x;        ovalRect.h1 = y;
+   ovalRect.v2 = x + 15;   ovalRect.h2 = y + 15;
+   SetSolidPenPat(color+1);
+   MoveTo(y, x);
+   PaintOval(ovalPtr);
+   SetSolidPenPat(color);
+   MoveTo(y, x);
+   FrameOval(ovalPtr);
+   if (toolerror()) {
+      DrawCString("Failure in drawing routine\n");
+      goto Fail;
+      }
+   y += 10;    x += 10;
+   }
+
+/* Dump contents of screen to a file. */
+fn = tmpnam(&filename[1]);		/* get unique filename for dump */
+if (fn == NULL) {
+   MoveTo (100, 50);
+   SetSolidPenPat(black);
+   DrawCString("Unable to obtain unique filename for screen dump");
+   goto Fail;
+   }
+filename[0] = strlen(&filename[1]);	/* convert C-string to P-string */
+
+createDCB.pathname = filename;		/* create screen dump file */
+CREATE(&createDCB);
+if (toolerror()) {
+   MoveTo(50, 100);
+   SetSolidPenPat(black);
+   DrawCString("Unable to create file for screen dump");
+   goto Fail;
+   }
+openDCB.openPathname = filename;	/* open the screen dump file */
+OPEN(&openDCB);
+if (toolerror()) {
+   MoveTo(50, 100);
+   SetSolidPenPat(black);
+   DrawCString("Unable to open file for screen dump");
+   goto Fail;
+   }
+writeDCB.fileRefNum = openDCB.openRefNum; /* write screen contents to file */
+writeDCB.dataBuffer = (void *) 0x00E12000;
+writeDCB.requestCount = 32768L;
+WRITE(&writeDCB);
+if (toolerror()) {
+   MoveTo(50, 100);
+   SetSolidPenPat(black);
+   DrawCString("Unable to write screen contents to file");
+   goto Fail;
+   }
+CLOSE(&openDCB);			/* close the screen dump file   */
+
+/* Wrap up:  Wait for key press and then shut down QuickDraw II. */
+Fail:
+SetSolidPenPat(black);			/* wait for user to signal end */
+str = "Press return when ready to quit program";
+MoveTo(SCREENWIDTH-CStringWidth(str), 40);
+DrawCString(str);
+getchar();
+endgraph();
+printf("The name of the file containing the screen dump is:\n%b", filename);
+}

C.Samples/Graphic.Samples/Pipe.cc

@@ -0,0 +1,73 @@
+/****************************************************************
+*
+*  Pipe
+*
+*  A simple graphics demo.
+*
+*  by Mike Westerfield
+*
+*  Copyright 1987-1989
+*  Byte Works, Inc.
+*
+****************************************************************/
+
+#pragma keep "Pipe"
+#pragma lint -1
+
+#include <quickdraw.h>
+
+#define xWidth 20
+#define yWidth 10
+
+int main (void)
+
+{
+Rect r;					/* drawing rectangle */
+int x = xWidth;				/* horizontal width of pipe */
+int y = yWidth;				/* vertical width of pipe */
+int color = 1;				/* pen color */
+int maxX;				/* maximum horizontal pixel */
+int maxY;				/* maximum vertical pixel */
+int minX;				/* minimum horizontal pixel */
+int minY;				/* minimum vertical pixel */
+int deltaX = 6;				/* pipe width increment */
+int deltaY = 3;				/* pipe depth increment */
+int i;
+
+GetPortRect(&r);			/* initialize drawing rectangle */
+maxX = r.h2 - xWidth;			/* don't go beyond rect edges */
+maxY = r.v2 - yWidth;
+minX = r.v1;
+minY = r.h1;
+
+for (i = 0; i < 150; ++i) {		/* main loop:  draw pipe, a series of ovals */
+   r.h1 = x - xWidth;
+   r.h2 = x + xWidth;
+   r.v1 = y - yWidth;
+   r.v2 = y + yWidth;
+   color ^= 3;
+   SetSolidPenPat(color);
+   PaintOval(&r);
+   SetSolidPenPat(0);
+   FrameOval(&r);
+
+   x += deltaX;				/* bend pipe as needed to fit within rectangle */
+   if (x < xWidth) {
+      x = xWidth;
+      deltaX = -deltaX;
+      }
+   else if (x > maxX) {
+      x = maxX;
+      deltaX = -deltaX;
+      }
+   y += deltaY;
+   if (y < yWidth) {
+      y = yWidth;
+      deltaY = -deltaY;
+      }
+   else if (y > maxY) {
+      y = maxY;
+      deltaY = -deltaY;
+      }
+   }
+}

C.Samples/Graphic.Samples/Spiral.cc

@@ -0,0 +1,45 @@
+/****************************************************************
+*
+*  Spiral
+*
+*  A simple graphics demo.  Uses the shell STOP command from the
+*  debug menu to stop the program early.
+*
+*  by Mike Westerfield
+*
+*  Copyright 1989
+*  Byte Works, Inc.
+*
+****************************************************************/
+
+#pragma keep "Spiral"
+#pragma lint -1
+
+#include <quickdraw.h>
+#include <math.h>
+
+int main (void)
+
+{
+float r, theta, rot;
+int color = 1;
+Rect rect;
+
+GetPortRect(&rect);
+SetPenSize(3, 1);
+for (rot = 0.0002; rot < 0.0005; rot += 0.0001) {
+   theta = 0.0;
+   r = 40.0;
+   MoveTo ((int) (cos (theta) * r * 3) + 160,
+           (int) (sin (theta) * r) + 40);
+   while (r > 0.0) {
+      SetSolidPenPat (color);
+      color ^= 3;
+      theta += 3.1415926535 / 21.0 + rot;
+      LineTo ((int) (cos (theta) * r * 3) + 160,
+              (int) (sin (theta) * r) + 40);
+      r -= 0.02;
+      }
+   }
+Out: ;
+}

C.Samples/HyperCard/xcmd.cc

@@ -0,0 +1,34 @@
+/*****************************************************************
+*
+*  HyperCard XCMD
+*
+*  This sample is a framework program, showing the essential parts
+*  of a HyperCard XCMD.
+*
+*  For complete details on the requirements for HyperCard XCMDs,
+*  see the HyperCard technical documentation on the System 6.0
+*  CD ROM.
+*
+*  Build this program using the script xcmd.make.  This script has
+*  quite a few comments about the build process, so it's worth
+*  loading the scrept and reading the comments.
+*
+*  By Mike Westerfield
+*
+*  Copyright 1993
+*  Byte Works, Inc.
+*
+*****************************************************************/
+
+#pragma keep "xcmd"    
+#pragma lint -1
+#pragma xcmd main
+
+#include <HyperXCMD.h>
+#include <misctool.h>
+
+void main (XCMDPtr parm)
+
+{
+SysBeep();
+}

C.Samples/HyperCard/xcmd.make

@@ -0,0 +1,26 @@
+*
+*  This file builds the sample xcmd.cc.
+*
+
+*
+*  There's nothing special about the compile -- just be sure the program
+*  itself uses the xcmd pragma, the small memory model, and does not use the
+*  segment directive.
+*
+
+compile xcmd.cc
+
+*
+*  The -x flag is crutial!  XCMDs must consist of a single segment, and
+*  without the -x flag on the link, the linker creates an expressload
+*  segment.
+*
+
+link -x xcmd keep=xcmd
+
+*
+*  The Rez compiler packs the executable code and a name into a file for
+*  HyperCard.
+*
+
+compile xcmd.rez keep=Beep

C.Samples/HyperCard/xcmd.rez

@@ -0,0 +1,23 @@
+/*****************************************************************
+*
+*  HyperCard XCMD
+*
+*  This is the resource file for xcmd.cc.
+*
+*  By Mike Westerfield
+*
+*  Copyright 1993
+*  Byte Works, Inc.
+*
+*****************************************************************/
+
+#include "types.rez"
+
+read $801E(1, convert) "xcmd";
+
+resource rResName ($0001801E) {
+   1,
+   {
+      1, "Beep";
+      }
+   };

C.Samples/HyperStudio/nba.cc

@@ -0,0 +1,35 @@
+/*****************************************************************
+*
+*  HyperStudio New Button Action (NBA)
+*
+*  This sample is a framework program, showing the essential parts
+*  of a HyperStudio NBA.
+*
+*  For complete details on the requirements for HyperStudio NBAs,
+*  contact Roger Wagner Publishing.  When this sample was written,
+*  details for writing HyperStudio NDAs were available in disk form
+*  for $10.
+*
+*  Build this program using the script xcmd.make.  This script has
+*  quite a few comments about the build process, so it's worth
+*  loading the scrept and reading the comments.
+*
+*  By Mike Westerfield
+*
+*  Copyright 1993
+*  Byte Works, Inc.
+*
+*****************************************************************/
+
+#pragma keep "nba"
+#pragma lint -1
+#pragma nba main
+
+#include "HyperStudio.h"
+#include <misctool.h>
+
+void main (HSParamPtr parm)
+
+{
+SysBeep();
+}

C.Samples/HyperStudio/nba.make

@@ -0,0 +1,27 @@
+*
+*  This file builds the sample nba.cc.
+*
+
+*
+*  There's nothing special about the compile -- just be sure the program
+*  itself uses the nba pragma, the small memory model, and does not use the
+*  segment directive.
+*
+
+compile nba.cc
+
+*
+*  The -x flag is crutial!  NBAs must consist of a single segment, and
+*  without the -x flag on the link, the linker creates an expressload
+*  segment.
+*
+
+link -x nba keep=nba
+
+*
+*  The Rez compiler packs the executable code and a name into a file for
+*  HyperStudio.
+*
+
+compile nba.rez keep=Beep
+filetype Beep $BC $4007

C.Samples/HyperStudio/nba.rez

@@ -0,0 +1,23 @@
+/*****************************************************************
+*
+*  HyperStudio NBA
+*
+*  This is the resource file for nba.cc.
+*
+*  By Mike Westerfield
+*
+*  Copyright 1993
+*  Byte Works, Inc.
+*
+*****************************************************************/
+
+#include "types.rez"
+
+read $8017($7FF0, convert) "nba";
+
+resource rResName ($00018017) {
+   1,
+   {
+      $7FF0, "Beep";
+      }
+   };

C.Samples/Text.Samples/Ackermann.cc

@@ -0,0 +1,67 @@
+/*****************************************************************
+*
+*  Ackermann
+*
+*  This program implements a famous mathematical function that
+*  is often used to examine recursion.  It is deceptively
+*  simple, but can take enormous amounts of time and stack
+*  space for relatively small arguments.  For that reason,
+*  rangechecking has been enabled to ensure the integrity of the
+*  stack.
+*
+*  By Mike Westerfield
+*
+*  Copyright 1987-1989
+*  Byte Works, Inc.
+*
+*****************************************************************/
+
+#pragma keep "Ackermann"
+#pragma debug 0x0001
+#pragma lint -1
+
+#include <stdio.h>
+
+/* Constants */
+#define maxm 2				/* max value of 1st argument */
+#define maxn 3				/* max value of 2nd argument */
+
+/* Global variables */
+int a, m, n, depth, maxdepth;
+
+/****************************************************************
+*
+* Ackermann - Demonstrates recursion in ORCA/C
+*
+****************************************************************/
+
+int Ackermann (int m, int n)
+
+{
+int result;
+
+depth++;
+if (depth > maxdepth)
+   maxdepth = depth;
+if (m == 0)
+   return (n + 1);
+if (n == 0)
+   return (Ackermann (m-1, 1));
+result = Ackermann (m-1, Ackermann (m, n-1));
+depth--;
+return result;
+}
+
+
+int main (void)
+
+{
+for (m = 0; m <= maxm; m++)
+   for (n = 0; n <= maxn; n++) {
+       depth    = 0;
+       maxdepth = 0;
+       a = Ackermann (m, n);
+       printf ("Ackermann(%d, %d) = %-4d     ", m, n, a);
+       printf ("Max recursion depth was %d\n", maxdepth);
+       }
+}

C.Samples/Text.Samples/Artillery.cc

@@ -0,0 +1,101 @@
+/************************************************
+*
+*  Artillery
+*
+*  This classic interactive text game lets you
+*  pick the angle of your artillery gun in
+*  an attempt to knock out the enemy position.
+*  The computer picks a secret distance.  When
+*  you fire, you will be told how much you
+*  missed by, and must fire again.  The object
+*  is to hit the target with the fewest shells.
+*
+************************************************/
+
+#pragma keep "Artillery"
+#pragma lint -1
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <time.h>
+#include <math.h>
+#include <misctool.h>
+
+#define FALSE 0                 /* boolean constants */
+#define TRUE  1
+
+#define BLASTRADIUS 50.0        /* max distance from target for a hit */
+#define DTR         0.01745329  /* convert from degrees to radians */
+#define VELOCITY    434.6       /* muzzle velocity */
+
+int main(void)
+
+{
+float angle,                    /* angle */
+      distance,                 /* distance to the target */
+      flightTime,               /* time of flight */
+      x,                        /* distance to impact */
+      vx,vy;                    /* x, y velocities */
+int   done,                     /* is there a hit, yet? */
+      tries,                    /* number of shots */
+      i;                        /* loop variable */
+
+/* choose a distance to the target */
+srand((int) time(NULL));
+for (i = 0; i < 100; ++i)
+   rand();
+distance = rand()/5.55373;
+
+/* not done yet... */
+done = FALSE;
+tries = 1;
+
+/* shoot 'til we hit it */
+do {
+   /* get the firing angle */
+   printf("Firing angle: ");
+   scanf("%f", &angle);
+
+   /* compute the muzzle velocity in x, y */
+   angle *= DTR;
+   vx = cos(angle)*VELOCITY;
+   vy = sin(angle)*VELOCITY;
+
+   /* find the time of flight */
+   /* (velocity = acceleration*flightTime, two trips) */
+   flightTime = 2.0*vy/32.0;
+
+   /* find the distance */
+   /* (distance = velocity*flightTime) */
+   x = vx*flightTime;
+
+   /* see what happened... */
+   if (fabs(distance-x) < BLASTRADIUS) {
+      done = TRUE;
+      printf("A hit, after %d", tries);
+      if (tries == 1)
+        printf(" try!\n");
+      else
+        printf(" tries!\n");
+      switch (tries) {
+         case 1:
+            printf("(A lucky shot...)\n");
+            break;
+         case 2:
+            printf("Phenomenal shooting!\n");
+            break;
+         case 3:
+            printf("Good shooting.\n");
+            break;
+         otherwise:
+            printf("Practice makes perfect - try again.\n");
+         }
+      }
+   else if (distance > x)
+      printf("You were short by %d feet.\n", (int)(distance-x));
+   else
+      printf("You were over by %d feet.\n", (int)(x-distance));
+   ++tries;
+   }
+while (!done);
+}

C.Samples/Text.Samples/CLine.cc

@@ -0,0 +1,45 @@
+/***************************************************************
+*
+*  Command Line
+*
+*  On the Apple IIgs, all EXE programs can expect three things
+*  to be passed to them by the shell: a user ID number for use
+*  with tool kits, an eight character shell ID which
+*  identifies the shell that executed the program, and the
+*  text from the command line itself.  This program shows how
+*  to access these values from C, printing them to the
+*  screen.  Be sure and execute the program with some text
+*  after the name - for example,
+*
+*       CLINE Hello, world.
+*
+*  When any EXE program returns to the shell, it passes an
+*  error code in the A register.  You can set this value from
+*  C by returning an integer value as the result of main, as
+*  shown in this program.
+*
+*  If you compile this program from the desktop, turn debug
+*  code off before executing the program from the shell window.
+*
+***************************************************************/
+
+#pragma keep "CLine"
+#pragma lint -1
+
+#include <stdio.h>
+#include <orca.h>
+
+int main(void)
+
+{
+char *shellName, *line;
+int userNumber;
+
+userNumber = userid();
+shellName = shellid();
+line = commandline();
+printf("User ID: %d\n", userNumber);
+printf("Shell ID: %s\n", shellName);
+printf("Command line: %s\n", line);
+return 0;
+}

C.Samples/Text.Samples/ErrorExit.cc

@@ -0,0 +1,52 @@
+/*******************************************************************
+*
+*   Error Exit
+*
+*   You can call the library routines that handle run-time errors
+*   from your own program.  One of these, called strerror, will
+*   print a text run-time error message to standard output.  You
+*   pass a single integer parameter, which is the run-time error
+*   number.  This procedure is generally called from an error trap
+*   subroutine - see the sample program ERRORTRAP.CC for an example
+*   of how to trap errors.  In this program strerror is used to
+*   list the current run-time error messages.
+*
+*   The two built-in macros __FILE__ and __LINE__ are used to print
+*   the current line number and the name of the current source file.
+*
+*   The library subroutine SystemErrorLocation provides trace-back
+*   information; it is further covered in the text sample program
+*   ERRORTRAP.CC.
+*
+*   By Mike Westerfield and Barbara Allred
+*
+*   Copyright 1987-1989
+*   Byte Works, Inc.
+*
+*********************************************************************/
+
+#pragma keep "ErrorExit"
+#pragma debug 8				/* enable trace-back of code */
+#pragma lint -1
+
+#include <string.h>
+#include <errno.h>
+#include <stdio.h>
+
+extern pascal void SystemErrorLocation (void);
+/* A library procedure that prints the current location and a traceback. */
+
+int main (void)
+
+{
+int i;
+
+printf ("Run-time error messages are:\n\n");
+for (i = 1; i <= sys_nerr; i++)
+   printf ("%3d:  %s\n", i, strerror (i));
+
+printf ("\nCurrent line: %d\nCurrent file: %s\n", __LINE__, __FILE__);
+
+printf ("Exiting with a traceback.\n");
+SystemErrorLocation ();
+}

C.Samples/Text.Samples/ErrorTrap.cc

@@ -0,0 +1,97 @@
+/******************************************************************
+*
+*   Error Trap
+*
+*   You can trap run-time errors with ORCA/C.  There are several
+*   reasons to do this, including:
+*
+*        1.  Error messages take up space.  By replacing the
+*            system error handler with your own, you can cut
+*            out the space needed to store the run-time error
+*            messages.
+*        2.  You may want to trap some kinds of run-time
+*            errors, like file not found or out of memory,
+*            and handle them yourself.  If you do not, the
+*            error will cause the program to stop executing,
+*            which may not be the desired result.
+*
+*   This program shows how to intercept and handle run-time
+*   errors.  This is done by placing a function in your program
+*   called SYSTEMERROR.  The function has a single parameter,
+*   which is an integer error number.  SYSTEMERROR replaces a
+*   function by the same name that is normally linked in from
+*   the libraries.  Another library function, SystemErrorLocation,
+*   provides the name of the function and the line number where
+*   the run-time error occurred.
+*
+*   Note that if you do not want to handle a particular error,
+*   you can call the system error handlers from your program.
+*   See the sample program ERROREXIT.CC for an example.
+*
+*   By Mike Westerfield and Barbara Allred
+*
+*   Copyright 1987-1989
+*   Byte Works, Inc.
+*
+*******************************************************************/
+
+#pragma keep "ErrorTrap"
+#pragma debug 9				/* enable range checking + trace-back */
+#pragma lint -1
+
+#include <stdio.h>
+
+extern pascal void SystemErrorLocation (void);
+/* A library procedure that prints the current location and a traceback. */
+
+/****************************************************************
+*
+* BadFunction - Subroutine that will generate a run-time error
+*
+****************************************************************/
+
+static void BadFunction (void)
+
+{
+char ch [8000];				/* this array is too large for */
+					/* the default run-time stack  */
+(void)ch;				/* dummy use of ch to avoid lint msg */
+}
+
+
+/****************************************************************
+*
+* DoIt - Calls function that will generate a run-time error
+*
+****************************************************************/
+
+static void DoIt (void)
+{
+BadFunction();				/* call function with large array */
+}
+
+
+/****************************************************************
+*
+* SystemError - Replaces SYSTEMERROR function in the ORCA library
+*
+****************************************************************/
+
+static void SYSTEMERROR (int errorNumber)
+
+{
+printf ("Run-time error detected.  error number = %d\n", errorNumber);
+}
+
+
+/****************************************************************
+*
+* Main program starts here
+*
+****************************************************************/
+
+int main(void)
+{
+DoIt();
+SystemErrorLocation();
+}

C.Samples/Text.Samples/Finance.cc

@@ -0,0 +1,61 @@
+/************************************************
+*
+*  Finance
+*
+*  This program prints the balance on an
+*  account for monthly payments, along with the
+*  total amount paid so far.
+*
+*************************************************/
+
+#pragma keep "Finance"
+#pragma lint -1
+
+#include <stdio.h>
+
+#define LOANAMOUNT 10000.0       /* amount of the loan */
+#define PAYMENT    600.0         /* monthly payment */
+#define INTEREST   15            /* yearly interest (as %) */
+
+int main(void)
+
+{
+float balance,                   /* amount left to pay */
+      monthlyInterest,           /* multiplier for interest */
+      paid ;                     /* total amount paid */
+int   month;                     /* month number */
+
+/* set up the initial values */
+balance = LOANAMOUNT;
+paid = month = 0;
+monthlyInterest = 1.0 + INTEREST/1200.0;
+
+/* write out the conditions */
+printf("Payment schedule for a loan of %10.2f\n", LOANAMOUNT);
+printf("with monthly payments of %5.2f at an\n", PAYMENT);
+printf("interest rate of %d%%.\n\n", INTEREST);
+printf("          month        balance    amount paid\n");
+printf("          -----        -------    -----------\n");
+
+/* check for payments that are too small */
+if (balance*monthlyInterest - balance >= PAYMENT)
+   printf("The payment is too small!");
+else
+   while (balance > 0) {
+      /* add in the interest */
+      balance *= monthlyInterest;
+      /* make a payment */
+      if (balance > PAYMENT) {
+         balance -= PAYMENT;
+         paid += PAYMENT;
+         }
+      else {
+         paid += balance;
+         balance = 0;
+         }
+      /* update the month number */
+      ++month;
+      /* write the new statistics */
+      printf("%15d %14.2f %14.2f\n", month, balance, paid);
+      }
+}

C.Samples/Text.Samples/Key.cc

@@ -0,0 +1,107 @@
+/*****************************************************************
+*
+*   Keyboard Handling
+*
+*   This program shows one way to access the keyboard directly
+*   from ORCA/C.  Keep in mind that the standard file input
+*   collects an entire line of characters before reporting the
+*   first character.  This is necessary to allow editing of the
+*   input line.  When using the desktop environment, you can get
+*   keypress events from the event manager.  This program shows
+*   how to detect a keypress as soon as it is hit.  It echoes
+*   keys until you type CONTROL-@ (ASCII 0).
+*
+*   The program works by reading the keyboard (at $C000) until
+*   the value is negative, indicating that a key has been
+*   pressed.  It then stores a value (any value will do) in
+*   $C010 to indicate that the key has been read.  This makes
+*   the value at $C010 positive (bit 7 is clear).  The value of
+*   the key is then ANDed with $7F to clear the high bit.
+*
+*   THIS METHOD OF READING THE KEYBOARD ONLY WORKS IN THE TEXT
+*   ENVIRONMENT.  When the event manager is active, as it always
+*   is in a desktop program, you should call the event manager
+*   to read keystrokes.
+*
+*   Checking to see when a key has been pressed is bundled into
+*   the function KeyPress.  Returning the key and clearing the
+*   strobe is done in ReadChar.
+*
+*   See key2 for a version that splits the keyboard routines off
+*   into a separately compilable module.
+*
+*   See key3 for a version that uses assembly language to do the
+*   same thing.
+*
+*   By Mike Westerfield and Barbara Allred
+*
+*   Copyright 1987-1989
+*   Byte Works, Inc.
+*
+*******************************************************************/
+
+#pragma keep "Key"
+#pragma lint -1
+
+#include <stdio.h>
+
+static char ch;                               /* character read from keyboard */
+
+/****************************************************************
+*
+* KeyPress - Check if a key has been pressed
+*
+****************************************************************/
+
+int KeyPress(void)
+
+{
+char *keyboard;
+
+keyboard = (char *) 0x00C000;
+return ((*keyboard) & 0x80) != 0;
+}
+
+
+/****************************************************************
+*
+* ReadChar - Return the last character typed on the keyboard.
+*            Note:  Returns a character whether or not one has
+*                   been typed!
+*
+****************************************************************/
+
+char ReadChar (void)
+
+{
+char *keyboard, *strobe;
+
+keyboard = (char *) 0x00C000;
+strobe = (char *) 0x00C010;
+*strobe = 0;
+return *keyboard & 0x7F;
+}
+
+
+/****************************************************************
+*
+* Main program starts here
+*
+****************************************************************/
+
+int main(void)
+
+{
+printf ("Press any key(s) and then RETURN.  Enter CTRL-@ to quit.\n");
+do {
+   while (! KeyPress())			/* wait for a keypress */
+       ;
+   ch = ReadChar();			/* get character typed from keybrd */
+   if (ch == 0x0D)			/* write character to the screen */
+      printf ("\n");
+   else
+      printf ("%c", ch);
+   }
+while (ch != 0);
+return 0;
+}

C.Samples/Text.Samples/Key2.Build

@@ -0,0 +1,20 @@
+unset exit
+echo compile key2.cc
+compile key2.cc
+if {status} == 0
+   echo compile key2.funcs
+   compile key2.funcs
+   if {status} == 0
+      echo link key2.cc key2.funcs
+      link key2 funcs keep=Key2
+      if {status} == 0
+         key2
+      else
+         echo Unable to link key2.cc key2.funcs
+      end
+   else
+      echo Unable to compile key2.funcs
+   end
+else
+   echo Unable to compile key2.cc
+end

C.Samples/Text.Samples/Key2.Funcs

@@ -0,0 +1,43 @@
+/*****************************************************************
+*
+*   This file contains the functions for KEY2.CC.  See that file
+*   for detailed comments.
+*
+*******************************************************************/
+
+#pragma keep "Funcs"
+
+/****************************************************************
+*
+* KeyPress - Check if a key has been pressed
+*
+****************************************************************/
+
+int KeyPress(void)
+
+{
+char *keyboard;
+
+keyboard = (char *) 0x00C000;
+return ((*keyboard) & 0x80) != 0;
+}
+
+
+/****************************************************************
+*
+* ReadChar - Returns the last character typed on the keyboard.
+*            Note:  Returns a character whether or not one has
+*                   been typed!
+*
+****************************************************************/
+
+char ReadChar(void)
+
+{
+char *keyboard, *strobe;
+
+keyboard = (char *) 0x00C000;
+strobe = (char *) 0x00C010;
+*strobe = 0;
+return *keyboard & 0x7F;
+}

C.Samples/Text.Samples/Key2.cc

@@ -0,0 +1,61 @@
+/*****************************************************************
+*
+*   Keyboard Handling
+*
+*   This program demonstrates separate compilation by splitting
+*   the program KEY into two parts: the main program, and a
+*   separately compiled file with the keyboard subroutines that
+*   can then be called from many different programs without the
+*   need for recompiling.  See KEY.CC for a full description of
+*   what this program does.
+*
+*   The program now consists of four files:
+*
+*        Key2.Build - EXEC file which separately compiles the two
+*                     source files, then links their object
+*                     modules to create the final program.  To
+*                     use the EXEC file, simply type KEY2.BUILD
+*                     from the command line.
+*
+*        Key2.cc    - File containing main program.
+*
+*        Key2.h     - Header file accessed by the main program;
+*                     Contains declarations of external functions.
+*
+*        Key2.Funcs - File containing keyboard functions called
+*                     by main program.
+*
+*   See Key3 for a version that uses assembly language to read
+*   the keyboard.
+*
+*   By Mike Westerfield and Barbara Allred
+*
+*   Copyright 1987-1989
+*   Byte Works, Inc.
+*
+*******************************************************************/
+
+#pragma keep "Key2"
+#pragma lint -1
+
+#include "Key2.h"
+#include <stdio.h>
+
+int main(void)
+
+{
+char ch;
+
+printf ("Press any key(s) and then RETURN.  Enter CTRL-@ to quit.\n");
+do {
+   while (! KeyPress())			/* wait for a keypress */
+      ;
+   ch = ReadChar();			/* get character typed from keybrd */
+   if (ch == 0x0D)			/* write character to the screen */
+      printf ("\n");
+   else
+      printf ("%c", ch);
+   }
+while (ch != 0);
+return 0;
+}

C.Samples/Text.Samples/Key2.h

@@ -0,0 +1,4 @@
+/* Header file for program Key2.CC */
+
+extern int KeyPress(void);
+extern char ReadChar(void);

C.Samples/Text.Samples/Key3.asm

@@ -0,0 +1,41 @@
+****************************************************************
+*
+*  KeyPress - Check to see if a key has been pressed
+*
+*  Outputs:
+*        A - 1 (true) if pressed, else 0
+*
+****************************************************************
+*
+KeyPress start
+keyBoard equ   $C000                    keyboard location
+
+         sep   #$30                     use short regs for load
+         lda   >keyBoard                load keyboard value
+         asl   A                        shift sign bit into bit 0
+         rol   A
+         rep   #$30                     back to long regs
+         and   #1                       and out all but the bit we want
+         rtl
+         end
+
+****************************************************************
+*
+*  ReadChar - return the last character typed on the keyboard
+*
+*  Outputs:
+*        A - character typed
+*
+****************************************************************
+*
+ReadChar start
+keyBoard equ   $C000                    keyboard location
+strobe   equ   $C010                    strobe location
+
+         sep   #$30                     use short regs
+         sta   >strobe                  clear strobe
+         lda   >keyBoard                load character
+         rep   #$30                     back to long regs
+         and   #$007F                   and out high bits
+         rtl
+         end

C.Samples/Text.Samples/Key3.cc

@@ -0,0 +1,64 @@
+/*****************************************************************
+*
+*   Keyboard Handling
+*
+*   This is the final incarnation of the keyboard polling sample.
+*   See KEY.CC for complete comments on what the program does and
+*   how it works.
+*
+*   In this version, we will write the two subroutines in
+*   assembly language.  While you could use separate compilation
+*   to compile and assemble the two pieces separately, then
+*   link them, as in the last example, we will use chaining
+*   to avoid all of that.  Chaining is a feature of all
+*   languages fully installed in ORCA or APW that allows a
+*   single program to be written in more than one language
+*   without resorting to separate compilation.  Which method
+*   you prefer - chaining or separate compilation - depends
+*   on your own taste.
+*
+*   To chain the two files together, we just place an append
+*   command after the end of the program.  The rest is automatic
+*   To compile, assemble, link, and execute, we can now use the
+*   familiar RUN command:
+*
+*        run key3.cc
+*
+*   Note: both the assembler and compiler must be properly
+*   installed for this to work.  The assembler is sold
+*   separately as ORCA/M 2.0 for the Apple IIGS.
+*
+*   By Mike Westerfield and Barbara Allred
+*
+*   Copyright 1987-1989
+*   Byte Works, Inc.
+*
+*******************************************************************/
+
+#pragma keep "Key3"
+#pragma lint -1
+
+#include <stdio.h>
+
+int main (void)
+
+{
+extern int KEYPRESS (void);		/* declare assembly-language    */
+extern int READCHAR (void);		/*   routines to be called      */
+char ch;				/* character read from keyboard */
+
+printf("Press any key(s) and then RETURN.  Enter CTRL-@ to quit.\n");
+do {
+   while (! KEYPRESS())			/* wait for a keypress */
+      ;
+   ch = READCHAR();			/* get character typed from keybrd */
+   if (ch == 0x0D)			/* write character to the screen */
+      printf ("\n");
+   else
+      printf ("%c", ch);
+   }
+while (ch != 0);
+return 0;
+}
+
+#append "Key3.asm"

C.Samples/Text.Samples/Print.cc

@@ -0,0 +1,34 @@
+/*****************************************************************
+*
+*  Text Printer Demo
+*
+*  This example shows how to access the .PRINTER text printer
+*  driver from a C program.  The .PRINTER driver must be installed
+*  before this sample is executed.
+*
+*  There really isn't much to this sample, which may seem bad at
+*  first, but it's really good:  accessing the text printer driver
+*  really is as simple as opening the printer and writing to it!
+*
+*  By Mike Westerfield
+*
+*  Copyright 1993
+*  Byte Works, Inc.
+*                                 
+*****************************************************************/
+
+#pragma keep "Print"
+#pragma lint -1
+
+#include <stdio.h>
+
+void main (void)
+
+{
+FILE *f;
+
+f = fopen(".printer", "w+");
+fprintf(f, "Hello, printer!\n");
+fputc('\f', f);			/* on most printers, this will eject a page */
+fclose(f);
+}

C.Samples/Text.Samples/Trace.cc

@@ -0,0 +1,64 @@
+/****************************************************************
+*
+*   Trace
+*
+*   ORCA/C can give you a traceback when a run-time error occurs.
+*   A traceback shows the function and line number where the
+*   error occurred, then gives a list of functions and line
+*   numbers that show what subroutine calls were made to get to
+*   the point where the error occurred.  This program illustrates
+*   this by deliberately failing in the function named Fail.
+*
+*   By Mike Westerfield and Barbara Allred
+*
+*   Copyright 1987-1989
+*   Byte Works, Inc.
+*
+******************************************************************/
+
+#pragma keep "Trace"
+#pragma debug 9
+#pragma lint -1
+
+#include <stdio.h>
+
+
+/****************************************************************
+*
+* Fail - Subroutine that will generate a run-time error
+*
+****************************************************************/
+
+static void Fail (void)
+{
+char ch [8000];				/* this array is too large for */
+					/* the default run-time stack  */
+(void)ch;				/* dummy use of ch to avoid lint msg */
+}
+
+
+/****************************************************************
+*
+* DoIt - Calls subroutine that will generate a run-time error
+*
+****************************************************************/
+
+static void DoIt (void)
+
+{
+Fail();
+}
+
+
+/****************************************************************
+*
+* Main program starts here
+*
+****************************************************************/
+
+int main (void)
+
+{
+printf ("This program fails.  Generating a traceback:\n");
+DoIt();
+}

C.Update.ReadMe

@@ -1,15 +1,25 @@
-Welcome to ORCA/C 2.2.0 B6!  This is an update release containing
-patches from community members (Stephen Heumann and Kelvin Sherlock),
-which fix bugs and add new features.  For details on these changes,
-see the cc.notes file in the Release.Notes directory.
+This is an update package that can be used to update ORCA/C 2.1.0 or
+2.2.0 to ORCA/C 2.2.1.  You must have an existing copy of ORCA/C 2.1.0
+or 2.2.0 in order to use this update.  If you do not already have a
+copy, you can get it as part of Opus ][: The Software, a collection of
+Byte Works software which is sold by Juiced.GS:
+https://juiced.gs/store/opus-ii-software/
 
-This package is designed to be applied as an update to an existing
-ORCA installation containing ORCA/C 2.1.0 or later (including the one
-provided on Opus ][: The Software).  To apply the update, simply copy
-the files from this distribution into the corresponding locations in
-your ORCA installation, replacing any older versions.  (One easy way
-to do this is to extract the archive containing this update directly
-on top of your ORCA installation, overwriting all modified files.)
+This update must be applied to an existing ORCA installation containing
+ORCA/C 2.1.0 or ORCA/C 2.2.0 (including the one provided on Opus ][:
+The Software).  To apply the update, you just need to copy the files
+from this distribution into the corresponding locations in your ORCA
+installation, replacing any older versions.
+
+If you received this update as a SHK file, you can simply extract the
+files from it directly on top of your ORCA installation.
+
+If you received this update as a disk image, you can apply the update
+by copying the files into place using the Finder, or by running the
+following command within the root directory of your ORCA installation
+using the text-based ORCA shell:
+
+COPY -C :ORCAC.221:=
 
 In addition to the ORCA shell environment, this update can also be
 used under other environments that are compatible with ORCA/C, such as
@@ -18,20 +28,3 @@ into the directory containing files from a standard ORCA installation
 (normally /lang/orca for GNO).  An updated version of ORCALib suitable
 for use under GNO is available as a separate download at:
 https://github.com/byteworksinc/ORCALib/releases
-
-If you have any questions, or if you want to get involved in ORCA/C
-development, please get in touch.  The ORCA/C development project is
-hosted on GitHub, and bug reports or patches can be submitted there:
-https://github.com/byteworksinc/ORCA-C
-
-Thanks to:
-* Mike Westerfield, for writing ORCA/C, releasing the source code,
-  and permitting it to be updated by the community.
-* Kelvin Sherlock, for providing several patches and bug reports, and
-  for writing several useful tools for modern Apple II development.
-* Soenke Behrens, for compiling a list of ORCA/C bug reports and test
-  cases, which has helped me to identify and fix a number of bugs.
-* The developers of Csmith (http://embed.cs.utah.edu/csmith/), an
-  automated compiler testing tool that has helped to find several bugs.
-
---Stephen Heumann (stephenheumann@gmail.com)

CC.pas

@@ -140,6 +140,8 @@ DoGlobals;                              {create the ~GLOBALS and ~ARRAYS segment
 {shut down the compiler}
 TermHeader;				{make sure the compiled header file is closed}
 CheckStaticFunctions;                   {check for undefined functions}
+if (lint & lintUnused) <> 0 then        {check for unused static vars}
+   CheckUnused(globalTable);
 ffDCBGS.action := 7;			{purge the source file}
 ffDCBGS.pcount := 14;
 ffDCBGS.pathName := @includeFileGS.theString;

CC.rez

@@ -4,12 +4,12 @@ resource rVersion(1) {
    {
       2,				/* Major revision */
       2,				/* Minor revision */
-      0,				/* Bug version */
-      beta,				/* Release stage */
-      6,				/* Non-final release # */
+      1,				/* Bug version */
+      development,			/* Release stage */
+      1,				/* Non-final release # */
       },
    verUS,				/* Region code */
    "ORCA/C",				/* Short version number */
    "Copyright 1997, Byte Works, Inc.\n"	/* Long version number */
-   "Updated 2022"
+   "Updated 2024"
    };

CCommon.asm

@@ -44,37 +44,43 @@ lb1      lda   [fromPtr],Y
 Hash     start cc
 hashSize equ   876                      # hash buckets - 1
 
-sum      equ   0                        hash
+disp     equ   0                        disp into hash table
 length   equ   2                        length of string
 
          subroutine (4:sPtr),4
 
-         stz   sum                      default to bucket 0
          lda   [sPtr]                   set the length of the string
+         tax
          and   #$00FF
          sta   length
          ldy   #1                       start with char 1
-         lda   [sPtr]                   if 1st char is '~', start with char 6
+         txa                            if 1st char is '~', start with char 6
          and   #$FF00
          cmp   #'~'*256
-         bne   lb1
+         bne   lb0
          ldy   #6
 
-lb1      lda   [sPtr],Y                 get the value to add in
-         and   #$3F3F
-         cpy   length                   if there is only 1 char left then
-         bne   lb2
-         and   #$00FF                     and out the high byte
-lb2      clc                            add it to the sum
-         adc   sum
-         sta   sum
-         iny                            next char
+lb0      lda   #0                       initial value is 0
+         bra   lb2                      while there are at least 2 chars left
+lb1      asl   a                          rotate sum left one bit
+         adc   [sPtr],Y                   add in next two bytes
+         iny                              advance two chars
          iny
-         cpy   length
-         ble   lb1
-         mod2  sum,#hashSize+1          return disp
-         asl   sum
-         asl   sum
+lb2      cpy   length
+         blt   lb1
+         bne   lb3                      if there is 1 char left then
+         asl   a                          rotate sum left one bit
+         sta   disp
+         lda   [sPtr],Y
+         and   #$00FF                     and out the high byte
+         adc   disp                       add last byte to the sum
+         sec
+lb3      sbc   #hashSize+1              disp := (sum mod (hashSize+1)) << 2
+         bcs   lb3
+         adc   #hashSize+1
+         asl   a
+         asl   a
+         sta   disp
 
-         return 2:sum
+         return 2:disp                  return disp
          end

CCommon.pas

@@ -74,6 +74,7 @@ interface
 const
                                         {hashsize appears in CCOMMON.ASM}
    hashSize      = 876;                 {# hash buckets - 1}
+                                        {NOTE: hashsize2 is used in Symbol.asm}
    hashSize2     = 1753;                {# hash buckets * 2 - 1}
    maxLine       = 255;                 {max length of a line}
    maxPath	 = 255;			{max length of a path name}
@@ -93,6 +94,8 @@ const
    lintOverflow         = $0020;        {check for overflows}
    lintC99Syntax        = $0040;        {check for syntax that C99 disallows}
    lintReturn           = $0080;        {flag issues with how functions return}
+   lintUnused           = $0100;        {check for unused variables}
+   lintConstantRange    = $0200;        {check for out-of-range constants}
 
                                         {bit masks for GetLInfo flags}
                                         {----------------------------}
@@ -109,7 +112,7 @@ const
    flag_t       = $00001000;            {treat all errors as terminal?}
    flag_w       = $00000200;            {wait when an error is found?}
 
-   versionStr = '2.2.0 B6';		{compiler version}
+   versionStr = '2.2.1 dev';		{compiler version}
 
 type
                                         {Misc.}
@@ -142,6 +145,9 @@ type
        end;
    gsosOutStringPtr = ^gsosOutString;
    
+   { C language standards }
+   cStandardEnum = (c89,c95,c99,c11,c17,c23);
+   
    { The base types include two main categories.  The values starting    }
    { with cg are defined in the code generator, and may be passed to the }
    { code generator for resolution.  The cc types are used internally in }
@@ -195,10 +201,13 @@ type
                lteqop,gteqop,eqeqop,exceqop,andandop,
                barbarop,pluseqop,minuseqop,asteriskeqop,slasheqop,
                percenteqop,ltlteqop,gtgteqop,andeqop,caroteqop,
-               bareqop,poundpoundop,
+               bareqop,poundpoundop,dotdotdotsy,
+               ppnumber,                {preprocessing number (pp-token)}
+               otherch,                 {other non-whitespace char (pp-token)}
                eolsy,eofsy,             {control characters}
                typedef,                 {user types}
-               uminus,uand,uasterisk,   {converted operations}
+                                        {converted operations}
+               uminus,uplus,uand,uasterisk,
                parameteroper,castoper,opplusplus,opminusminus,compoundliteral,
                macroParm);              {macro language}
 
@@ -209,14 +218,15 @@ type
       (illegal,ch_special,ch_dash,ch_plus,ch_lt,ch_gt,ch_eq,ch_exc,
        ch_and,ch_bar,ch_dot,ch_white,ch_eol,ch_eof,ch_char,ch_string,
        ch_asterisk,ch_slash,ch_percent,ch_carot,ch_pound,ch_colon,
-       ch_backslash,letter,digit);
+       ch_backslash,ch_other,letter,digit);
 
                                         {prefixes of a character/string literal}
    charStrPrefixEnum = (prefix_none,prefix_L,prefix_u16,prefix_U32,prefix_u8);
 
    tokenSet = set of tokenEnum;
    tokenClass = (reservedWord,reservedSymbol,identifier,intConstant,longConstant,
-                 longlongConstant,realConstant,stringConstant,macroParameter);
+                 longlongConstant,realConstant,stringConstant,otherCharacter,
+                 preprocessingNumber,macroParameter);
    identPtr = ^identRecord;             {^ to a symbol table entry}
    tokenType = record                   {a token}
       kind: tokenEnum;                  {kind of token}
@@ -233,6 +243,8 @@ type
          stringConstant: (sval: longstringPtr;
                           ispstring: boolean;
                           prefix: charStrPrefixEnum);
+         otherCharacter: (ch: char);    {used for preprocessing tokens only}
+         preprocessingNumber: (errCode: integer);  {used for pp tokens only}
          macroParameter: (pnum: integer);
      end;
  
@@ -318,14 +330,17 @@ type
    initializerPtr = ^initializerRecord; {initializers}
    initializerRecord = record
       next: initializerPtr;             {next record in the chain}
-      count: integer;                   {# of duplicate records}
+      disp: longint;                    {disp within overall object being initialized}
+      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}
-      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 itype: baseTypeEnum of
+            case basetype: baseTypeEnum of
                cgByte,
                cgUByte,
                cgWord,
@@ -365,15 +380,20 @@ type
      iPtr: initializerPtr;              {pointer to the first initializer}
      isForwardDeclared: boolean;        {does this var use a forward declared type?}
      class: tokenEnum;                  {storage class}
+     used: boolean;                     {is this identifier used?}
      case storage: storageType of
         stackFrame: (lln: integer;      {local label #}
                      clnext: identPtr); {next compound literal}
         parameter:  (pln: integer;      {paramater label #}
                      pdisp: integer;    {disp of parameter}
                      pnext: identPtr);  {next parameter}
-        external: ();
+        external:   (inlineDefinition: boolean); {(potential) inline definition of function?}
         global,private: ();
-        none: ();
+        none: (
+           case anonMemberField: boolean of {field from an anonymous struct/union member?}
+              true : (anonMember: identPtr); {containing anonymous struct/union}
+              false: ();
+        );
      end;
 
                                         {mini-assembler}
@@ -476,6 +496,7 @@ var
    bofPtr: ptr;                         {pointer to the start of sourceFile}
    chPtr: ptr;                          {pointer to the next character in the file}
    changedSourceFile: boolean;          {source file changed in function?}
+   cStd: cStandardEnum;                 {selected C standard}
    debugSourceFileGS: gsosOutString;    {debug source file name}
                                         {debugType is also in SCANNER.ASM}
    debugType: (stop,break,autogo);      {line number debug types}
@@ -488,9 +509,9 @@ var
    infoStringGS: gsosOutString;         {language specific command line info}
    intLabel: integer;                   {last used label number}
    languageNumber: integer;             {our language number}
-   lastLine: 0..maxint;                 {last line number used by pc_nam}
+   lastLine: 0..maxint4;                {last line number used by pc_nam}
    liDCBGS: getLInfoDCBGS;		{get/set LInfo DCB}
-   lineNumber: 0..maxint;               {source line number}
+   lineNumber: 0..maxint4;              {source line number}
    nameFound: boolean;                  {has a pc_nam been generated?}
    nextLocalLabel: integer;             {next available local data label number}
    numErrors: integer;                  {number of errors in the program}
@@ -500,6 +521,7 @@ var
    partialFileGS: gsosOutString;        {partial compile list}
    pragmaKeepFile: gsosOutStringPtr;    {filename specified in #pragma keep}
    sourceFileGS: gsosOutString;         {presumed source file name}
+   strictMode: boolean;                 {strictly follow standard, without extensions?}
    tempList: tempPtr;                   {list of temp work variables}
    longlong0: longlong;                 {the value 0 as a longlong}
    longlong1: longlong;                 {the value 1 as a longlong}
@@ -515,10 +537,6 @@ var
    isConstant: boolean;                 {is the initializer expression constant?}
    expressionIsLongLong: boolean;       {is the last constant expression long long?}
 
-                                        {type specifier results}
-                                        {----------------------}
-   typeSpec: typePtr;                   {type specifier}
-
                                         {flags}
                                         {-----}
    codegenStarted: boolean;             {have we started the code generator?}
@@ -820,6 +838,8 @@ var
    msgGS: gsosInString;			{message}
 
 begin {ExitToEditor}
+if disp < 0 then                        {sanity check disp}
+   disp := 0;
 msgGS.size := length(msg^);		{set up the error message}
 msgGS.theString := msg^;
 liDCBGS.org := disp;			{mark the error}
@@ -997,7 +1017,7 @@ case errnum of                          {print the error}
    8 : msg := 'you cannot change languages from an included file';
    9 : msg := concat('Error writing ', objFile.theString.theString);
    10: msg := 'ORCA/C requires version 2.0 or later of the shell';
-   11: msg := 'The program is too large to compile to memory -- use Compile to Disk';
+  {11: msg := 'The program is too large to compile to memory -- use Compile to Disk';}
    12: msg := 'Invalid sym file detected. Re-run ORCA/C to proceed.';
    13: msg := 'file name or command-line parameter is too long';
    otherwise: begin

CGC.asm

@@ -1,40 +1,6 @@
          mcopy cgc.macros
 ****************************************************************
 *
-*  CnvSX - Convert floating point to SANE extended
-*
-*  Inputs:
-*        rec - pointer to a record
-*
-****************************************************************
-*
-CnvSX    start cg
-rec      equ   4                        record containing values
-rec_real equ   0                        disp to real (extended) value
-rec_ext  equ   10                       disp to extended (SANE) value
-
-         tsc                            set up DP
-         phd
-         tcd
-         ph4   rec                      push addr of real number
-         clc                            push addr of SANE number
-         lda   rec
-         adc   #rec_ext
-         tax
-         lda   rec+2
-         adc   #0
-         pha
-         phx
-         fx2x                           convert TOS to extended
-         move4 0,4                      return
-         pld
-         pla
-         pla
-         rtl
-         end
-
-****************************************************************
-*
 *  CnvSC - Convert floating point to SANE comp
 *
 *  Inputs:
@@ -48,8 +14,7 @@ rec_ext  equ   10                       disp to extended (SANE) value
 CnvSC    start cg
 rec      equ   4                        record containing values
 rec_real equ   0                        disp to real (extended) value
-rec_ext  equ   10                       disp to extended (SANE) value
-rec_cmp  equ   20                       disp to comp (SANE) value
+rec_cmp  equ   10                       disp to comp (SANE) value
 
          tsc                            set up DP
          phd

CGC.macros

@@ -175,12 +175,6 @@
  sta 2+&op
  mend
  MACRO
-&LAB FX2X
-&LAB PEA $0010
- LDX #$090A
- JSL $E10000
- MEND
- MACRO
 &LAB FX2C
 &LAB PEA $0510
  LDX #$090A
@@ -435,3 +429,85 @@
 .g
  mnote "Missing closing '}'",16
  mend
+ macro
+&l add4 &m1,&m2,&m3
+ lclb &yistwo
+ lclc &c
+&l ~setm
+ aif c:&m3,.a
+&c amid "&m2",1,1
+ aif "&c"<>"#",.a
+&c amid "&m1",1,1
+ aif "&c"="{",.a
+ aif "&c"="[",.a
+&c amid "&m2",2,l:&m2-1
+ aif &c>=65536,.a
+ clc
+ ~lda &m1
+ ~op adc,&m2
+ ~sta &m1
+ bcc ~&SYSCNT
+ ~op.h inc,&m1
+~&SYSCNT anop
+ ago .c
+.a
+ aif c:&m3,.b
+ lclc &m3
+&m3 setc &m1
+.b
+ clc
+ ~lda &m1
+ ~op adc,&m2
+ ~sta &m3
+ ~lda.h &m1
+ ~op.h adc,&m2
+ ~sta.h &m3
+.c
+ ~restm
+ mend
+ macro
+&l ~op &opc,&op
+ lclc &c
+&c amid "&op",1,1
+ aif "&c"<>"{",.b
+&c amid "&op",l:&op,1
+ aif "&c"="}",.a
+ mnote "Missing closing '}'",2
+&op setc &op}
+.a
+&op amid "&op",2,l:&op-2
+&op setc (&op)
+.b
+&l &opc &op
+ mend
+ macro
+&l ~op.h &opc,&op
+&l anop
+ lclc &c
+&c amid "&op",1,1
+ aif "&c"="[",.b
+ aif "&c"<>"{",.d
+&c amid "&op",l:&op,1
+ aif "&c"="}",.a
+ mnote "Missing closing '}'",2
+&op setc &op}
+.a
+&op amid "&op",2,l:&op-2
+&op setc (&op)
+.b
+ aif &yistwo,.c
+&yistwo setb 1
+ ldy #2
+.c
+&op setc "&op,y"
+ &opc &op
+ mexit
+.d
+ aif "&c"<>"#",.e
+&op amid "&op",2,l:&op-1
+&op setc "#^&op"
+ &opc &op
+ mexit
+.e
+ &opc 2+&op
+ mend

CGC.pas

@@ -31,9 +31,8 @@ uses CCommon, CGI;
 type
                                         {pcode code generation}
                                         {---------------------}
-   realrec = record                     {used to convert from real to in-SANE}
+   realrec = record                     {used to convert from real to comp}
       itsReal: extended;
-      inSANE: packed array[1..10] of byte;
       inCOMP: packed array[1..8] of byte;
       end;
 
@@ -58,15 +57,6 @@ procedure CnvSC (rec: realrec); extern;
 {               has space for the result                        }
 
 
-procedure CnvSX (rec: realrec); extern;
-
-{ convert a real number to SANE extended format                 }
-{                                                               }
-{ parameters:                                                   }
-{       rec - record containing the value to convert; also      }
-{               has space for the result                        }
-
-
 procedure CnvXLL (var result: longlong; val: extended); extern;
 
 { convert a real number to long long                            }

CGI.Comments

@@ -57,7 +57,7 @@
 {  Gen2(pc_mov, banks, bytes)                                   }
 {                                                               }
 {  The top of stack contains a source address, and TOS-1 has a  }
-{  destination address.  The destination address is  removed,	}
+{  destination address.  The source address is removed,         }
 {  and BYTES bytes are moved from the source to the		}
 {  destination.  BANKS is the number of full banks to move; it	}
 {  is used when 64K or more must be moved.  The memory areas	}
@@ -196,6 +196,15 @@
 {  a SIZE bit value.  Extra bits are dropped.                   }
 {                                                               }
 {                                                               }
+{  pc_ckp - check for null pointer                              }
+{                                                               }
+{  Gen0(pc_ckp)                                                 }
+{  Gen0(pc_ckn)                                                 }
+{                                                               }
+{  Make sure a pointer value is not null.  The pc_ckp form      }
+{  checks the value at tos; pc_ckn checks the value at tos-1.   }
+{                                                               }
+{                                                               }
 {  pc_cop - copy to a local variable                            }
 {                                                               }
 {  Gen2t(pc_cop, label, disp, type)                            	}
@@ -306,6 +315,14 @@
 {  the stack.							}
 {                                                               }
 {                                                               }
+{  pc_fix - fix a floating-point variable                       }
+{                                                               }
+{  Gen1t(pc_fix, lab, type)                                     }
+{                                                               }
+{  Change a floating-point value (generally a passed parameter) }
+{  from extended to cgReal, cgDouble,or cgComp.                 }
+{                                                               }
+{                                                               }
 {  pc_gil - increment and load from a global variable           }
 {  pc_gli - load a global variable, then inc the original       }
 {  pc_gdl - decrement and load from a global variable           }
@@ -787,6 +804,17 @@
 {  into the stack frame.                                        }
 {                                                               }
 {                                                               }
+{  pc_rev - return a value from a subroutine                    }
+{                                                               }
+{  Gen0t(pc_rev, type)                                          }
+{                                                               }
+{  This pcode is used to return from a function.  The type is   }
+{  the type of the function, and is used to tell the code       }
+{  generator what type of value to return.  It may be cgByte,   }
+{  cgUByte, cgWord, cgUWord, cgLong, or cgULong.  The value     }
+{  to return is removed from the evaluation stack.              }
+{                                                               }
+{                                                               }
 {  pc_cui - call user procedure, indirect                       }
 {                                                               }
 {  Gen1t(pc_cui, repair, ftype)					}

CGI.Debug

@@ -133,10 +133,13 @@ opt[pc_slq] := 'slq';
 opt[pc_sqr] := 'sqr';
 opt[pc_wsr] := 'wsr';
 opt[pc_rbo] := 'rbo';
+opt[pc_rev] := 'rev';
+opt[pc_ckp] := 'ckp';
+opt[pc_ckn] := 'ckn';
 end; {InitWriteCode}
 
 
-procedure PrintDAG (tag: stringPtr; code: icptr);
+procedure PrintDAG {tag: stringPtr; code: icptr};
 
 { print a DAG							}
 {								}
@@ -280,14 +283,14 @@ with code^ do
       pc_bnt,pc_blx,pc_bnl,pc_ngi,pc_ngl,pc_ngr,pc_ixa,pc_mdl,
       pc_udi,pc_udl,pc_bqr,pc_bqx,pc_baq,pc_bnq,pc_ngq,pc_adq,pc_sbq,
       pc_mpq,pc_umq,pc_dvq,pc_udq,pc_mdq,pc_uqm,pc_slq,pc_sqr,pc_wsr,
-      pc_rbo,pc_sll,pc_shr,pc_usr,pc_slr,pc_vsr: ;
+      pc_rbo,pc_sll,pc_shr,pc_usr,pc_slr,pc_vsr,pc_ckp,pc_ckn: ;
 
 
       dc_prm:
          write('  ', q:1, ':', r:1, ':', s:1);
 
       pc_equ,pc_neq,pc_geq,pc_leq,pc_grt,pc_les,pc_pop,pc_ret,pc_bno,
-      pc_cpi,pc_sto,pc_tri,pc_stk,pc_idl,pc_iil,pc_ili,pc_ild:
+      pc_cpi,pc_sto,pc_tri,pc_stk,pc_idl,pc_iil,pc_ili,pc_ild,pc_rev:
          WriteType(optype);
 
       pc_cnv,pc_cnn: begin

CGI.pas

@@ -33,12 +33,13 @@ const
    cge1                 =       57;     {compiler error}
    cge2                 =       58;     {implementation restriction: too many local labels}
    cge3                 =       60;     {implementation restriction: string space exhausted}
+   cge4                 =      188;     {local variable out of range for DP addressing}
    
                                         {65816 native code generation}
                                         {----------------------------}
                                         {instruction modifier flags}
-   shift8                 =      1;     {shift operand left 8 bits}
-   shift16                =      2;     {shift operand left 16 bits}
+   shift8                 =      1;     {shift operand right 8 bits}
+   shift16                =      2;     {shift operand right 16 bits}
    toolCall               =      4;     {generate a tool call}
    stringReference        =      8;     {generate a string reference}
    isPrivate              =     32;     {is the label private?}
@@ -46,6 +47,8 @@ const
    localLab               =    128;     {the operand is a local lab}
    forFlags               =    256;     {instruction used for effect on flags only}
    subtract1              =    512;     {subtract 1 from address operand}
+   shiftLeft8             =   1024;     {shift operand left 8 bits}
+   labelUsedOnce          =   2048;     {only one branch targets this label}
 
    m_adc_abs              =    $6D;     {op code #s for 65816 instructions}
    m_adc_dir              =    $65;
@@ -69,6 +72,7 @@ const
    m_bpl                  =    $10;
    m_bra                  =    $80;
    m_brl                  =    $82;
+   m_bvc                  =    $50;
    m_bvs                  =    $70;
    m_clc                  =    $18;
    m_cmp_abs              =    $CD;
@@ -83,6 +87,7 @@ const
    m_cpx_abs              =    236;
    m_cpx_dir              =    228;
    m_cpx_imm              =    224;
+   m_cpy_imm              =    $C0;
    m_dea                  =     58;
    m_dec_abs              =    206;
    m_dec_absX             =    $DE;
@@ -204,8 +209,13 @@ const
    d_wrd                  =    261;
    d_sym                  =    262;
    d_cns                  =    263;
+   d_dcb                  =    264;
+   d_dcw                  =    265;
+   d_dcl                  =    266;
 
-   max_opcode             =    263;
+   max_opcode             =    266;
+   
+   asmFlag                =  $8000;     {or'd with opcode to indicate asm code}
 
                                         {Code Generation}
                                         {---------------}
@@ -248,7 +258,8 @@ type
        pc_gli,pc_gdl,pc_gld,pc_cpi,pc_tri,pc_lbu,pc_lbf,pc_sbf,pc_cbf,dc_cns,
        dc_prm,pc_nat,pc_bno,pc_nop,pc_psh,pc_ili,pc_iil,pc_ild,pc_idl,
        pc_bqr,pc_bqx,pc_baq,pc_bnq,pc_ngq,pc_adq,pc_sbq,pc_mpq,pc_umq,pc_dvq,
-       pc_udq,pc_mdq,pc_uqm,pc_slq,pc_sqr,pc_wsr,pc_rbo);
+       pc_udq,pc_mdq,pc_uqm,pc_slq,pc_sqr,pc_wsr,pc_rbo,pc_fix,pc_rev,pc_ckp,
+       pc_ckn);
 
                                         {intermediate code}
                                         {-----------------}
@@ -273,11 +284,17 @@ 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;
 
+   codeRef = icptr;                     {reference to a code location}
+
 					{basic blocks}
                                         {------------}
    iclist = ^iclistRecord;		{used to form lists of records}
@@ -323,6 +340,7 @@ var
                                         {quality or characteristics of }
                                         {code                          }
                                         {------------------------------}
+   checkNullPointers: boolean;          {check for null pointer dereferences?}
    checkStack: boolean;                 {check stack for stack errors?}
    cLineOptimize: boolean;		{+o flag set?}
    code: icptr;                         {current intermediate code record}
@@ -330,6 +348,7 @@ var
    commonSubexpression: boolean;        {do common subexpression removal?}
    currentSegment,defaultSegment: segNameType; {current & default seg names}
    segmentKind: integer;                {kind field of segment (ored with start/data)}
+   defaultSegmentKind: integer;         {default segment kind}
    debugFlag: boolean;                  {generate debugger calls?}
    debugStrFlag: boolean;               {gsbug/niftylist debug names?}
    dataBank: boolean;                   {save, restore data bank?}
@@ -568,6 +587,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        }
@@ -631,6 +660,21 @@ procedure GenTool (fop: pcodes; fp1, fp2: integer; dispatcher: longint);
 {       dispatcher - tool entry point                           }
 
 
+function GetCodeLocation: codeRef;
+
+{ Get a reference to the current location in the generated      }
+{ code, suitable to be passed to RemoveCode.                    }
+
+
+procedure InsertCode (theCode: codeRef);
+
+{ Insert a section of already-generated code that was           }
+{ previously removed with RemoveCode.                           }
+{                                                               }
+{ parameters:                                                   }
+{       theCode - code removed (returned from RemoveCode)       }
+
+
 {procedure PrintBlocks (tag: stringPtr; bp: blockPtr); {debug}
 
 { print a series of basic blocks				}
@@ -640,6 +684,28 @@ procedure GenTool (fop: pcodes; fp1, fp2: integer; dispatcher: longint);
 {    bp - first block to print					}
 
 
+{procedure PrintDAG (tag: stringPtr; code: icptr); {debug}
+
+{ print a DAG                                                   }
+{                                                               }
+{ parameters:                                                   }
+{    tag - label for lines                                      }
+{    code - first node in DAG                                   }
+
+
+function RemoveCode (start: codeRef): codeRef;
+
+{ Remove a section of already-generated code, from immediately  }
+{ after start up to the latest code generated.  Returns the     }
+{ code removed, so it may be re-inserted later.                 }
+{                                                               }
+{ parameters:                                                   }
+{       start - location to start removing from                 }
+{                                                               }
+{ Note: start must be a top-level pcode (not a subexpression).  }
+{ Note: The region removed must not include a dc_enp.           }
+
+
 function TypeSize (tp: baseTypeEnum): integer;
 
 { Find the size, in bytes, of a variable			}
@@ -801,9 +867,12 @@ isXCMD := false;
 codeGeneration := false;                {code generation is not turned on yet}
 currentSegment := '          ';         {start with the blank segment}
 defaultSegment := '          ';
+segmentKind := 0;                       {default to static code segments}
+defaultSegmentKind := 0;
 smallMemoryModel := true;               {small memory model}
 dataBank := false;                      {don't save/restore data bank}
-strictVararg := not cLineOptimize;      {save/restore caller's stack around vararg}
+strictVararg :=                         {save/restore caller's stack around vararg}
+   (not cLineOptimize) or strictMode;
 saveStack := not cLineOptimize;         {save/restore caller's stack reg}
 checkStack := false;                    {don't check stack for stack errors}
 stackSize := 0;				{default to the launcher's stack size}
@@ -819,6 +888,7 @@ profileFlag := false;                   {don't generate profiling code}
 debugFlag := false;                     {don't generate debug code}
 debugStrFlag := false;                  {don't generate gsbug debug strings}
 traceBack := false;                     {don't generate traceback code}
+checkNullPointers := false;             {don't check null pointers}
 volatile := false;			{no volatile qualifiers found}
 
 registers := cLineOptimize;             {don't do register optimizations}
@@ -1224,6 +1294,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        }
@@ -1376,6 +1470,74 @@ if codeGeneration then begin
 end; {GenLdcReal}
 
 
+function GetCodeLocation{: codeRef};
+
+{ Get a reference to the current location in the generated      }
+{ code, suitable to be passed to RemoveCode.                    }
+
+begin {GetCodeLocation}
+GetCodeLocation := DAGhead;
+end {GetCodeLocation};
+
+
+procedure InsertCode {theCode: codeRef};
+
+{ Insert a section of already-generated code that was           }
+{ previously removed with RemoveCode.                           }
+{                                                               }
+{ parameters:                                                   }
+{       theCode - code removed (returned from RemoveCode)       }
+
+var
+   lcode: icptr;
+
+begin {InsertCode}
+if theCode <> nil then
+   if codeGeneration then begin
+      lcode := theCode;
+{     PrintDAG(@'Inserting: ', lcode);  {debug}
+      while lcode^.next <> nil do
+         lcode := lcode^.next;
+      lcode^.next := DAGhead;
+      DAGhead := theCode;
+      end; {if}
+end; {InsertCode}
+
+
+function RemoveCode {start: codeRef): codeRef};
+
+{ Remove a section of already-generated code, from immediately  }
+{ after start up to the latest code generated.  Returns the     }
+{ code removed, so it may be re-inserted later.                 }
+{                                                               }
+{ parameters:                                                   }
+{       start - location to start removing from                 }
+{                                                               }
+{ Note: start must be a top-level pcode (not a subexpression).  }
+{ Note: The region removed must not include a dc_enp.           }
+
+var
+   lcode: icptr;
+
+begin {RemoveCode}
+if start = DAGhead then
+   RemoveCode := nil
+else begin
+   RemoveCode := DAGhead;
+   if codeGeneration then begin
+      lcode := DAGhead;
+      while (lcode^.next <> start) and (lcode^.next <> nil) do
+         lcode := lcode^.next;
+      if lcode^.next = nil then
+         Error(cge1);
+      lcode^.next := nil;
+{     PrintDAG(@'Removing: ', DAGhead); {debug}
+      DAGhead := start;
+      end; {if}
+   end; {else}
+end; {RemoveCode}
+
+
 function TypeSize {tp: baseTypeEnum): integer};
 
 { Find the size, in bytes, of a variable			}

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);
@@ -429,26 +430,6 @@ while not (op^.next^.opcode in [dc_lab, dc_enp, dc_cns, dc_glb,
 end; {RemoveDeadCode}
 
 
-function NoFunctions (op: icptr): boolean;
-
-{ are there any function calls?					}
-{								}
-{ parameters:							}
-{    op - operation tree to search				}
-{								}
-{ returns: True if there are no pc_cup or pc_cui operations	}
-{    in the tree, else false.					}
-
-begin {NoFunctions}
-if op = nil then
-   NoFunctions := true
-else if op^.opcode in [pc_cup,pc_cui,pc_tl1] then
-   NoFunctions := false
-else
-   NoFunctions := NoFunctions(op^.left) or NoFunctions(op^.right);
-end; {NoFunctions}
-
-
 function OneBit (val: longint): boolean;
 
 { See if there is exactly one bit set in val			}
@@ -507,9 +488,6 @@ var
    { parameters:						}
    {    op - tree to check					}
 
-   var
-      result: boolean;		{temp result}
-
    begin {SideEffects}
    if op = nil then begin
       if volatile then
@@ -520,7 +498,8 @@ var
    else if op^.opcode in
       [pc_mov,pc_cbf,pc_cop,pc_cpi,pc_cpo,pc_gil,pc_gli,pc_gdl,
        pc_gld,pc_iil,pc_ili,pc_idl,pc_ild,pc_lil,pc_lli,pc_ldl,
-       pc_lld,pc_sbf,pc_sro,pc_sto,pc_str,pc_cui,pc_cup,pc_tl1] then
+       pc_lld,pc_sbf,pc_sro,pc_sto,pc_str,pc_cui,pc_cup,pc_tl1,
+       pc_fix,pc_ckp] then
       SideEffects := true
    else if op^.opcode = pc_ldc then
       SideEffects := false
@@ -538,7 +517,6 @@ var
    {    newOpcode - opcode to use if the jump sense is reversed	}
 
    var
-      done: boolean;			{optimization done test}
       topcode: pcodes;			{temp opcode}
 
    begin {JumpOptimizations}
@@ -587,6 +565,12 @@ var
             false: (rval: real);
 	 end;
 
+      cnvdbl: record			{for stuffing a double in a quad space}
+         case boolean of
+            true:  (qval: longlong);
+            false: (rval: double);
+         end;
+
    begin {RealStoreOptimizations}
    if opl^.opcode = pc_cnv then
       if baseTypeEnum(opl^.q & $000F) = op^.optype then
@@ -603,7 +587,7 @@ var
                      if lab^ = op^.lab^ then
                         same := true;
             end {if}
-         else {if op^.opcode = pc_str then}
+         else if op^.opcode = pc_str then
             if opcode = pc_lod then
                if q = op^.q then
                   if r = op^.r then
@@ -653,6 +637,19 @@ var
             opl^.optype := cgLong;
             op^.optype := cgLong;
             end; {if}
+      end {if}
+   else if op^.optype = cgDouble then begin
+      if opl^.opcode = pc_ldc then begin
+         cnvdbl.rval := opl^.rval;
+         opl^.qval := cnvdbl.qval;
+         opl^.optype := cgQuad;
+         op^.optype := cgQuad;
+         end {if}
+      else if opl^.opcode in [pc_ind,pc_ldo,pc_lod] then
+         if opl^.optype = cgDouble then begin
+            opl^.optype := cgQuad;
+            op^.optype := cgQuad;
+            end; {if}
       end; {if}
    end; {RealStoreOptimizations}
 
@@ -750,11 +747,13 @@ case op^.opcode of			{check for optimizations of this node}
                op^.opcode := pc_inc;
                op^.q := q;
                op^.right := nil;
+               PeepHoleOptimization(opv);
                end {else if}
             else {if q < 0 then} begin
                op^.opcode := pc_dec;
                op^.q := -q;
                op^.right := nil;
+               PeepHoleOptimization(opv);
                end; {else if}
             end {if}
          else if CodesMatch(op^.left, op^.right, false) then begin
@@ -819,6 +818,7 @@ case op^.opcode of			{check for optimizations of this node}
                op^.q := ord(lval);
                op^.right := nil;
                done := true;
+               PeepHoleOptimization(opv);
                end {else if}
             else if (lval > -maxint) and (lval < 0) then begin
                op^.opcode := pc_dec;
@@ -826,6 +826,7 @@ case op^.opcode of			{check for optimizations of this node}
                op^.q := -ord(lval); 
                op^.right := nil;
                done := true;
+               PeepHoleOptimization(opv);
                end; {else if}
             end {if}
          else if CodesMatch(op^.left, op^.right, false) then
@@ -1750,8 +1751,10 @@ case op^.opcode of			{check for optimizations of this node}
                   opv := op^.right;
                   end; {if}
                end {if}
-            else
+            else begin
                op^.opcode := pc_neq;
+               PeepHoleOptimization(opv);
+               end; {else}
             end {if}
          end {if}
       else if op^.left^.opcode = pc_ldc then
@@ -1836,8 +1839,14 @@ case op^.opcode of			{check for optimizations of this node}
                and (op^.right^.qval.lo = 0) and (op^.right^.qval.hi = 0)) then
             begin
             case op^.opcode of
-               pc_leq: op^.opcode := pc_equ;
-               pc_grt: op^.opcode := pc_neq;
+               pc_leq: begin
+                       op^.opcode := pc_equ;
+                       PeepHoleOptimization(opv);
+                       end;
+               pc_grt: begin
+                       op^.opcode := pc_neq;
+                       PeepHoleOptimization(opv);
+                       end;
                pc_les: if not SideEffects(op^.left) then begin
                           op^.right^.optype := cgWord;
                           op^.right^.q := 0;
@@ -1915,6 +1924,7 @@ case op^.opcode of			{check for optimizations of this node}
             else begin
                op^.opcode := pc_neq;
                op^.optype := cgLong;
+               PeepHoleOptimization(opv);
                end; {else}
             end; {if}
          end {if}
@@ -2282,11 +2292,13 @@ case op^.opcode of			{check for optimizations of this node}
             op^.opcode := pc_dec;
             op^.q := q;
             op^.right := nil;
+            PeepHoleOptimization(opv);
             end {else if}
          else {if q < 0) then} begin
             op^.opcode := pc_inc;
             op^.q := -q;
             op^.right := nil;
+            PeepHoleOptimization(opv);
             end; {else if}
          end {if}
       else if op^.left^.opcode in [pc_inc,pc_dec] then
@@ -2337,12 +2349,14 @@ case op^.opcode of			{check for optimizations of this node}
             op^.q := ord(lval);
             op^.right := nil;
             op^.optype := cgLong;
+            PeepHoleOptimization(opv);
             end {else if}
          else if (lval > -maxint) and (lval < 0) then begin
             op^.opcode := pc_inc;
             op^.q := -ord(lval);
             op^.right := nil;
             op^.optype := cgLong;
+            PeepHoleOptimization(opv);
             end; {else if}       
          end; {if}
       end; {case pc_sbl}
@@ -2461,22 +2475,23 @@ case op^.opcode of			{check for optimizations of this node}
       end; {case pc_sro, pc_str}
 
    pc_sto: begin			{pc_sto}
-      if op^.optype in [cgReal,cgDouble,cgExtended,cgComp] then
-         RealStoreOptimizations(op, op^.right);
+      op2 := op^.right;
       if op^.left^.opcode = pc_lao then begin
          op^.q := op^.left^.q;
          op^.lab := op^.left^.lab;
          op^.opcode := pc_sro;
-         op^.left := op^.right;
+         op^.left := op2;
          op^.right := nil;
          end {if}
       else if op^.left^.opcode = pc_lda then begin
          op^.q := op^.left^.q;
          op^.r := op^.left^.r;
          op^.opcode := pc_str;
-         op^.left := op^.right;
+         op^.left := op2;
          op^.right := nil;
          end; {if}
+      if op^.optype in [cgReal,cgDouble,cgExtended,cgComp] then
+         RealStoreOptimizations(op, op2);
       end; {case pc_sto}
 
    pc_sqr: begin			{pc_sqr}
@@ -2817,7 +2832,7 @@ case op^.opcode of
    pc_cnn, pc_cnv:                                        
       TypeOf := baseTypeEnum(op^.q & $000F);
 
-   pc_stk:
+   pc_stk, pc_ckp:
       TypeOf := TypeOf(op^.left);
 
    pc_bno:
@@ -5479,7 +5494,7 @@ case code^.opcode of
    pc_bnt, pc_bnl, pc_cnv, pc_dec, pc_inc, pc_ind, pc_lbf, pc_lbu,
    pc_ngi, pc_ngl, pc_ngr, pc_not, pc_stk, pc_cop, pc_cpo, pc_tl1,
    pc_sro, pc_str, pc_fjp, pc_tjp, pc_xjp, pc_cup, pc_pop, pc_iil,
-   pc_ili, pc_idl, pc_ild, pc_bnq, pc_ngq, pc_rbo:
+   pc_ili, pc_idl, pc_ild, pc_bnq, pc_ngq, pc_rbo, pc_rev, pc_ckp:
       begin
       code^.left := Pop;
       Push(code);
@@ -5503,7 +5518,7 @@ case code^.opcode of
    pc_gil, pc_gli, pc_gdl, pc_gld, pc_lil, pc_lli, pc_ldl, pc_lld,
    pc_lad, pc_lao, pc_lca, pc_lda, pc_ldc, pc_ldo, pc_lod, pc_nop,
    dc_cns, dc_glb, dc_dst, pc_lnm, pc_nam, pc_nat, dc_lab, pc_add,
-   pc_ujp, dc_pin, pc_ent, dc_sym:
+   pc_ujp, dc_pin, pc_ent, dc_sym, pc_fix:
       Push(code);
 
    pc_ret:
@@ -5514,6 +5529,15 @@ case code^.opcode of
       Push(code);
       end;
 
+   pc_ckn:
+      begin
+      code^.opcode := pc_ckp;
+      temp := Pop;
+      code^.left := Pop;
+      Push(code);
+      Push(temp);
+      end;
+
    pc_cnn:
       begin
       code^.opcode := pc_cnv;

Expression.pas

@@ -250,12 +250,11 @@ procedure Match (kind: tokenEnum; err: integer); extern;
 {       err - error number if the expected token is not found   }
 
 
-procedure TypeName; extern;
+function TypeName: typePtr; extern;
 
 { process a type name (used for casts and sizeof/_Alignof)      }
 {                                                               }
-{ outputs:                                                      }
-{       typeSpec - pointer to the type                          }
+{ returns: a pointer to the type                                }
 
 
 function MakeFuncIdentifier: identPtr; extern;
@@ -278,7 +277,7 @@ function MakeCompoundLiteral(tp: typePtr): identPtr; extern;
 {       tp - the type of the compound literal                   }
 
 
-procedure AutoInit (variable: identPtr; line: integer;
+procedure AutoInit (variable: identPtr; line: longint;
    isCompoundLiteral: boolean); extern;
 
 { generate code to initialize an auto variable                  }
@@ -611,6 +610,41 @@ var
    baseType1,baseType2: baseTypeEnum;   {temp variables (for speed)}
    kind1,kind2: typeKind;               {temp variables (for speed)}
 
+
+   procedure CheckConstantRange(t1: typePtr; value: longint);
+   
+   { Check for situations where an implicit conversion will     }
+   { change the value of a constant.                            }
+   {                                                            }
+   { Note: This currently only addresses conversions to 8-bit   }
+   {    or 16-bit integer types, and intentionally does not     }
+   {    distinguish between signed and unsigned types.          }
+   
+   var
+      min,max: longint;                 {min/max allowed values}
+   
+   begin {CheckConstantRange}
+   if t1^.cType = ctBool then begin
+      min := 0;
+      max := 1;
+      end {if}
+   else if t1^.baseType in [cgByte,cgUByte] then begin
+      min := -128;
+      max := 255;
+      end {else if}
+   else if t1^.baseType in [cgWord,cgUWord] then begin
+      min := -32768;
+      max := 65536;
+      end {else if}
+   else begin
+      min := -maxint4-1;
+      max := maxint4;
+      end; {else}
+   if (value < min) or (value > max) then
+      Error(186);
+   end; {CheckConstantRange}
+
+
 begin {AssignmentConversion}
 kind1 := t1^.kind;
 kind2 := t2^.kind;
@@ -631,6 +665,9 @@ else if kind2 in
    case kind1 of
 
       scalarType: begin
+         if ((lint & lintConstantRange) <> 0) then
+            if isConstant then
+               CheckConstantRange(t1, value);
          baseType1 := t1^.baseType;
          if baseType1 in [cgReal,cgDouble,cgComp] then
             baseType1 := cgExtended;
@@ -702,6 +739,9 @@ else if kind2 in
 
       enumType: begin
          if kind2 = scalarType then begin
+            if ((lint & lintConstantRange) <> 0) then
+               if isConstant then
+                  CheckConstantRange(intPtr, value);
             baseType2 := t2^.baseType;
             if baseType2 in [cgString,cgVoid] then
                Error(47)
@@ -756,6 +796,7 @@ var
    opStack: tokenPtr;                   {operation stack}
    parenCount: integer;                 {# of open parenthesis}
    stack: tokenPtr;                     {operand stack}
+   tType: typePtr;                      {type for cast/sizeof/etc.}
 
    op,sp: tokenPtr;                     {work pointers}
 
@@ -986,6 +1027,7 @@ var
       stack^.token.class := longlongConstant;
       stack^.token.kind := longlongconst;
       stack^.token.qval := longlong0;
+      id := nil;
       end {if}
 
    {if the id is not declared, create a function returning integer}
@@ -1008,7 +1050,7 @@ var
          {fnPtr^.dispatcher := 0;}
          np := pointer(GMalloc(length(fToken.name^)+1));
          CopyString(pointer(np), pointer(fToken.name));
-         id := NewSymbol(np, fnPtr, ident, variableSpace, declared);
+         id := NewSymbol(np, fnPtr, ident, variableSpace, declared, false);
          if ((lint & lintUndefFn) <> 0) or ((lint & lintC99Syntax) <> 0) then
             Error(51);
          end {if}
@@ -1022,6 +1064,9 @@ var
       stack^.token.kind := intconst;
       stack^.token.ival := id^.itype^.eval;
       end; {else if}
+
+   if id <> nil then
+      id^.used := true;
    stack^.id := id;                     {save the identifier}
    ComplexTerm;                         {handle subscripts, selection, etc.}
    1:
@@ -1369,7 +1414,11 @@ var
                                    op1 := op1 * op2;
                   slashch     : begin                                   {/}
                                 if op2 = 0 then begin
-                                   Error(109);
+                                   if not (kind in [normalExpression,
+                                      autoInitializerExpression]) then
+                                      Error(109)
+                                   else if ((lint & lintOverflow) <> 0) then
+                                      Error(129);
                                    op2 := 1;
                                    end; {if}
                                 if unsigned then
@@ -1379,7 +1428,11 @@ var
                                 end;
                   percentch   : begin                                   {%}
                                 if op2 = 0 then begin
-                                   Error(109);
+                                   if not (kind in [normalExpression,
+                                      autoInitializerExpression]) then
+                                      Error(109)
+                                   else if ((lint & lintOverflow) <> 0) then
+                                      Error(129);
                                    op2 := 1;
                                    end; {if}
                                 if unsigned then
@@ -1525,7 +1578,11 @@ var
                   asteriskch  : umul64(llop1, llop2);                   {*}
                   slashch     : begin                                   {/}
                                 if (llop2.lo = 0) and (llop2.hi = 0) then begin
-                                   Error(109);
+                                   if not (kind in [normalExpression,
+                                      autoInitializerExpression]) then
+                                      Error(109)
+                                   else if ((lint & lintOverflow) <> 0) then
+                                      Error(129);
                                    llop2 := longlong1;
                                    end; {if}
                                 if unsigned then
@@ -1535,7 +1592,11 @@ var
                                 end;
                   percentch   : begin                                   {%}
                                 if (llop2.lo = 0) and (llop2.hi = 0) then begin
-                                   Error(109);
+                                   if not (kind in [normalExpression,
+                                      autoInitializerExpression]) then
+                                      Error(109)
+                                   else if ((lint & lintOverflow) <> 0) then
+                                      Error(129);
                                    llop2 := longlong1;
                                    end; {if}
                                 if unsigned then
@@ -1659,6 +1720,7 @@ var
       tildech,                          {~}
       excch,                            {!}
       uminus,                           {unary -}
+      uplus,                            {unary +}
       uand,                             {unary &}
       uasterisk: begin                  {unary *}
          op^.left := Pop;
@@ -1666,12 +1728,16 @@ var
          if op^.token.kind = sizeofsy then begin
             op^.token.kind := ulongConst;
             op^.token.class := longConstant;
-            if op^.left^.token.kind = stringConst then
+            kindLeft := op^.left^.token.kind;
+            if kindLeft = stringConst then
                op^.token.lval := op^.left^.token.sval^.length
             else begin
                lCodeGeneration := codeGeneration;
                codeGeneration := false;
                GenerateCode(op^.left);
+               if kindLeft = dotch then
+                  if isBitfield then
+                     Error(49);
                codeGeneration := lCodeGeneration and (numErrors = 0);
                op^.token.lval := expressionType^.size;
                with expressionType^ do
@@ -1810,6 +1876,7 @@ var
                      ekind := intconst;
                      end;
                   uminus      : op1 := -op1;                    {unary -}
+                  uplus       : ;                               {unary +}
                   uasterisk   : Error(79);                      {unary *}
                   otherwise: Error(57);
                   end; {case}
@@ -1852,6 +1919,7 @@ var
                      if llop1.lo = 0 then
                         llop1.hi := llop1.hi + 1;
                      end;
+                  uplus       : ;                               {unary +}
                   uasterisk   : Error(79);                      {unary *}
                   otherwise: Error(57);
                   end; {case}
@@ -1880,6 +1948,11 @@ var
                      op^.token.kind := ekind;
                      op^.token.rval := -rop1;
                      end;
+                  uplus       : begin                        {unary +}
+                     op^.token.class := realConstant;
+                     op^.token.kind := ekind;
+                     op^.token.rval := rop1;
+                     end;
                   excch       : begin                        {!}
                      op^.token.class := intConstant;
                      op^.token.kind := intconst;
@@ -2002,8 +2075,7 @@ var
             while not (token.kind in [colonch,commach,rparench,eofsy]) do
                NextToken;
             end; {if}
-         TypeName;                      {get the type name}
-         currentType := typeSpec;
+         currentType := TypeName;       {get the type name}
          if (currentType^.size = 0) or (currentType^.kind = functionType) then
             Error(133);
          tl := typesSeen;               {check if it is a duplicate}
@@ -2124,7 +2196,7 @@ begin {ExpressionTree}
 opStack := nil;
 stack := nil;
 if token.kind = typedef then            {handle typedefs that are hidden}
-   if FindSymbol(token,allSpaces,false,true) <> nil then
+   if FindSymbol(token,variableSpace,false,true) <> nil then
       if token.symbolPtr^.class <> typedefsy then
          token.kind := ident;
 if token.kind in startExpression then begin
@@ -2214,7 +2286,7 @@ if token.kind in startExpression then begin
                   doingSizeof := true
                else if opStack^.token.kind = _Alignofsy then
                   doingAlignof := true;
-            TypeName;
+            tType := TypeName;
             if doingSizeof or doingAlignof then begin
 
                {handle a sizeof operator}
@@ -2229,10 +2301,10 @@ if token.kind in startExpression then begin
                sp^.token.kind := ulongconst;
                sp^.token.class := longConstant;
                if doingSizeof then
-                  sp^.token.lval := typeSpec^.size
+                  sp^.token.lval := tType^.size
                else {if doingAlignof then}
                   sp^.token.lval := 1;
-               with typeSpec^ do
+               with tType^ do
                   if (size = 0) or ((kind = arrayType) and (elements = 0)) then
                      Error(133);
                sp^.next := stack;
@@ -2246,7 +2318,7 @@ if token.kind in startExpression then begin
                op^.left := nil;
                op^.middle := nil;
                op^.right := nil;
-               op^.castType := typeSpec;
+               op^.castType := tType;
                op^.token.kind := castoper;
                op^.token.class := reservedWord;
                op^.next := opStack;
@@ -2279,10 +2351,7 @@ if token.kind in startExpression then begin
                   asteriskch: token.kind := uasterisk;
                   minusch   : token.kind := uminus;
                   andch     : token.kind := uand;
-                  plusch    : begin
-                              NextToken;
-                              goto 2;
-                              end;
+                  plusch    : token.kind := uplus;
                   otherwise : Error(57);
                   end; {case}
          if icp[token.kind] = notAnOperation then
@@ -2306,7 +2375,7 @@ if token.kind in startExpression then begin
                   end; {if}
             if token.kind in         {make sure we get what we want}
                [plusplusop,minusminusop,sizeofsy,_Alignofsy,tildech,excch,
-                uasterisk,uminus,uand] then begin
+                uasterisk,uminus,uplus,uand] then begin
                if not expectingTerm then begin
                   Error(38);
                   Skip;
@@ -2762,6 +2831,8 @@ procedure ChangePointer (op: pcodes; size: longint; tp: baseTypeEnum);
 begin {ChangePointer}
 if size = 0 then
    Error(122);
+if checkNullPointers then
+   Gen0(pc_ckn);
 case tp of
    cgByte,cgUByte,cgWord,cgUWord: begin
       if (size = long(size).lsw) and (op = pc_adl)
@@ -2821,6 +2892,7 @@ var
    doingScalar: boolean;                {temp; for assignment operators}
    et: baseTypeEnum;                    {temp storage for a base type}
    i: integer;                          {loop variable}
+   isConst: boolean;                    {is this a constant?}
    isNullPtrConst: boolean;             {is this a null pointer constant?}
    isVolatile: boolean;                 {is this a volatile op?}
    lType: typePtr;                      {type of operands}
@@ -2838,6 +2910,23 @@ var
    ldoDispose: boolean;                 {local copy of doDispose}
 
 
+   procedure CheckForIncompleteStructType;
+   
+   { Check if expressionType is an incomplete struct/union type. }
+   
+   var
+      tp: typePtr;                      {the type}
+   
+   begin
+   tp := expressionType;
+   while tp^.kind = definedType do
+      tp := tp^.dType;
+   if tp^.kind in [structType,unionType] then
+      if tp^.size = 0 then
+         Error(187);
+   end;
+
+
    function ExpressionKind (tree: tokenPtr): typeKind;
 
    { returns the type of an expression                           }
@@ -2871,7 +2960,7 @@ var
    end; {ExpressionKind}
 
 
-   procedure LoadAddress (tree: tokenPtr);
+   procedure LoadAddress (tree: tokenPtr; nullCheck: boolean);
 
    { load the address of an l-value                              }
    {                                                             }
@@ -2928,7 +3017,7 @@ var
       {evaluate a compound literal and load its address}
       AutoInit(tree^.id, 0, true);
       tree^.token.kind := ident;
-      LoadAddress(tree);
+      LoadAddress(tree, false);
       tree^.token.kind := compoundliteral;
       Gen0t(pc_bno, cgULong);
       end {if}
@@ -2936,6 +3025,8 @@ var
 
       {load the address of the item pointed to by the pointer}
       GenerateCode(tree^.left);
+      if nullCheck then
+         Gen0(pc_ckp);
       isBitField := false;
       if not (expressionType^.kind in [pointerType,arrayType,functionType]) then
          Error(79);
@@ -2943,7 +3034,7 @@ var
    else if tree^.token.kind = dotch then begin
 
       {load the address of a field of a record}
-      LoadAddress(tree^.left);
+      LoadAddress(tree^.left, nullCheck);
       eType := expressionType;
       if eType^.kind in [arrayType,pointerType] then begin
          if eType^.kind = arrayType then
@@ -2966,15 +3057,18 @@ var
    else if tree^.token.kind = castoper then begin
 
       {load the address of a field of a record}
-      LoadAddress(tree^.left);
+      LoadAddress(tree^.left, nullCheck);
       expressionType := tree^.castType;
       if expressionType^.kind <> arrayType then
          expressionType := MakePointerTo(expressionType);
       end {else if}
 
    else if ExpressionKind(tree) in [arrayType,pointerType,structType,unionType]
-      then
-      GenerateCode(tree)
+      then begin
+      GenerateCode(tree);
+      if nullCheck then
+         Gen0(pc_ckp);
+      end {else if}
    else begin
       expressionType := intPtr;         {set default type in case of error}
       if doDispose then                 {prevent spurious errors}
@@ -3057,6 +3151,8 @@ var
                end; {case}
 
          pointerType,arrayType: begin
+            if checkNullPointers then
+               Gen0(pc_ckp);
             GenldcLong(expressionType^.pType^.size);
             if inc then
                Gen0(pc_adl)
@@ -3135,10 +3231,12 @@ var
             lSize := iType^.pType^.size;
             if lSize = 0 then
                Error(122);
-            if long(lSize).msw <> 0 then begin
+            if (long(lSize).msw <> 0) or checkNullPointers then begin
 
-               {handle inc/dec of >64K}
+               {handle inc/dec of >64K or with null pointer check}
                LoadScalar(tree^.id);
+               if checkNullPointers then
+                  Gen0(pc_ckp);
                GenLdcLong(lSize);
                if pc_l in [pc_lli,pc_lil] then
                   Gen0(pc_adl)
@@ -3176,7 +3274,7 @@ var
    else begin
 
       {do an indirect ++ or --}
-      LoadAddress(tree);                {get the address to save to}
+      LoadAddress(tree, checkNullPointers);     {get the address to save to}
       if expressionType^.kind = arrayType then
          expressionType := expressionType^.aType
       else if expressionType^.kind = pointerType then
@@ -3216,8 +3314,10 @@ var
          else
             Gen2t(pc_ind, ord(tqVolatile in expressionType^.qualifiers), 0, tp);
          if pc_l in [pc_lli,pc_lld] then
-            if expressionType^.cType in [ctBool,ctFloat,ctDouble,ctLongDouble,
-               ctComp] then begin
+            if (expressionType^.kind = scalarType) and
+               (expressionType^.cType in
+                  [ctBool,ctFloat,ctDouble,ctLongDouble,ctComp])
+               then begin
                t1 := GetTemp(ord(expressionType^.size));
                Gen2t(pc_cop, t1, 0, expressionType^.baseType);
                end; {if}
@@ -3228,8 +3328,10 @@ var
             Gen0t(pc_cpi, tp);
          Gen0t(pc_bno, tp);
          if pc_l in [pc_lli,pc_lld] then {correct the value for postfix ops}
-            if expressionType^.cType in [ctBool,ctFloat,ctDouble,ctLongDouble,
-               ctComp] then begin
+            if (expressionType^.kind = scalarType) and
+               (expressionType^.cType in
+                  [ctBool,ctFloat,ctDouble,ctLongDouble,ctComp])
+               then begin
                Gen0t(pc_pop, expressionType^.baseType);
                Gen2t(pc_lod, t1, 0, expressionType^.baseType);
                Gen0t(pc_bno, expressionType^.baseType);
@@ -3252,6 +3354,7 @@ var
       fntype: typePtr;                  {temp function type}
       ftree: tokenPtr;                  {function address tree}
       ftype: typePtr;                   {function type}
+      hasVarargs: boolean;              {varargs call with 1+ varargs passed?}
       i: integer;                       {loop variable}
       indirect: boolean;                {is this an indirect call?}
       ldoDispose: boolean;              {local copy of doDispose}
@@ -3267,9 +3370,7 @@ var
       {    fType - function type                                }
 
       var
-         kind: typeKind;                {for expression kinds}
          ldoDispose: boolean;           {local copy of doDispose}
-         lnumErrors: integer;		{number of errors before type check}
          numParms: integer;             {# of parameters generated}
          parameters: parameterPtr;      {next prototyped parameter}
          pCount: integer;               {# of parameters prototyped}
@@ -3319,8 +3420,11 @@ var
       fmt := fmt_none;
       fp := nil;
 
-      if ((lint & lintPrintf) <> 0) and fType^.varargs and not indirect then
-        fmt := FormatClassify(ftree^.id^.name^);
+      if (lint & lintPrintf) <> 0 then
+         if fType^.varargs then
+            if not indirect then
+               if ftree^.id^.storage <> private then
+                  fmt := FormatClassify(ftree^.id^.name^);
 
       while parameters <> nil do begin  {count the prototypes}
          pCount := pCount+1;
@@ -3333,8 +3437,11 @@ var
             tp := tp^.right;
             end; {while}
          tp := parms;
-         if (pCount > 0) or ((pCount <> 0) and not ftype^.varargs) then
-            Error(85);
+         if pCount <> 0 then
+            if ftype^.varargs and (pcount < 0) then
+               hasVarargs := true
+            else
+               Error(85);
          end; {if}
 
         tp := parms;
@@ -3345,25 +3452,26 @@ var
       doDispose := false;
       while tp <> nil do begin
          if tp^.middle <> nil then begin
-            lnumErrors := numErrors;
-            kind := ExpressionKind(tp^.middle);
-            if numErrors = lnumErrors then
-               if kind in [structType,unionType] then begin
-        	  GenerateCode(tp^.middle);
-        	  if expressionType^.size & $FFFF8000 <> 0 then
+            GenerateCode(tp^.middle);
+            if expressionType^.kind in [structType,unionType,definedType]
+               then begin
+               tType := expressionType;
+               while tType^.kind = definedType do
+                  tType := tType^.dType;
+               if tType^.kind in [structType,unionType] then begin
+                  if tType^.size & $FFFF8000 <> 0 then
                      Error(61);
-        	  Gen1t(pc_ldc, long(expressionType^.size).lsw, cgWord);
-        	  Gen0(pc_psh);
-        	  end {else if}
-               else
-        	  GenerateCode(tp^.middle);
+                  Gen1t(pc_ldc, long(tType^.size).lsw, cgWord);
+                  Gen0(pc_psh);
+                  end; {if}
+               end; {if}
             if fmt <> fmt_none then begin
-                new(tfp);
-                tfp^.next := fp;
-                tfp^.tk := tp^.middle;
-                tfp^.ty := expressionType;
-                fp := tfp;
-            end;
+               new(tfp);
+               tfp^.next := fp;
+               tfp^.tk := tp^.middle;
+               tfp^.ty := expressionType;
+               fp := tfp;
+               end; {if}
             if prototype then begin
                if pCount = 0 then begin
                   if parameters <> nil then begin
@@ -3403,6 +3511,7 @@ var
    begin {FunctionCall}
    {find the type of the function}
    indirect := true;                    {assume an indirect call}
+   hasVarargs := false;                 {assume no variable arguments}
    ftree := tree^.left;                 {get the function tree}
    if ftree^.token.kind = ident then    {check for direct calls}
       if ftree^.id^.itype^.kind = functionType then begin
@@ -3437,9 +3546,11 @@ var
       if (ftype^.toolNum = 0) and (ftype^.dispatcher = 0) then begin
 	 if indirect then begin
             fntype := expressionType;
-            GenerateCode(ftree);
+            GenerateCode(ftree);            
+            if checkNullPointers then
+               Gen0(pc_ckp);
             expressionType := fntype;
-            Gen1t(pc_cui, ord(fType^.varargs and strictVararg),
+            Gen1t(pc_cui, ord(hasVarargs and strictVararg),
                UsualUnaryConversions);
             end {if}
 	 else begin
@@ -3451,17 +3562,17 @@ var
         	  if fName^[i] in ['a'..'z'] then
                      fName^[i] := chr(ord(fName^[i]) & $5F);
                end; {if}
-            Gen1tName(pc_cup, ord(fType^.varargs and strictVararg),
+            Gen1tName(pc_cup, ord(hasVarargs and strictVararg),
                UsualUnaryConversions, fname);
             end; {else}
-         if fType^.varargs then
+         if hasVarargs then
             hasVarargsCall := true;
 	 end {if}
       else
 	 GenTool(pc_tl1, ftype^.toolNum, long(ftype^.ftype^.size).lsw,
             ftype^.dispatcher);
       expressionType := ftype^.fType;
-      lastWasConst := false;
+      CheckForIncompleteStructType;
       end; {else}
    end; {FunctionCall}      
 
@@ -3586,7 +3697,7 @@ var
 
 
 begin {GenerateCode}
-lastwasconst := false;
+isConst := false;
 isNullPtrConst := false;
 case tree^.token.kind of
 
@@ -3611,17 +3722,18 @@ case tree^.token.kind of
 
 
          arrayType: begin
-            LoadAddress(tree);                             
+            LoadAddress(tree, false);                             
             expressionType := expressionType^.ptype;
             end;
 
          functionType:
-            LoadAddress(tree);                             
+            LoadAddress(tree, false);                             
 
          structType, unionType: begin
-            LoadAddress(tree);                             
+            LoadAddress(tree, false);                             
             if expressionType^.kind = pointerType then
                expressionType := expressionType^.ptype;
+            CheckForIncompleteStructType;
             end;
 
          enumConst: begin
@@ -3648,7 +3760,7 @@ case tree^.token.kind of
 
    intConst,uintConst,ushortConst,charConst,scharConst,ucharConst: begin
       Gen1t(pc_ldc, tree^.token.ival, cgWord);
-      lastwasconst := true;
+      isConst := true;
       lastconst := tree^.token.ival;
       isNullPtrConst := tree^.token.ival = 0;
       if tree^.token.kind = intConst then
@@ -3671,7 +3783,7 @@ case tree^.token.kind of
          expressionType := longPtr
       else
          expressionType := ulongPtr;
-      lastwasconst := true;
+      isConst := true;
       lastconst := tree^.token.lval;
       isNullPtrConst := tree^.token.lval = 0;
       end; {case longConst}
@@ -3683,7 +3795,7 @@ case tree^.token.kind of
       else
          expressionType := ulonglongPtr;
       if (tree^.token.qval.hi = 0) and (tree^.token.qval.lo >= 0) then begin
-         lastwasconst := true;
+         isConst := true;
          lastconst := tree^.token.qval.lo;
          end; {if}
       isNullPtrConst := (tree^.token.qval.hi = 0) and (tree^.token.qval.lo = 0);
@@ -3744,7 +3856,7 @@ case tree^.token.kind of
                end; {with}
             end {if}
          else begin
-            LoadAddress(tree^.left);
+            LoadAddress(tree^.left, checkNullPointers);
             lType := expressionType;
             lisBitField := isBitField;
             lbitDisp := bitDisp;
@@ -3801,7 +3913,7 @@ case tree^.token.kind of
          end {if}
       else begin
          doingScalar := false;
-         LoadAddress(tree^.left);
+         LoadAddress(tree^.left, checkNullPointers);
          lisBitField := isBitField;
          lbitDisp := bitDisp;
          lbitSize := bitSize;
@@ -4315,6 +4427,10 @@ case tree^.token.kind of
                             {NOTE: assumes aType & pType overlap in typeRecord}
             else if not CompTypes(lType^.aType, expressionType^.aType) then
                Error(47);
+            if checkNullPointers then begin
+               Gen0(pc_ckn);
+               Gen0(pc_ckp);
+               end; {if}
             Gen0(pc_sbl);
             if size <> 1 then begin
                GenLdcLong(size);
@@ -4481,6 +4597,19 @@ case tree^.token.kind of
          end; {case}
       end; {case uminus}
 
+   uplus: begin                         {unary +}
+      GenerateCode(tree^.left);
+      if expressionType^.kind <> scalarType then
+         error(66)
+      else case UsualUnaryConversions of
+         cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong,cgQuad,cgUQuad,
+         cgReal,cgDouble,cgComp,cgExtended:
+            ;
+         otherwise:
+            error(66);
+         end; {case}
+      end; {case uplus}
+
    tildech: begin                       {~}
       GenerateCode(tree^.left);
       if expressionType^.kind <> scalarType then
@@ -4543,7 +4672,7 @@ case tree^.token.kind of
       if not (tree^.left^.token.kind in 
          [ident,compoundliteral,stringconst,uasterisk]) then
          L_Value(tree^.left);
-      LoadAddress(tree^.left);
+      LoadAddress(tree^.left, false);
       if tree^.left^.token.kind = stringconst then begin
          {build pointer-to-array type for address of string constant}
          tType := pointer(Malloc(sizeof(typeRecord)));
@@ -4567,6 +4696,9 @@ case tree^.token.kind of
             lType := lType^.pType;
          expressionType := lType;
          isVolatile := tqVolatile in lType^.qualifiers;
+         if checkNullPointers then
+            if lType^.kind <> functionType then
+               Gen0(pc_ckp);
          if lType^.kind = scalarType then
             if lType^.baseType = cgVoid then
                Gen2(pc_cnv, cgULong, cgVoid)
@@ -4578,14 +4710,17 @@ case tree^.token.kind of
             ((lType^.kind in [functionType,arrayType,structType,unionType])
             or ((lType^.kind = definedType) and  {handle const struct/union}
                 (lType^.dType^.kind in [structType,unionType]))) then
-            Error(79);
+            Error(79)
+         else
+            CheckForIncompleteStructType;
          end {if}
       else
          Error(79);
       end; {case uasterisk}
 
    dotch: begin                         {.}
-      LoadAddress(tree^.left);
+      LoadAddress(tree^.left, checkNullPointers);
+      isBitfield := false;
       lType := expressionType;
       if lType^.kind in [arrayType,pointerType,structType,unionType] then begin
          if lType^.kind = arrayType then
@@ -4703,6 +4838,7 @@ case tree^.token.kind of
 if doDispose then
    dispose(tree);
 lastWasNullPtrConst := isNullPtrConst;
+lastWasConst := isConst;
 end; {GenerateCode}
 
 

Header.pas

@@ -15,10 +15,10 @@ interface
 
 uses CCommon, MM, Scanner, Symbol, CGI;
 
-{$segment 'SCANNER'}
+{$segment 'HEADER'}
 
 const
-   symFileVersion = 27;                 {version number of .sym file format}
+   symFileVersion = 44;                 {version number of .sym file format}
 
 var
    inhibitHeader: boolean;		{should .sym includes be blocked?}
@@ -721,6 +721,8 @@ procedure EndInclude {chPtr: ptr};
                 		WriteByte(ord(token.ispstring));
                 		WriteByte(ord(token.prefix));
                 		end;
+            otherCharacter:	WriteByte(ord(token.ch));
+            preprocessingNumber:WriteWord(token.errCode);
             macroParameter:	WriteWord(token.pnum);
             reservedSymbol:	if token.kind in [lbracech,rbracech,lbrackch,
                                    rbrackch,poundch,poundpoundop] then 
@@ -800,7 +802,7 @@ procedure EndInclude {chPtr: ptr};
                   p_keep: WriteLongString(@pragmaKeepFile^.theString);
 
                   p_line: begin
-                     WriteWord(lineNumber);
+                     WriteLong(lineNumber);
                      WriteLongString(@sourceFileGS.theString);
                      end;
 
@@ -826,6 +828,7 @@ procedure EndInclude {chPtr: ptr};
                         | (ord(profileFlag) << 2)
                         | (ord(traceBack) << 3)
                         | (ord(checkStack) << 4)
+                        | (ord(checkNullPointers) << 5)
                         | (ord(debugStrFlag) << 15));
 
                   p_lint: begin
@@ -886,13 +889,16 @@ procedure EndInclude {chPtr: ptr};
                         WriteByte(currentSegment[i]);
                         end; {for}
                      WriteWord(segmentKind);
+                     WriteWord(defaultSegmentKind);
                      end;
 
                   p_unix: WriteByte(ord(unix_1));
                   
                   p_fenv_access: WriteByte(ord(fenvAccess));
                   
-                  p_extensions: WriteByte(ord(extendedKeywords));
+                  p_extensions:
+                     WriteByte(ord(extendedKeywords)
+                        | (ord(extendedParameters) << 1));
 
                   end; {case}
                end; {if}
@@ -1102,6 +1108,9 @@ procedure EndInclude {chPtr: ptr};
          WriteByte(ord(ip^.isForwardDeclared));
          WriteByte(ord(ip^.class));
          WriteByte(ord(ip^.storage));
+         if ip^.storage = external then
+            WriteByte(ord(ip^.inlineDefinition));
+         {if ip^.storage = none then ip^.anonMemberField must be false}
 	 end; {WriteIdent}
          
 
@@ -1196,7 +1205,7 @@ type
 var
    done: boolean;			{for loop termination test}
    typeDispList: typeDispPtr;		{type displacement/pointer table}
-   includeFileName: gsosInStringPtr;	{name of include file}
+   includesPtr: ptr;			{ptr to includes section from sym file}
    i: 1..maxint;			{loop/index variable}
 
 
@@ -1297,7 +1306,6 @@ var
    while len > 0 do begin
       giRec.pCount := 7;
       giRec.pathname := pointer(ReadLongString);
-      includeFileName := giRec.pathname; {save name to print later}
       len := len - (giRec.pathname^.size + 18);
       GetFileInfoGS(giRec);
       if ToolError = 0 then begin
@@ -1315,6 +1323,34 @@ var
    end; {DatesMatch}
 
 
+   procedure PrintIncludes;
+
+   { Print "Including ..." lines for the headers		}
+
+   type
+      longptr = ^longint;
+
+   var
+      dataPtr: ptr;                     {pointer to data from sym file}
+      endPtr: ptr;                      {pointer to end of includes section}
+      i: 1..maxint;			{loop/index variable}
+      includeNamePtr: gsosInStringPtr;  {pointer to an include file name}
+
+   begin {PrintIncludes}
+   dataPtr := includesPtr;
+   endPtr := pointer(ord4(dataPtr) + longptr(dataPtr)^ + 4);
+   dataPtr := pointer(ord4(dataPtr) + 4);
+   while dataPtr <> endPtr do begin
+      includeNamePtr := gsosInStringPtr(dataPtr);
+      write('Including ');
+      for i := 1 to includeNamePtr^.size do
+         write(includeNamePtr^.theString[i]);
+      writeln;
+      dataPtr := pointer(ord4(dataPtr) + includeNamePtr^.size + 18);
+      end; {while}
+   end; {PrintIncludes}
+
+
    procedure ReadMacroTable;
 
    { Read macros from the symbol file				}
@@ -1356,6 +1392,8 @@ var
                 	        token.ispstring := ReadByte <> 0;
                 	        token.prefix := charStrPrefixEnum(ReadByte);
                 	        end;
+         otherCharacter:	token.ch := chr(ReadByte);
+         preprocessingNumber:   token.errCode := ReadWord;
          macroParameter:	token.pnum := ReadWord;
          reservedSymbol:	if token.kind in [lbracech,rbracech,lbrackch,
                                    rbrackch,poundch,poundpoundop] then 
@@ -1452,7 +1490,7 @@ var
             end;
 
          p_line: begin
-            lineNumber := ReadWord;
+            lineNumber := ReadLong - 1;
             lsPtr := ReadLongString;
             sourceFileGS.theString.size := lsPtr^.length;
             for i := 1 to sourceFileGS.theString.size do
@@ -1488,6 +1526,7 @@ var
             profileFlag := odd(val >> 2);
             traceback := odd(val >> 3);
             checkStack := odd(val >> 4);
+            checkNullPointers := odd(val >> 5);
             debugStrFlag := odd(val >> 15);
             end;
 
@@ -1556,13 +1595,18 @@ var
                currentSegment[i] := chr(ReadByte);
                end; {for}
             segmentKind := ReadWord;
+            defaultSegmentKind := ReadWord;
             end;
 
          p_unix: unix_1 := boolean(ReadByte);
          
          p_fenv_access: fenvAccess := boolean(ReadByte);
          
-         p_extensions: extendedKeywords := boolean(ReadByte);
+         p_extensions: begin
+            i := ReadByte;
+            extendedKeywords := odd(i);
+            extendedParameters := odd(i >> 1);
+            end;
 
          otherwise: begin
             PurgeSymbols;
@@ -1797,6 +1841,11 @@ var
       sp^.isForwardDeclared := boolean(ReadByte);
       sp^.class := tokenEnum(ReadByte);
       sp^.storage := storageType(ReadByte);
+      sp^.used := false;
+      if sp^.storage = none then
+         sp^.anonMemberField := false
+      else if sp^.storage = external then
+         sp^.inlineDefinition := boolean(ReadByte);
       ReadIdent := sp;
       end; {ReadIdent}
 
@@ -1960,14 +2009,11 @@ if not ignoreSymbols then begin
             PurgeSymbols;
 	 typeDispList := nil;
 	 while not done do begin
+            includesPtr := symPtr;
             if DatesMatch then begin
                if SourceMatches then begin
-                  if progress then begin
-                     write('Including ');
-                     for i := 1 to includeFileName^.size do
-                        write(includeFileName^.theString[i]);
-                     writeln;
-                     end; {if}
+                  if progress then
+                     PrintIncludes;
         	  ReadMacroTable;
         	  ReadSymbolTable;
         	  ReadPragmas;

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                                       }

Native.asm

@@ -87,7 +87,8 @@ lb1      lda   nPeep+peep_opcode,X        if npeep[i].opcode = d_lab then
          inc   fn
          bra   lab1                           goto 1;
 lb2      anop                                 end;
-         lda   nPeep+peep_opcode,X        len := len+size[npeep[i].mode];
+         lda   nPeep+peep_opcode,X        len := len+size[npeep[i].opcode & ~asmFlag];
+         and   #$7FFF
          tay
          lda   size,Y
          and   #$00FF
@@ -123,7 +124,8 @@ lb4      lda   i                        while i < nnextspot do begin
          inc   fn
          bra   lab1                           goto 1;
 lb5      anop                                 end;
-         lda   nPeep+peep_opcode,X        len := len+size[npeep[i].mode];
+         lda   nPeep+peep_opcode,X        len := len+size[npeep[i].opcode & ~asmFlag];
+         and   #$7FFF
          tay
          lda   size,Y
          and   #$00FF
@@ -162,5 +164,5 @@ size     dc    i1'2,2,2,2,2,2,2,2,1,3,1,1,3,3,3,4'
          dc    i1'3,2,2,2,2,2,2,2,1,3,1,1,3,3,3,4'
          dc    i1'2,2,2,2,3,2,2,2,1,3,1,1,3,3,3,4'
 
-         dc    i1'0,0,1,2,0,2,0,255'
+         dc    i1'0,0,1,2,0,2,0,255,1,2,4'
          end

Native.pas

@@ -110,6 +110,14 @@ procedure GenLab (lnum: integer);
 {       lnum - label number                                     }
 
 
+procedure GenLabUsedOnce (lnum: integer);
+
+{ generate a label that is only targeted by one branch          }
+{                                                               }
+{ parameters:                                                   }
+{       lnum - label number                                     }
+
+
 procedure InitFile (keepName: gsosOutStringPtr; keepFlag: integer; partial: boolean);
 
 { Set up the object file					}
@@ -293,7 +301,7 @@ else begin
       end; {if}
    if shift <> 0 then begin
       Out(129);                         {shift the address}
-      Out2(-shift); Out2(-1);
+      Out2(-shift); if (shift > 0) then Out2(-1) else Out2(0);
       Out(7);
       end; {if}
    if lab <> maxlabel then              {if not a string, end the expression}
@@ -312,7 +320,7 @@ procedure UpDate (lab: integer; labelValue: longint);
 {       labelValue - displacement in seg where label is located }
 
 var
-   next,temp: labelptr;                 {work pointers}
+   next: labelptr;                      {work pointer}
 
 begin {UpDate}
 if labeltab[lab].defined then
@@ -334,7 +342,6 @@ else begin
          Out2(long(labelvalue).lsw);
          Out2(long(labelvalue).msw);
          blkcnt := blkcnt-4;
-         temp := next;
          next := next^.next;
          end; {while}
       segdisp := blkcnt;
@@ -358,9 +365,10 @@ procedure WriteNative (opcode: integer; mode: addressingMode; operand: integer;
 label 1;
 
 type
-   rkind = (k1,k2,k3,k4);               {cnv record types}
+   rkind = (k1,k2,k3,k4,k5);            {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}
@@ -368,7 +376,8 @@ var
          k1: (rval: real;);
          k2: (dval: double;);
          k3: (qval: longlong);
-         k4: (ival1,ival2,ival3,ival4: integer;);
+         k4: (eval: extended);
+         k5: (ival1,ival2,ival3,ival4,ival5: integer;);
       end;
    count: integer;                      {number of constants to repeat}
    i,j,k: integer;                      {loop variables}
@@ -394,7 +403,7 @@ var
       pc := pc+1;
       end {if}
    else if (flags & localLab) <> 0 then
-      LabelSearch(long(name).lsw, 1, ord(odd(flags div shift16))*16, operand)
+      LabelSearch(long(name).lsw, 1, ord((flags & shift16) <> 0)*16, operand)
    else if (flags & shift16) <> 0 then
       RefName(name, operand, 1, -16)
    else
@@ -426,7 +435,7 @@ var
    else if (flags & shift8) <> 0 then
       RefName(name, operand, 2, -8)
    else if (flags & localLab) <> 0 then
-      LabelSearch(long(name).lsw, 2, ord(odd(flags div shift16))*16, operand)
+      LabelSearch(long(name).lsw, 2, ord((flags & shift16) <> 0)*16, operand)
    else if (flags & shift16) <> 0 then
       RefName(name, operand, 2, -16)
    else if name = nil then
@@ -458,6 +467,26 @@ var
    end; {DefGlobal}
 
 
+   function ShiftSize (flags: integer): integer;
+
+   { Determine the shift size specified by flags.               }
+   { (Positive means right shift, negative means left shift.)   }
+   {                                                            }
+   { parameters:                                                }
+   {    flags - the flags                                       }
+
+   begin {ShiftSize}
+   if (flags & shift8) <> 0 then
+      ShiftSize := 8
+   else if (flags & shift16) <> 0 then
+      ShiftSize := 16
+   else if (flags & shiftLeft8) <> 0 then
+      ShiftSize := -8
+   else
+      ShiftSize := 0;
+   end; {ShiftSize}
+
+
 begin {WriteNative}
 { writeln('WriteNative: ',opcode:4, ', mode=', ord(mode):1,
    ' operand=', operand:1);      {debug}
@@ -474,6 +503,7 @@ case mode of
             if not longA then
                if operand = 255 then
                   goto 1;
+         opcode := opcode & ~asmFlag;
          CnOut(opcode);
          if opcode = m_pea then
             GenImmediate2
@@ -487,12 +517,12 @@ case mode of
          else if opcode in [m_rep,m_sep,m_cop] then begin
             GenImmediate1;
             if opcode = m_rep then begin
-               if odd(operand div 32) then longA := true;
-               if odd(operand div 16) then longI := true;
+               if (operand & 32) <> 0 then longA := true;
+               if (operand & 16) <> 0 then longI := true;
                end {if}
             else if opcode = m_sep then begin
-               if odd(operand div 32) then longA := false;
-               if odd(operand div 16) then longI := false;
+               if (operand & 32) <> 0 then longA := false;
+               if (operand & 16) <> 0 then longI := false;
                end; {else}
             end {else}
          else
@@ -505,16 +535,16 @@ case mode of
 
    longabs: begin
       CnOut(opcode);
-      isJSL := opcode = m_jsl;          {allow for dynamic segs}
+      isJSL := (opcode & ~asmFlag) = m_jsl;     {allow for dynamic segs}
       if name = nil then
-         if odd(flags div toolcall) then begin
+         if (flags & toolcall) <> 0 then begin
             CnOut2(0);
             CnOut(225);
             end {if}
          else
             LabelSearch(operand, 3, 0, 0)
       else
-         if odd(flags div toolcall) then begin
+         if (flags & toolcall) <> 0 then begin
             CnOut2(long(name).lsw);
             CnOut(long(name).msw);
             end {if}
@@ -524,7 +554,7 @@ case mode of
       end;
 
    longabsolute: begin
-      if opcode <> d_add then begin
+      if opcode <> d_dcl then begin
          CnOut(opcode);
          i := 3;
          end {if}
@@ -535,7 +565,7 @@ case mode of
       else if (flags & constantOpnd) <> 0 then begin
          lval := ord4(name);
          CnOut2(long(lval).lsw);
-         if opcode = d_add then
+         if opcode = d_dcl then
             CnOut2(long(lval).msw)
          else
             CnOut(long(lval).msw);
@@ -545,13 +575,13 @@ case mode of
       else begin
          CnOut2(operand);
          CnOut(0);
-         if opcode = d_add then
+         if opcode = d_dcl then
             CnOut(0);
          end; {else}
       end;
 
    absolute: begin
-      if opcode <> d_add then
+      if opcode <> d_dcw then
          CnOut(opcode);
       if (flags & localLab) <> 0 then
          LabelSearch(long(name).lsw, 2, 0, operand)
@@ -564,7 +594,7 @@ case mode of
       end;
 
    direct: begin
-      if opcode <> d_add then
+      if opcode <> d_dcb then
          CnOut(opcode);
       if (flags & localLab) <> 0 then
          LabelSearch(long(name).lsw, 1, 0, operand)
@@ -645,15 +675,28 @@ case mode of
                                      CnOut(cns.inCOMP[j]);
                                   end;
             cgExtended          : begin
-                                  cns.itsReal := icptr(name)^.rval;
-                                  CnvSX(cns);
-                                  for j := 1 to 10 do
-                                     CnOut(cns.inSANE[j]);
+                                  cnv.eval := icptr(name)^.rval;
+                                  CnOut2(cnv.ival1);
+                                  CnOut2(cnv.ival2);
+                                  CnOut2(cnv.ival3);
+                                  CnOut2(cnv.ival4);
+                                  CnOut2(cnv.ival5);
                                   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
@@ -701,7 +744,7 @@ case mode of
       end;
 
    genAddress: begin
-      if opcode < 256 then
+      if opcode < 256 then              {includes opcodes with asmFlag}
          CnOut(opcode);
       if (flags & stringReference) <> 0 then begin
          Purge;
@@ -732,7 +775,7 @@ case mode of
          else
             LabelSearch(operand, 1, 16, 0)
       else if (flags & subtract1) <> 0 then
-         LabelSearch(operand, 0, 0, 0)
+         LabelSearch(operand, 0, ShiftSize(flags), 0)
       else
          LabelSearch(operand, 2, 0, 0);
       end;
@@ -816,13 +859,13 @@ case p_opcode of
    m_plx:
       xRegister.condition := regUnknown;
 
-   m_bcc,m_bcs,m_beq,m_bmi,m_bne,m_bpl,m_bvs,
+   m_bcc,m_bcs,m_beq,m_bmi,m_bne,m_bpl,m_bvc,m_bvs,
    m_pha,m_phb,m_phd,m_php,m_phx,m_phy,m_pei_dir,m_tcs:
       goto 3;
    
    m_bra,m_brl,m_clc,m_cmp_abs,m_cmp_dir,m_cmp_imm,m_cmp_s,m_cmp_indl,
    m_cmp_indly,m_cpx_imm,m_jml,m_jmp_indX,m_plb,m_rtl,m_rts,m_sec,d_add,d_pin,
-   m_cpx_abs,m_cpx_dir,m_cmp_dirx,m_plp,m_cop,d_wrd:    ;
+   m_cpx_abs,m_cpx_dir,m_cpy_imm,m_cmp_dirx,m_plp,m_cop,d_wrd:    ;
 
    m_pea: begin
       if aRegister.condition = regImmediate then
@@ -1448,9 +1491,9 @@ Out(0);                                 {end the segment}
 segDisp := 8;                           {update header}
 Out2(long(pc).lsw);
 Out2(long(pc).msw);
-if pc > $0000FFFF then
+if pc > $00010000 then
    if currentSegment <> '~ARRAYS   ' then
-      Error(112);
+      Error(184);
 blkcnt := blkcnt-4;                     {purge the segment to disk}
 segDisp := blkcnt;
 CloseSeg;
@@ -1525,10 +1568,10 @@ var
       for i := ns to nnextSpot-1 do begin
          opcode := npeep[i].opcode;
          if opcode in
-            [m_bcc,m_bcs,m_beq,m_bmi,m_bne,m_bpl,m_bra,m_brl,m_bvs,m_jml,
+            [m_bcc,m_bcs,m_beq,m_bmi,m_bne,m_bpl,m_bra,m_brl,m_bvc,m_bvs,m_jml,
              m_jmp_indX,m_jsl,m_lda_abs,m_lda_absx,m_lda_dir,m_lda_dirx,
              m_lda_imm,m_lda_indl,m_lda_indly,m_lda_long,m_lda_longx,m_lda_s,
-             m_mvn,m_pla,m_rtl,m_rts,m_tdc,m_txa,m_tya,m_tsc,d_end,d_bmov,
+             m_pla,m_rtl,m_rts,m_tdc,m_txa,m_tya,m_tsc,d_end,d_bmov,
              d_add,d_pin,d_wrd,d_sym,d_cns] then begin
             ASafe := true;
             goto 1;
@@ -1602,7 +1645,7 @@ var
                      end; {if}
 
          m_bcs,m_beq,m_bne,m_bmi,m_bpl,m_bcc:
-            if npeep[ns+2].opcode = d_lab then
+            if npeep[ns+2].opcode = d_lab then begin
                if npeep[ns+2].operand = operand then
                   if npeep[ns+1].opcode = m_brl then begin
                      if Short(ns,npeep[ns+1].operand) then begin
@@ -1637,7 +1680,22 @@ var
                         opcode := m_bcs
                      else
                         opcode := m_bmi;
-                     end; {else if m_bra}
+                     end {else if m_bra}
+                  else if npeep[ns+3].opcode in [m_bra,m_brl] then
+                     if Short(ns,npeep[ns+3].operand) then begin
+                        operand := npeep[ns+3].operand;
+                        if (npeep[ns+2].flags & labelUsedOnce) <> 0 then
+                           Remove(ns+2);
+                        end; {if}
+               end {if}
+            else if npeep[ns+3].opcode = d_lab then
+               if npeep[ns+3].operand = operand then
+                  if npeep[ns+4].opcode in [m_bra,m_brl] then
+                     if Short(ns,npeep[ns+4].operand) then begin
+                        operand := npeep[ns+4].operand;
+                        if (npeep[ns+3].flags & labelUsedOnce) <> 0 then
+                           Remove(ns+3);
+                        end; {if}
 
          m_brl:
             if Short(ns,operand) then begin
@@ -1646,7 +1704,8 @@ var
                didOne := true;
                end; {if}
 
-         m_bvs:
+         {disabled because current codegen does not produce this sequence}
+         {m_bvs:
             if npeep[ns+2].opcode = d_lab then
                if npeep[ns+2].operand = operand then
                   if npeep[ns+1].opcode = m_bmi then
@@ -1661,11 +1720,12 @@ var
                                     Remove(ns+3);
                                     end; {if}
 
-         m_dec_abs:
+         {disabled - can generate bad code}
+         {m_dec_abs:
             if npeep[ns+1].opcode = m_lda_abs then
                if name^ = npeep[ns+1].name^ then
                   if npeep[ns+2].opcode = m_beq then
-                     Remove(ns+1);
+                     Remove(ns+1);}
 
          m_lda_abs:
             if npeep[ns+1].opcode = m_clc then begin
@@ -1740,13 +1800,52 @@ var
                npeep[ns+2] := npeep[ns];
                Remove(ns);
                end {else if}
-            else if npeep[ns+1].opcode = m_xba then
+            else if npeep[ns+1].opcode = m_xba then begin
                if npeep[ns+2].opcode = m_and_imm then
                   if npeep[ns+2].operand = $00FF then begin
                      operand := operand+1;
                      Remove(ns+1);
+                     end {if}
+               end {else if}
+            else if npeep[ns+1].opcode = m_tay then
+               if npeep[ns+2].opcode in [m_lda_dir,m_lda_indly,m_pla] then begin
+                  opcode := m_ldy_dir;
+                  Remove(ns+1);
+                  end {if}
+               else if npeep[ns+2].opcode = m_pld then
+                  if npeep[ns+3].opcode = m_tsc then begin
+                     opcode := m_ldy_dir;
+                     Remove(ns+1);
                      end; {if}
-                              
+
+         m_ldx_dir:
+            if npeep[ns+1].opcode = m_txs then  {optimize stack repair code}
+               if npeep[ns+2].opcode = m_tsx then begin
+                  if npeep[ns+3].opcode = m_stx_dir then
+                     if npeep[ns+3].operand = npeep[ns].operand then begin
+                        Remove(ns+2);
+                        Remove(ns+2);
+                        end; {if}
+                  end {if}
+               else if npeep[ns+2].opcode in
+                  [m_sta_dir,m_sta_abs,m_sta_long,m_sta_indl,m_tyx] then begin
+                  if (npeep[ns+2].opcode <> m_sta_dir)
+                     or (npeep[ns+2].operand <> npeep[ns].operand) then
+                     if npeep[ns+3].opcode = m_tsx then
+                        if npeep[ns+4].opcode = m_stx_dir then
+                           if npeep[ns+4].operand = npeep[ns].operand then begin
+                              Remove(ns+3);
+                              Remove(ns+3);
+                              if npeep[ns+2].opcode = m_tyx then
+                                 Remove(ns+2);
+                              end; {if}
+                  end {else if}
+               else if npeep[ns+2].opcode = m_tsc then begin
+                  npeep[ns].opcode := m_lda_dir;
+                  npeep[ns+1].opcode := m_tcs;
+                  Remove(ns+2);
+                  end; {else if}
+
          m_pei_dir:
             if npeep[ns+1].opcode = m_pla then begin
                opcode := m_lda_dir;
@@ -1806,14 +1905,14 @@ var
                if operand = npeep[ns+1].operand then
                   if name = npeep[ns+1].name then
                      if not (npeep[ns+2].opcode in
-                        [m_bcc,m_bcs,m_beq,m_bmi,m_bne,m_bpl,m_bvs]) then
+                        [m_bcc,m_bcs,m_beq,m_bmi,m_bne,m_bpl,m_bvc,m_bvs]) then
                         Remove(ns+1);
 
          m_sta_dir:
             if npeep[ns+1].opcode = m_lda_dir then
                if operand = npeep[ns+1].operand then
                   if not (npeep[ns+2].opcode in
-                     [m_bcc,m_bcs,m_beq,m_bmi,m_bne,m_bpl,m_bvs]) then
+                     [m_bcc,m_bcs,m_beq,m_bmi,m_bne,m_bpl,m_bvc,m_bvs]) then
                      Remove(ns+1);
 
          m_plb:
@@ -1838,7 +1937,7 @@ var
                end {if}
             else if npeep[ns+1].opcode = m_txa then begin
                if not (npeep[ns+2].opcode in
-                  [m_bcc,m_bcs,m_beq,m_bmi,m_bne,m_bpl,m_bvs]) then begin
+                  [m_bcc,m_bcs,m_beq,m_bmi,m_bne,m_bpl,m_bvc,m_bvs]) then begin
                   Remove(ns);
                   Remove(ns);
                   end; {if}
@@ -1857,12 +1956,16 @@ var
 
          m_tya:
             if npeep[ns+1].opcode = m_sta_dir then begin
-               npeep[ns+1].opcode := m_sty_dir;
-               Remove(ns);
+               if ASafe(ns+2) then begin
+                  npeep[ns+1].opcode := m_sty_dir;
+                  Remove(ns);
+                  end; {if}
                end {if}
             else if npeep[ns+1].opcode = m_sta_abs then begin
-               npeep[ns+1].opcode := m_sty_abs;
-               Remove(ns);
+               if ASafe(ns+2) then begin
+                  npeep[ns+1].opcode := m_sty_abs;
+                  Remove(ns);
+                  end; {if}
                end; {else if}
 
          m_tyx:
@@ -1876,7 +1979,8 @@ var
                Remove(ns);
                Remove(ns);
                end {if}
-            else if npeep[ns+1].opcode in [m_ldx_abs,m_ldx_dir] then
+            else if npeep[ns+1].opcode in
+               [m_ldx_abs,m_ldx_dir,m_ldy_imm,m_ldy_dir] then
                if npeep[ns+2].opcode = m_pla then begin
                   Remove(ns+2);
                   Remove(ns);
@@ -1910,6 +2014,35 @@ var
                   if not volatile then
                      Remove(ns+1);
 
+         m_tcd:
+            if npeep[ns+1].opcode = m_tdc then
+               Remove(ns+1)
+            else if npeep[ns+1].opcode in [m_pea,m_stz_dir,m_stz_abs] then
+               if npeep[ns+2].opcode = m_tdc then
+                  Remove(ns+2);
+
+         m_tcs:
+            if npeep[ns+1].opcode = m_tsx then
+               if npeep[ns+2].opcode = m_stx_dir then begin
+                  npeep[ns+2].opcode := m_sta_dir;
+                  Remove(ns+1);
+                  end; {if}
+
+         m_tsx:
+            if npeep[ns+1].opcode = m_stx_dir then
+               if npeep[ns+2].opcode = m_pei_dir then
+                  if npeep[ns+3].opcode = m_tsx then
+                     if npeep[ns+4].opcode = m_stx_dir then
+                        if npeep[ns+1].operand = npeep[ns+2].operand then
+                           if npeep[ns+1].operand = npeep[ns+4].operand then
+                              begin
+                              npeep[ns+1].opcode := m_phx;
+                              npeep[ns+1].mode := implied;
+                              Remove(ns+2);
+                              end; {if}
+
+         {extra explicit cases to ensure this case statement uses a jump table}
+         m_rtl,m_rts,m_jml,m_jsl,m_mvn,m_plp,m_pld,m_txs,
          otherwise: ;
 
          end; {case}
@@ -1919,7 +2052,7 @@ var
 begin {GenNative}
 { writeln('GenNative: ',p_opcode:4, ', mode=', ord(p_mode):1,
    ' operand=', p_operand:1);      {debug}
-if npeephole and not (strictVararg and hasVarargsCall) then begin
+if npeephole then begin
    if (nnextspot = 1) and not (p_opcode in nleadOpcodes) then begin
       if p_opcode <> d_end then
          if registers then
@@ -2166,6 +2299,10 @@ case callNum of
    92: sp := @'~DOUBLEPRECISION';
    93: sp := @'~COMPPRECISION';
    94: sp := @'~CUMUL2';
+   95: sp := @'~REALFIX';
+   96: sp := @'~DOUBLEFIX';
+   97: sp := @'~COMPFIX';
+   98: sp := @'~CHECKPTRC';
    otherwise:
       Error(cge1);
    end; {case}
@@ -2185,6 +2322,18 @@ GenNative(d_lab, gnrlabel, lnum, nil, 0);
 end; {GenLab}
 
 
+procedure GenLabUsedOnce {lnum: integer};
+
+{ generate a label that is only targeted by one branch          }
+{                                                               }
+{ parameters:                                                   }
+{       lnum - label number                                     }
+
+begin {GenLabUsedOnce}
+GenNative(d_lab, gnrlabel, lnum, nil, labelUsedOnce);
+end; {GenLabUsedOnce}
+
+
 procedure InitFile {keepName: gsosOutStringPtr; keepFlag: integer; partial: boolean};
 
 { Set up the object file					}
@@ -2223,11 +2372,17 @@ procedure InitFile {keepName: gsosOutStringPtr; keepFlag: integer; partial: bool
 
       { set up the data bank register                           }
 
+      var
+         lisJSL: boolean;               {saved copy of isJSL}
+
       begin {SetDataBank}
+      lisJSL := isJSL;
+      isJSL := false;
       CnOut(m_pea);
       RefName(@'~GLOBALS', 0, 2, -8);
       CnOut(m_plb);
       CnOut(m_plb);
+      isJSL := lisJSL;
       end; {SetDataBank}
 
 
@@ -2237,6 +2392,12 @@ procedure InitFile {keepName: gsosOutStringPtr; keepFlag: integer; partial: bool
    fname2.theString.size := length(fname2.theString.theString);
    OpenObj(fname2);
 
+   {force this to be a static segment}
+   if (segmentKind & $8000) <> 0 then begin
+      currentSegment := '          ';
+      segmentKind := 0;
+      end; {if}
+
    {write the header}
    InitNative;
    Header(@'~_ROOT', $4000, 0);
@@ -2258,6 +2419,7 @@ procedure InitFile {keepName: gsosOutStringPtr; keepFlag: integer; partial: bool
       CnOut(0);
 
       {glue code for calling open routine}
+      isJSL := true;
       CnOut(m_phb);
       SetDataBank;
       CnOut(m_jsl);
@@ -2298,6 +2460,7 @@ procedure InitFile {keepName: gsosOutStringPtr; keepFlag: integer; partial: bool
       RefName(initName, 0, 3, 0);
       CnOut(m_plb);
       CnOut(m_rtl);
+      isJSL := false;
       end
 
    {classic desk accessory initialization}
@@ -2315,6 +2478,7 @@ procedure InitFile {keepName: gsosOutStringPtr; keepFlag: integer; partial: bool
       RefName(lab, menuLen + dispToCDAClose, 4, 0);
 
       {glue code for calling open routine}
+      isJSL := true;
       CnOut(m_pea);
       CnOut2(1);
       CnOut(m_jsl);
@@ -2341,33 +2505,40 @@ procedure InitFile {keepName: gsosOutStringPtr; keepFlag: integer; partial: bool
       RefName(@'~DAID', 0, 3, 0);
       CnOut(m_plb);
       CnOut(m_rtl);
+      isJSL := false;
       end
 
    {control panel device initialization}
    else if isCDev then begin
-      CnOut(m_pea);
-      CnOut2(1);
+      CnOut(m_phb);                     {save data bank}
+      SetDataBank;                      {set data bank}
+      CnOut(m_plx);                     {get RTL address & original data bank}
+      CnOut(m_ply);
+      CnOut(m_lda_s); CnOut(3);         {move CDev parameters}
+      CnOut(m_pha);
+      CnOut(m_lda_s); CnOut(3);
+      CnOut(m_pha);
+      CnOut(m_lda_s); CnOut(9);
+      CnOut(m_sta_s); CnOut(5);
+      CnOut(m_lda_s); CnOut(11);
+      CnOut(m_sta_s); CnOut(7);
+      CnOut(m_lda_s); CnOut(13);
+      CnOut(m_sta_s); CnOut(9);
+      CnOut(m_sta_s); CnOut(15);        {store message in result space}
+      CnOut(m_lda_long);                {store original user ID in result space}
+      RefName(@'~USER_ID',0,3,0);
+      CnOut(m_sta_s); CnOut(17);
+      CnOut(m_txa);                     {save RTL address & original data bank}
+      CnOut(m_sta_s); CnOut(11);
+      CnOut(m_tya);
+      CnOut(m_sta_s); CnOut(13);
+      CnOut(m_pea); CnOut2(1);          {get user ID}
       CnOut(m_jsl);
       RefName(@'~DAID', 0, 3, 0);
-      CnOut(m_phb);
-      SetDataBank;
-      CnOut(m_pla);
-      CnOut(m_sta_s); CnOut(13);
-      CnOut(m_pla);
-      CnOut(m_sta_s); CnOut(13);
-      CnOut(m_jsl);
+      CnOut(m_jsl);                     {call CDev main routine}
       RefName(openName,0,3,0);
-      CnOut(m_tay);
-      CnOut(m_lda_s); CnOut(3);
-      CnOut(m_pha);
-      CnOut(m_lda_s); CnOut(3);
-      CnOut(m_pha);
-      CnOut(m_txa);
-      CnOut(m_sta_s); CnOut(7);
-      CnOut(m_tya);
-      CnOut(m_sta_s); CnOut(5);
-      CnOut(m_plb);
-      CnOut(m_rtl);
+      CnOut(m_jml);                     {clean up and return to caller}
+      RefName(@'~CDEVCLEANUP', 0, 3, 0);
       end
 
    {NBA initialization}
@@ -2398,6 +2569,7 @@ procedure InitFile {keepName: gsosOutStringPtr; keepFlag: integer; partial: bool
    else begin
 
       {write the initial JSL}
+      isJSL := true;
       CnOut(m_jsl);
       if rtl then
          RefName(@'~_BWSTARTUP4', 0, 3, 0)
@@ -2407,6 +2579,17 @@ procedure InitFile {keepName: gsosOutStringPtr; keepFlag: integer; partial: bool
       {set the data bank register}
       SetDataBank;
 
+      {set FPE slot, if using FPE}
+      if floatCard = 1 then begin
+         CnOut(m_lda_imm);
+         if floatSlot in [1..7] then
+            CnOut2(floatSlot)
+         else
+            CnOut2(0);
+         CnOut(m_jsl);
+         RefName(@'~INITFLOAT', 0, 3, 0);
+         end; {if}
+
       {write JSL to main entry point}
       CnOut(m_jsl);
       if rtl then
@@ -2415,7 +2598,8 @@ procedure InitFile {keepName: gsosOutStringPtr; keepFlag: integer; partial: bool
          RefName(@'~C_STARTUP', 0, 3, 0);
       CnOut(m_jsl);
       RefName(@'main', 0, 3, 0);
-      CnOut(m_jsl);
+      isJSL := false;
+      CnOut(m_jml);
       if rtl then
          RefName(@'~C_SHUTDOWN2', 0, 3, 0)
       else
@@ -2434,6 +2618,7 @@ procedure InitFile {keepName: gsosOutStringPtr; keepFlag: integer; partial: bool
    begin {SetStack}
    if stackSize <> 0 then begin
       currentSegment := '~_STACK   ';	{write the header}
+      segmentKind := 0;
       Header(@'~_STACK', $4012, 0);
       Out($F1);				{write the DS record to reserve space}
       Out2(stackSize);
@@ -2472,10 +2657,10 @@ xRegister.condition := regUnknown;
 yRegister.condition := regUnknown;
 lastRegOpcode := 0; {BRK}
 nnextspot := 1;
-nleadOpcodes := [m_asl_a,m_bcs,m_beq,m_bmi,m_bne,m_bpl,m_brl,m_bvs,m_bcc,
-   m_dec_abs,m_lda_abs,m_lda_dir,m_lda_imm,m_ldx_imm,m_sta_abs,m_sta_dir,
-   m_pha,m_plb,m_plx,m_tax,m_tya,m_tyx,m_phy,m_pei_dir,m_ldy_imm,m_rep,
-   m_ora_dir,m_ora_abs,m_and_imm,m_pea];
+nleadOpcodes := [m_asl_a,m_bcc,m_bcs,m_beq,m_bmi,m_bne,m_bpl,m_brl,{m_bvs,}
+   {m_dec_abs,}m_lda_abs,m_lda_dir,m_lda_imm,m_ldx_imm,m_sta_abs,m_sta_dir,
+   m_pha,m_plb,{m_plx,}m_tax,m_tya,m_tyx,m_phy,m_pei_dir,m_ldy_imm,m_rep,
+   m_ora_dir,m_ora_abs,m_and_imm,m_pea,m_tcd];
 nstopOpcodes := [d_end,d_pin];
 
 stringSize := 0;			{initialize scalars for a new segment}

ORCACDefs/desk.h

@@ -33,6 +33,7 @@
 #define clearAction 0x0009
 #define sysClickAction 0x000A
 #define optionalCloseAction 0x000B
+#define reOpenAction 0x000C
 
 /* SystemEdit Codes */
 #define undoEdit 0x0001

ORCACDefs/fcntl.h

@@ -35,6 +35,6 @@ int             fcntl(int, int, ...);
 long            lseek(int, long, int);
 int             open(const char *, int, ...);
 int             read(int, void *, unsigned);
-int             write(int, void *, unsigned);
+int             write(int, const void *, unsigned);
 
 #endif

ORCACDefs/float.h

@@ -38,13 +38,13 @@ int __get_flt_rounds(void);
 #define DBL_DIG         15
 #define LDBL_DIG        18
 
-#define FLT_MIN_EXP     -125
-#define DBL_MIN_EXP     -1021
-#define LDBL_MIN_EXP    -16382
+#define FLT_MIN_EXP     (-125)
+#define DBL_MIN_EXP     (-1021)
+#define LDBL_MIN_EXP    (-16382)
 
-#define FLT_MIN_10_EXP  -37
-#define DBL_MIN_10_EXP  -307
-#define LDBL_MIN_10_EXP -4931
+#define FLT_MIN_10_EXP  (-37)
+#define DBL_MIN_10_EXP  (-307)
+#define LDBL_MIN_10_EXP (-4931)
 
 #define FLT_MAX_EXP     128
 #define DBL_MAX_EXP     1024

ORCACDefs/gsbug.h

@@ -14,13 +14,17 @@
 #ifndef __GSBUG__
 #define __GSBUG__
 
+/* Error Codes */
+#define debugUnImpErr 0xFF01
+#define debugBadSelErr 0xFF02
+
 #define dgiProgramCounter 0  /* for DebugGetInfo */
 
-extern pascal Word DebugVersion() inline(0x04FF,dispatcher);
-extern pascal Word DebugStatus() inline(0x06FF,dispatcher);
-extern pascal void DebugStr() inline(0x09FF,dispatcher);
-extern pascal void SetMileStone() inline(0x0AFF,dispatcher);
-extern pascal void DebugSetHook() inline(0x0BFF,dispatcher);
-extern pascal LongWord DebugGetInfo() inline(0x0CFF,dispatcher);
+extern pascal Word DebugVersion(void) inline(0x04FF,dispatcher);
+extern pascal Word DebugStatus(void) inline(0x06FF,dispatcher);
+extern pascal void DebugStr(Pointer) inline(0x09FF,dispatcher);
+extern pascal void SetMileStone(Pointer) inline(0x0AFF,dispatcher);
+extern pascal void DebugSetHook(VoidProcPtr) inline(0x0BFF,dispatcher);
+extern pascal LongWord DebugGetInfo(Word) inline(0x0CFF,dispatcher);
 
 #endif

ORCACDefs/gsos.h

@@ -126,7 +126,7 @@
 #define invalidFSTop 0x0065             /* invalid FST operation */
 #define fstCaution 0x0066               /* FST handled call, but result is weird */
 #define devNameErr 0x0067               /* device exists with same name as replacement name */
-#define defListFull 0x0068              /* device list is full */
+#define devListFull 0x0068              /* device list is full */
 #define supListFull 0x0069              /* supervisor list is full */
 #define fstError 0x006a                 /* generic FST error */
 #define resExistsErr 0x0070             /* cannot expand file, resource already exists */

ORCACDefs/math.h

@@ -102,6 +102,12 @@ long double     cosl(long double);
 double          cosh(double);
 float           coshf(float);
 long double     coshl(long double);
+double          erf(double);
+float           erff(float);
+long double     erfl(long double);
+double          erfc(double);
+float           erfcf(float);
+long double     erfcl(long double);
 double          exp(double);
 float           expf(float);
 long double     expl(long double);
@@ -120,6 +126,9 @@ long double     fdiml(long double, long double);
 double          floor(double);
 float           floorf(float);
 long double     floorl(long double);
+double          fma(double, double, double);
+float           fmaf(float, float, float);
+long double     fmal(long double, long double, long double);
 double          fmax(double, double);
 float           fmaxf(float, float);
 long double     fmaxl(long double, long double);
@@ -141,6 +150,9 @@ int             ilogbl(long double);
 double          ldexp(double, int);
 float           ldexpf(float, int);
 long double     ldexpl(long double, int);
+double          lgamma(double);
+float           lgammaf(float);
+long double     lgammal(long double);
 #if defined(__ORCAC_HAS_LONG_LONG__) || __STDC_VERSION__ >= 199901L
 long long       llrint(double);
 long long       llrintf(float);
@@ -221,6 +233,9 @@ long double     tanl(long double);
 double          tanh(double);
 float           tanhf(float);
 long double     tanhl(long double);
+double          tgamma(double);
+float           tgammaf(float);
+long double     tgammal(long double);
 double          trunc(double);
 float           truncf(float);
 long double     truncl(long double);

ORCACDefs/misctool.h

@@ -277,9 +277,18 @@
 #define sbAlertCaution 0x0054
 #define sbScreenBlanking 0x0060
 #define sbScreenUnblanking 0x0061
+#define sbBeginningLongOperation 0x0070
 #define sbYouHaveMail 0x0100
 #define sbErrorWindowBase 0x0E00 /* uses $0Exx */
 #define sbErrorWindowOther 0x0EFF
+#define sbFileTransferred 0x0F80
+#define sbRealtimeMessage 0x0F81
+#define sbConnectedToService 0x1000
+#define sbDisconnectedFromService 0x1001
+#define sbEnteredRealtimeChat 0x1002
+#define sbLeftRealtimeChat 0x1003
+#define sbFeatureEnabled 0x1010
+#define sbFeatureDisabled 0x1011
 
 /* StringToText constants */
 #define fAllowMouseText 0x8000

ORCACDefs/resources.h

@@ -53,6 +53,7 @@
 #define resConverter 0x0800
 #define resMemAttr 0xC31C               /* Flags passed to the NewHandle Memory Manager call */
 #define systemMap 0x0001
+#define fileReadWrite 0x0001
 #define mapChanged 0x0002
 #define romMap 0x0004
 #define resNameOffset 0x10000           /* type holding names */

ORCACDefs/stdarg.h

@@ -31,7 +31,7 @@ typedef char *__va_list[2];
 
 typedef __va_list va_list;
 #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_start(ap,LastFixedParm) ((void) ((ap)[0] = (char *)__orcac_va_info[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])

ORCACDefs/stdio.h

@@ -85,6 +85,9 @@ typedef struct __file {
 extern FILE *stderr;                    /* standard I/O files */
 extern FILE *stdin;
 extern FILE *stdout;
+#define stderr          stderr
+#define stdin           stdin
+#define stdout          stdout
 
 #define L_tmpnam        26              /* size of a temp name */
 #define TMP_MAX         10000           /* # of unique temp names */
@@ -125,7 +128,9 @@ long int        ftell(FILE *);
 size_t          fwrite(const void *, size_t, size_t, FILE *);
 int             getc(FILE *);
 int             getchar(void);
+#if !defined(__KeepNamespacePure__) || __STDC_VERSION__ < 201112L
 char           *gets(char *);
+#endif
 void            perror(const char *);
 int             printf(const char *, ...);
 int             putc(int, FILE *);

ORCACDefs/string.h

@@ -23,7 +23,7 @@ typedef unsigned long size_t;
 #endif
 
 #ifndef __KeepNamespacePure__
-   char        *c2pstr(char *);
+   char        *c2pstr(const char *);
 #endif
 void           *memchr(const void *, int, size_t);
 int             memcmp(const void *, const void *, size_t);
@@ -31,7 +31,7 @@ void           *memcpy(void *, const void *, size_t);
 void           *memmove(void *, const void *, size_t);
 void           *memset(void *, int, size_t);
 #ifndef __KeepNamespacePure__
-   char        *p2cstr(char *);
+   char        *p2cstr(const char *);
 #endif
 char           *strcat(char *, const char *);
 char           *strchr(const char *, int);
@@ -46,12 +46,12 @@ int             strncmp(const char *, const char *, size_t);
 char           *strncpy(char *, const char *, size_t);
 char           *strpbrk(const char *, const char *);
 #ifndef __KeepNamespacePure__
-   int          strpos(char *, char);
+   int          strpos(const char *, char);
 #endif
 char           *strrchr(const char *, int);
 #ifndef __KeepNamespacePure__
-   char        *strrpbrk(char *, char *);
-   int          strrpos(char *, char);
+   char        *strrpbrk(const char *, const char *);
+   int          strrpos(const char *, char);
 #endif
 size_t          strspn(const char *, const char *);
 char           *strstr(const char *, const char *);

ORCACDefs/tgmath.h

@@ -32,6 +32,16 @@
    long double: fn##l, \
    default: _Generic((y), long double: fn##l, default: fn))((x),(y),(other))
 
+#define __tg_real_x_y_z(fn,x,y,z) _Generic((x), \
+   float: _Generic((y), \
+      float: _Generic((z), float: fn##f, long double: fn##l, default: fn), \
+      long double: fn##l, \
+      default: _Generic((z), long double: fn##l, default: fn)), \
+   long double: fn##l, \
+   default: _Generic((y), \
+      long double: fn##l, \
+      default: _Generic((z), long double: fn##l, default: fn)))((x),(y),(z))
+
 #define __tg_x(fn,x) __tg_real_x(fn,(x))
 #define __tg_x_y(fn,x,y) __tg_real_x_y(fn,(x),(y))
 
@@ -47,11 +57,14 @@
 #define cos(x)          __tg_x(cos,(x))
 #define cosh(x)         __tg_x(cosh,(x))
 #define copysign(x,y)   __tg_real_x_y(copysign,(x),(y))
+#define erf(x)          __tg_real_x(erf,(x))
+#define erfc(x)         __tg_real_x(erfc,(x))
 #define exp(x)          __tg_x(exp,(x))
 #define exp2(x)         __tg_real_x(exp2,(x))
 #define expm1(x)        __tg_real_x(expm1,(x))
 #define fabs(x)         __tg_real_x(fabs,(x))
 #define fdim(x,y)       __tg_real_x_y(fdim,(x),(y))
+#define fma(x,y,z)      __tg_real_x_y_z(fma,(x),(y),(z))
 #define fmax(x,y)       __tg_real_x_y(fmax,(x),(y))
 #define fmin(x,y)       __tg_real_x_y(fmin,(x),(y))
 #define floor(x)        __tg_real_x(floor,(x))
@@ -60,6 +73,7 @@
 #define hypot(x,y)      __tg_real_x_y(hypot,(x),(y))
 #define ilogb(x)        __tg_real_x(ilogb,(x))
 #define ldexp(x,n)      __tg_real_x_other(ldexp,(x),(n))
+#define lgamma(x)       __tg_real_x(lgamma,(x))
 #define llrint(x)       __tg_real_x(llrint,(x))
 #define llround(x)      __tg_real_x(llround,(x))
 #define log(x)          __tg_x(log,(x))
@@ -84,6 +98,7 @@
 #define sqrt(x)         __tg_x(sqrt,(x))
 #define tan(x)          __tg_x(tan,(x))
 #define tanh(x)         __tg_x(tanh,(x))
+#define tgamma(x)       __tg_real_x(tgamma,(x))
 #define trunc(x)        __tg_real_x(trunc,(x))
 
 #endif

ORCACDefs/time.h

@@ -28,12 +28,22 @@ struct tm {
         int tm_isdst;
         };
 
+#ifndef __struct_timespec__
+#define __struct_timespec__
+struct timespec {
+        time_t tv_sec;
+        long   tv_nsec;
+        };
+#endif
+
 clock_t         __clocks_per_sec(void);
 #ifndef __KeepNamespacePure__
    #define CLK_TCK      (__clocks_per_sec())
 #endif
 #define CLOCKS_PER_SEC  (__clocks_per_sec())
 
+#define TIME_UTC 1
+
 #ifndef NULL
 #define NULL  (void *) 0L
 #endif
@@ -43,6 +53,8 @@ clock_t         __clocks_per_sec(void);
 typedef unsigned long size_t;
 #endif
 
+extern int      __useTimeTool;
+
 char           *asctime(const struct tm *);
 clock_t         clock(void);
 char           *ctime(const time_t *);
@@ -52,5 +64,6 @@ struct tm      *localtime(const time_t *);
 time_t          mktime(struct tm *);
 size_t          strftime(char *, size_t, const char *, const struct tm *);
 time_t          time(time_t *);
+int             timespec_get(struct timespec *, int);
 
 #endif

ORCACDefs/window.h

@@ -66,6 +66,7 @@
 #define tmControlMenu 0x00040000L
 #define tmMultiClick 0x00080000L
 #define tmIdleEvents 0x00100000L
+#define tmNoGetNextEvent 0x00200000L
 
 /* TaskMaster Codes */
 #define wNoHit 0x0000                   /* retained for back compatibility */

ObjOut.asm

@@ -144,23 +144,18 @@ Out      start CodeGen
 *
 OutByte  private CodeGen
 
-         lda   objLen                   if objLen+segDisp = buffSize then
+         lda   objLen                   if objLen+segDisp >= buffSize then
          clc
          adc   segDisp
          lda   objLen+2
          adc   segDisp+2
-         and   #$FFFE
          beq   lb2
-         phx                               PurgeObjBuffer;
-         jsl   PurgeObjBuffer
+         and   minusBuffSize+2
+         beq   lb2
+         phx                               MakeSpaceInObjBuffer;
+         jsl   MakeSpaceInObjBuffer
          plx
-         lda   objLen                      check for segment overflow
          clc
-         adc   segDisp
-         lda   objLen+2
-         adc   segDisp+2
-         and   #$FFFE
-         bne   lb2a
 lb2      anop                           carry must be clear
          lda   objPtr+2                 p := pointer(ord4(objPtr)+segDisp);
          adc   segDisp+2
@@ -183,13 +178,6 @@ lb2      anop                           carry must be clear
          adc   #4
          tcs
          rts
-
-lb2a     lda   #$8000                   handle a segment overflow
-         sta   segDisp
-         stz   segDisp+2
-         ph2   #112
-         jsl   Error
-         rts
          end
 
 ****************************************************************
@@ -203,25 +191,20 @@ lb2a     lda   #$8000                   handle a segment overflow
 *
 OutWord  private CodeGen
 
-         lda   objLen                   if objLen+segDisp+1 = buffSize then
+         lda   objLen                   if objLen+segDisp+1 >= buffSize then
          sec
          adc   segDisp
          lda   objLen+2
          adc   segDisp+2
-         and   #$FFFE
          beq   lb2
-         phx                               PurgeObjBuffer;
-         jsl   PurgeObjBuffer
+         and   minusBuffSize+2
+         beq   lb2
+         phx                               MakeSpaceInObjBuffer;
+         jsl   MakeSpaceInObjBuffer
          plx
-         lda   objLen                      check for segment overflow
-         sec
-         adc   segDisp
-         lda   objLen+2
-         adc   segDisp+2
-         and   #$FFFE
-         bne   lb3
-lb2      anop                          carry must be clear
-         lda   objPtr+2                p := pointer(ord4(objPtr)+segDisp);
+         clc
+lb2      anop                           carry must be clear
+         lda   objPtr+2                 p := pointer(ord4(objPtr)+segDisp);
          adc   segDisp+2
          pha
          lda   objPtr
@@ -240,11 +223,4 @@ lb2      anop                          carry must be clear
          adc   #4
          tcs
          rts
-
-lb3      ph2   #112                     flag segment overflow error
-         jsl   Error
-         lda   #$8000
-         sta   segDisp
-         stz   segDisp+2
-         rts
          end

ObjOut.pas

@@ -138,9 +138,8 @@ procedure Purge;
 implementation
 
 const
-					{NOTE: OutByte and Outword assume }
-                                        { buffSize is 128K                }
-   buffSize = 131072;                   {size of the obj buffer}
+   initialBuffSize = $10000;            {initial size of the obj buffer}
+                                        {NOTE: must be a power of two >= 64K}
    maxCBuffLen  = 191;                  {length of the constant buffer}
    OBJ = $B1;                           {object file type}
 
@@ -217,9 +216,9 @@ var
 
    objLen: longint;                     {# bytes used in obj buffer}
    objHandle: handle;                   {handle of the obj buffer}
-   objPtr: ptr;                         {pointer to the next spot in the obj buffer}
+   objPtr: ptr;                         {points to first byte in current segment}
+   minusBuffSize: longint;              {size of obj buffer, negated}
 
-   segStart: ptr;			{points to first byte in current segment}
    spoolRefnum: integer;		{reference number for open file}
 
 {---------------------------------------------------------------}
@@ -276,7 +275,7 @@ var
       
    begin {InitSpoolFile}
    if memoryCompile then		{make sure this is a disk-based compile}
-      TermError(11);
+      TermError(3);
    dsRec.pCount := 1;			{destroy any old file}
    dsRec.pathname := @objFile.theString;
    DestroyGS(dsRec);
@@ -303,7 +302,7 @@ begin {PurgeObjBuffer}
 if spoolRefnum = 0 then			{make sure the spool file exists}
    InitSpoolFile;
 sPtr := objHandle^;			{determine size of completed segments}
-len := ord4(segStart) - ord4(sPtr);
+len := ord4(objPtr) - ord4(sPtr);
 if len <> 0 then begin
    wrRec.pcount := 4;			{write completed segments}
    wrRec.refnum := spoolRefnum;
@@ -313,13 +312,38 @@ if len <> 0 then begin
    if ToolError <> 0 then		{check for write errors}
       TermError(9);
    objLen := 0;				{adjust file pointers}
-   BlockMove(segStart, sPtr, segDisp);
+   BlockMove(objPtr, sPtr, segDisp);
    objPtr := sPtr;
-   segStart := sPtr;
    end; {if}                      
 end; {PurgeObjBuffer}
 
 
+procedure MakeSpaceInObjBuffer;
+
+{ Make space in the object buffer (at least two bytes) by       }
+{ purging or expanding it.                                      }
+
+var
+   segOffset: longint;                  {offset into buffer of current segment}
+
+begin {MakeSpaceInObjBuffer}
+segOffset := ord4(objPtr) - ord4(objHandle^);
+
+if (segOffset >= 2) and not memoryCompile then
+   PurgeObjBuffer
+else begin
+   {resize the buffer}
+   minusBuffSize := minusBuffSize * 2;
+   HUnLock(objHandle);
+   SetHandleSize(-minusBuffSize, objHandle);
+   if ToolError <> 0 then
+      TermError(5);
+   HLock(objHandle);
+   objPtr := ptr(ord4(objHandle^) + segOffset);
+   end; {if}
+end; {MakeSpaceInObjBuffer}
+
+
 {---------------------------------------------------------------}
 
 procedure CloseObj;
@@ -439,10 +463,9 @@ longPtr := pointer(objPtr);             {set the block count}
 longPtr^ := segDisp;
 objLen := objLen + segDisp;             {update the length of the obj file}
 objPtr := pointer(ord4(objHandle^)+objLen); {set objPtr}
-segStart := objPtr;
-if objLen = buffSize then
-   PurgeObjBuffer;
-currentSegment := defaultSegment;       {revert to default segment name}
+segDisp := 0;
+currentSegment := defaultSegment;       {revert to default segment name & kind}
+segmentKind := defaultSegmentKind;
 end; {CloseSeg}
 
 
@@ -526,7 +549,6 @@ procedure OpenSeg;
 
 begin {OpenSeg}
 segDisp := 0;
-segStart := objPtr;
 end; {OpenSeg}
 
 
@@ -559,12 +581,13 @@ if memoryCompile then begin
    end; {if}
 
 {allocate memory for an initial buffer}
-objHandle := pointer(NewHandle(buffSize, userID, $8000, nil));
+objHandle := pointer(NewHandle(initialBuffSize, userID, $8000, nil));
 
 {set up the buffer variables}
 if ToolError = 0 then begin
    objLen := 0;
    objPtr := objHandle^;
+   minusBuffSize := -initialBuffSize;
    end {if}
 else
    TermError(5);

Printf.pas

@@ -52,7 +52,7 @@ const
    feature_ll = true;
    feature_s_long = false;
    feature_n_size = true;
-   feature_scanf_ld = false;
+   feature_scanf_ld = true;
 
 type
    length_modifier = (default, h, hh, l, ll, j, z, t, ld);
@@ -136,7 +136,7 @@ var
       WriteLine;
       if s <> nil then begin
          Write('   > "');
-         for i := 1 to s^.length do begin
+         for i := 1 to s^.length-1 do begin
             ch := s^.str[i];
             if ch in [' '..'~'] then begin
                if ch in ['"','\','?'] then
@@ -167,13 +167,13 @@ var
    Write('     ');
    if offset = 0 then
       if s <> nil then begin
-         offset := s^.length;
+         offset := s^.length-1;
          write(' ');
          end; {if}
-   if offset > 0 then begin
-      if s <> nil then begin
-         if offset > s^.length then
-            offset := s^.length;
+   if s <> nil then begin
+      if offset > 0 then begin
+         if offset > s^.length-1 then
+            offset := s^.length-1;
          for i := 1 to offset do begin
             ch := s^.str[i];
             if ch in [' '..'~'] then begin

README.md

@@ -49,4 +49,4 @@ Alternatively, you can keep the LF line endings in your working copy of the Git
 
 [udl]: http://ftp.gno.org/pub/apple2/gs.specific/gno/file.convert/udl.114.shk
 
-In addition to converting the line endings, you will also have to set the files to the appropriate file types before building ORCA/C on a IIGS. The included `settypes` script (for use under the ORCA shell) does this for the sources to the ORCA/C compiler itself, although it does not currently cover the test cases and headers.
+In addition to converting the line endings, you will also have to set the files to the appropriate file types before building ORCA/C on a IIGS. The included `settypes` script (for use under the ORCA shell) can be used to do this.

Scanner.asm

@@ -465,7 +465,7 @@ cch      equ   13
          enum  (illegal,ch_special,ch_dash,ch_plus,ch_lt,ch_gt,ch_eq,ch_exc),0
          enum  (ch_and,ch_bar,ch_dot,ch_white,ch_eol,ch_eof,ch_char,ch_string)
          enum  (ch_asterisk,ch_slash,ch_percent,ch_carot,ch_pound,ch_colon)
-         enum  (ch_backslash,letter,digit)
+         enum  (ch_backslash,ch_other,letter,digit)
 
 ! begin {NextCh}
          tsc                            create stack frame
@@ -520,8 +520,10 @@ la2      anop
          lda   #eolChar
          sta   ch
          brl   le2
+!    CheckConditionals;
+la3      jsl   CheckConditionals
 !    ch := chr(eofChar);
-la3      stz   ch
+         stz   ch
 
 !    if needWriteLine then begin        {do eol processing}
 !       WriteLine;
@@ -533,7 +535,7 @@ la3      stz   ch
          beq   lb1
          jsl   WriteLine
          stz   wroteLine
-         inc   lineNumber
+         inc4  lineNumber
          move4 chPtr,firstPtr
 lb1      anop
 
@@ -548,19 +550,26 @@ lb2      anop
          brl   le2
 !    else begin
 lb3      anop
-!       {purge the current source file}
-!       with ffDCBGS do begin
-!          pCount := 5;
+!       if not doingFakeFile then begin
+         lda   doingFakeFile
+         bne   lb3a
+!          {purge the current source file}
+!          with ffDCBGS do begin
+!             pCount := 5;
          lda   #5
          sta   ffDCBGS
-!          action := 7;
+!             action := 7;
          lda   #7
          sta   ffDCBGS+2
-!          name := @includeFileGS.theString
+!             name := @includeFileGS.theString
          lla   ffDCBGS+12,includeFileGS+2
-!          end; {with}
-!       FastFileGS(ffDCBGS);
+!             end; {with}
+!          FastFileGS(ffDCBGS);
          FastFileGS ffDCBGS
+!          end; {if}
+lb3a     anop
+!       doingFakeFile := false;
+         stz   doingFakeFile
 !       fp := fileList;                   {open the file that included this one}
          move4 fileList,fp
 !       fileList := fp^.next;
@@ -589,6 +598,10 @@ lb4      lda   [p1],Y
          ldy   #4+maxPath+4+maxPath+4
          lda   [fp],Y
          sta   lineNumber
+         iny
+         iny
+         lda   [fp],Y
+         sta   lineNumber+2
 !       ReadFile;
          jsl   ReadFile
 !       eofPtr := pointer(ord4(bofPtr) + ffDCBGS.fileLength);
@@ -596,7 +609,7 @@ lb4      lda   [p1],Y
 !       chPtr := pointer(ord4(bofPtr) + fp^.disp);
 !       includeChPtr := chPtr;
 !       firstPtr := chPtr;
-         ldy   #4+maxPath+4+maxPath+4+2
+         ldy   #4+maxPath+4+maxPath+4+4
          clc
          lda   bofPtr
          adc   [fp],Y
@@ -617,8 +630,13 @@ lb4      lda   [p1],Y
          jsl   ~Dispose
 !       includeCount := includeCount + 1;
          inc   includeCount
+!       if inhibitHeader then
+         lda   inhibitHeader
+         beq   lb4a
+!          TermHeader;
+         jsl   TermHeader
 !       goto 1;
-         brl   lab1
+lb4a     brl   lab1
 !       end; {if}
 !    end {if}
 
@@ -641,7 +659,7 @@ lb5      anop
          beq   lb6
          jsl   WriteLine
          stz   wroteLine
-         inc   lineNumber
+         inc4  lineNumber
          move4 chPtr,firstPtr
 lb6      anop
 !    needWriteLine := charKinds[ord(ch)] = ch_eol;
@@ -727,11 +745,16 @@ lc2      anop
          lda   chPtr+2
          cmp   eofPtr+2
          jeq   lc5
-!          else if (cch = '/') and (chPtr^ = return) then begin
+!          else if (cch = '/') then begin
 lc2a     lda   cch
          cmp   #'/'
          bne   lc2b
-!             if charKinds[ord(ch)] = ch_eol then
+!             if (charKinds[ord(chPtr^)] = ch_eol)
+!                and (ptr(ord4(chPtr)-1)^ <> '\')
+!                and ((ptr(ord4(chPtr)-1)^ <> '/') 
+!                  or (ptr(ord4(chPtr)-2)^ <> '?')
+!                  or (ptr(ord4(chPtr)-3)^ <> '?'))
+!                then
 !                done := true
 !             else
 !                chPtr := pointer(ord4(chPtr)+1);
@@ -742,8 +765,19 @@ lc2a     lda   cch
          tax
          lda   charKinds,X
          cmp   #ch_eol
-         jeq   lc5
-         inc4  chPtr
+         bne   lc2aa
+         dec4  p1
+         lda   [p1]
+         and   #$00FF
+         cmp   #'\'
+         beq   lc2aa
+         cmp   #'/'
+         jne   lc5
+         sub4  p1,#2
+         lda   [p1]
+         cmp   #'??'
+         jne   lc5
+lc2aa    inc4  chPtr
          bra   lc2
 !             end {else if}
 !          else begin
@@ -765,7 +799,7 @@ lc2b     move4 chPtr,p1
          bne   lc3
          jsl   WriteLine
          stz   wroteLine
-         inc   lineNumber
+         inc4  lineNumber
          add4  chPtr,#1,firstPtr
 lc3      anop
 !             chPtr := pointer(ord4(chPtr)+1);

Scanner.macros

@@ -636,3 +636,48 @@
 .f
  mnote "Missing closing '}'",16
  mend
+ macro
+&l sub4 &m1,&m2,&m3
+ lclb &yistwo
+ lclc &c
+&l ~setm
+ aif c:&m3,.a
+&c amid "&m2",1,1
+ aif "&c"<>"#",.a
+&c amid "&m1",1,1
+ aif "&c"="{",.a
+ aif "&c"="[",.a
+&c amid "&m2",2,l:&m2-1
+ aif &c>=65536,.a
+ sec
+ ~lda &m1
+ ~op sbc,&m2
+ ~sta &m1
+ bcs ~&SYSCNT
+ ~op.h dec,&m1
+~&SYSCNT anop
+ ago .c
+.a
+ aif c:&m3,.b
+ lclc &m3
+&m3 setc &m1
+.b
+ sec
+ ~lda &m1
+ ~op sbc,&m2
+ ~sta &m3
+ ~lda.h &m1
+ ~op.h sbc,&m2
+ ~sta.h &m3
+.c
+ ~restm
+ mend
+ macro
+&l dec4 &a
+&l ~setm
+ lda &a
+ bne ~&SYSCNT
+ dec 2+&a
+~&SYSCNT dec &a
+ ~restm
+ mend

Symbol.asm

@@ -9,11 +9,12 @@
 ****************************************************************
 *
 ClearTable private cc
-tableSize equ  7026                     sizeof(symbolTable)
+hashSize2 equ  1753                     # hash buckets * 2 - 1
+sizeofBuckets equ 4*(hashSize2+1)       sizeof(symbolTable.buckets)
 
          subroutine (4:table),0
 
-         ldy   #tableSize-2
+         ldy   #sizeofBuckets-2
          lda   #0
 lb1      sta   [table],Y
          dey
@@ -22,3 +23,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

Symbol.pas

@@ -22,7 +22,6 @@
 {                                                               }
 {  External Variables:                                          }
 {                                                               }
-{  noDeclarations - have we declared anything at this level?    }
 {  table - current symbol table                                 }
 {                                                               }
 {  charPtr - pointer to the base type for char                  }
@@ -69,17 +68,22 @@ uses CCommon, CGI, MM, Scanner;
 
 {---------------------------------------------------------------}
 
+const
+   staticNumLen = 5;                    {length of staticNum name prefix}
+
 type
    symbolTablePtr = ^symbolTable;
    symbolTable = record                 {a symbol table}
       {NOTE: the array of buckets must come first in the record!}
       buckets: array[0..hashSize2] of identPtr; {hash buckets}
       next: symbolTablePtr;             {next symbol table}
-      staticNum: packed array[1..6] of char; {staticNum at start of table}
+      isEmpty: boolean;                 {is the pool empty (nothing in buckets)?}
+      case noStatics: boolean of        {no statics/staticNum for this table?}
+         false: (staticNum: packed array[1..6] of char); {staticNum for this table}
+         true: ();
       end;
 
 var
-   noDeclarations: boolean;             {have we declared anything at this level?}
    table: symbolTablePtr;               {current symbol table}
    globalTable: symbolTablePtr;         {global symbol table}
    functionTable: symbolTablePtr;       {table for top level of current function}
@@ -102,6 +106,11 @@ procedure CheckStaticFunctions;
 { check for undefined functions                                 }
 
 
+procedure CheckUnused (tPtr: symbolTablePtr);
+
+{ check for unused variables in symbol table                    }
+
+
 function CompTypes (t1, t2: typePtr): boolean;
 
 { Determine if the two types are compatible                     }
@@ -236,7 +245,8 @@ function Unqualify (tp: typePtr): typePtr;
 
 
 function NewSymbol (name: stringPtr; itype: typePtr; class: tokenEnum;
-                   space: spaceType; state: stateKind): identPtr;
+                   space: spaceType; state: stateKind; isInline: boolean):
+                   identPtr;
 
 { insert a new symbol in the symbol table                       }
 {                                                               }
@@ -296,35 +306,28 @@ function StringType(prefix: charStrPrefixEnum): typePtr;
 
 implementation
 
+type
+                                        {From CGC.pas}
+   realrec = record                     {used to convert from real to in-SANE}
+      itsReal: extended;
+      inCOMP: packed array[1..8] of byte;
+      end;
+
 var
    staticNum: packed array[1..6] of char; {static variable number}
+   tablePool: symbolTablePtr;           {pool of reusable empty symbol tables}
+   tablePoolSize: 0..maxint;            {number of tables in pool}
+   tablePoolMaxSize: 0..maxint;         {max number of tables in pool}
 
-{- Imported from expression.pas --------------------------------}
+{- Imported from CGC.pas ---------------------------------------}
 
-procedure GenerateCode (tree: tokenPtr); extern;
+procedure CnvSC (rec: realrec); extern;
 
-{ generate code from a fully formed expression tree             }
+{ convert a real number to SANE comp format                     }
 {                                                               }
 { parameters:                                                   }
-{     tree - top of the expression tree to generate code from   }
-{                                                               }
-{ variables:                                                    }
-{     expressionType - result type of the expression            }
-
-
-function UsualUnaryConversions: baseTypeEnum; extern;
-
-{ performs the usual unary conversions                          }
-{                                                               }
-{ inputs:                                                       }
-{       expressionType - type of the operand                    }
-{                                                               }
-{ result:                                                       }
-{       The base type of the operation to perform is returned.  }
-{       Any conversion code necessary has been generated.       }
-{                                                               }
-{ outputs:                                                      }
-{       expressionType - set to result type                     }
+{       rec - record containing the value to convert; also      }
+{               has space for the result                        }
 
 {---------------------------------------------------------------}
 
@@ -391,12 +394,26 @@ procedure Purge; extern;
 
 { write any constant bytes to the output buffer                 }
 
+{- Imported from IIGS Memory Manager ---------------------------}
+
+function MaxBlock: longint; tool ($02, $1C);
+
 {---------------------------------------------------------------}
 
 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                                     }
+
 {---------------------------------------------------------------}
 
 
@@ -416,26 +433,76 @@ for i := 0 to hashSize do begin
    while sp <> nil do begin
       if sp^.storage = private then
          if sp^.itype^.kind = functionType then
-            if sp^.state <> defined then begin
-               numErrors := numErrors+1;
-               new(msg);
-               msg^ := concat('The static function ', sp^.name^,
-                  ' was not defined.');
-               writeln('*** ', msg^);
-               if terminalErrors then begin
-                  if enterEditor then
-                     ExitToEditor(msg, ord4(firstPtr)-ord4(bofPtr))
-                  else
-                     TermError(0);
+            if sp^.state <> defined then
+               if sp^.used then begin
+                  numErrors := numErrors+1;
+                  new(msg);
+                  msg^ := concat('The static function ', sp^.name^,
+                     ' was used but never defined.');
+                  writeln('*** ', msg^);
+                  if terminalErrors then begin
+                     if enterEditor then
+                        ExitToEditor(msg, ord4(firstPtr)-ord4(bofPtr))
+                     else
+                        TermError(0);
+                     end; {if}
+                  liDCBGS.merrf := 16;
                   end; {if}
-               liDCBGS.merrf := 16;
-               end; {if}
       sp := sp^.next;
       end; {while}
    end; {for}
 end; {CheckStaticFunctions}
 
 
+procedure CheckUnused {tPtr: symbolTablePtr};
+
+{ check for unused variables in symbol table                    }
+
+var
+   i: integer;                          {loop variable}
+   ip: identPtr;                        {current symbol}
+   nameStr: stringPtr;
+
+begin {CheckUnused}
+if not tPtr^.isEmpty or not tPtr^.noStatics then
+   for i := 0 to hashSize do begin      {loop over all hash buckets}
+      if not tPtr^.isEmpty then begin
+         ip := tPtr^.buckets[i];        {trace through non-static symbols}
+         while ip <> nil do begin
+            if not ip^.used then
+               if ip^.itype <> nil then
+                  if not (ip^.itype^.kind in [functionType,enumConst]) then
+                     if ip^.storage in [stackFrame,private] then
+                        if not (ip^.name^[1] in ['~','@']) then begin
+                           new(nameStr);
+                           nameStr^ := ip^.name^;
+                           ErrorWithExtraString(185, nameStr);
+                           end; {if}
+            ip := ip^.next;
+            end; {while}
+         end; {if}
+      if not tPtr^.noStatics then begin
+         ip := globalTable^.buckets[i]; {trace through static symbols}
+         while ip <> nil do begin
+            if not ip^.used then
+               if ip^.itype <> nil then
+                  if not (ip^.itype^.kind in [functionType,enumConst]) then
+                     if ip^.storage = private then
+                        if copy(ip^.name^,1,staticNumLen) = tPtr^.staticNum then
+                           if not (ip^.name^[staticNumLen+1] in ['~','@']) then
+                              begin
+                              new(nameStr);
+                              nameStr^ :=
+                                 copy(ip^.name^, staticNumLen+1, maxint);
+                              ErrorWithExtraString(185, nameStr);
+                              end; {if}
+            ip := ip^.next;
+            end; {while}
+         end; {if}
+      end; {for}
+end; {CheckUnused}
+
+
 function CompTypes {t1, t2: typePtr): boolean};
 
 { Determine if the two types are compatible                     }
@@ -445,8 +512,6 @@ label 1;
 var
    el1,el2: longint;                    {array sizes}
    kind1,kind2: typeKind;               {temp variables (for speed)}
-   p1, p2: parameterPtr;                {for tracing parameter lists}
-   pt1,pt2: typePtr;                    {pointer types}
 
 begin {CompTypes}
 CompTypes := false;                     {assume the types are not compatible}
@@ -664,6 +729,234 @@ procedure DoGlobals;
 { declare the ~globals and ~arrays segments                     }
 
 
+   procedure FreeTablePool;
+   
+   { free the symbol table pool                                 }
+   
+   var
+      tPtr: symbolTablePtr;
+   
+   begin {FreeTablePool}
+   while tablePool <> nil do begin
+      tPtr := tablePool;
+      tablePool := tPtr^.next;
+      dispose(tPtr);
+      end;   
+   end; {FreeTablePool}
+
+
+   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}
+      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)}
+   buffPtr := GLongMalloc(variable^.itype^.size+3);
+   
+   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;
+      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;
+         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}
+   end; {StaticInit}
+
+
    procedure GenArrays;
 
    { define global arrays                                       }
@@ -693,43 +986,13 @@ procedure DoGlobals;
                      currentSegment := '          '
                   else
                      currentSegment := '~ARRAYS   ';
+                  segmentKind := 0;     {this segment is not dynamic!}
                   Gen2Name(dc_str, $4000, 1, @'~ARRAYS');
                   didOne := true;
                   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^.itype of
-                        cgByte,cgUByte,cgWord,cgUWord: begin
-                           lval := ip^.ival;
-                           Gen2t(dc_cns, long(lval).lsw, ip^.count, ip^.itype);
-                           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);
-                        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;
@@ -791,17 +1054,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
@@ -837,14 +1100,14 @@ begin {DoGlobals}
 {if printSymbols then                 {debug}
 {   PrintTable(globalTable);          {debug}
 
-{these segments are not dynamic!}
-segmentKind := 0;
+FreeTablePool;                          {dispose of unneeded symbol tables}
 
 {declare the ~globals segment, which holds non-array data types}
 if smallMemoryModel then
    currentSegment := '          '
 else
    currentSegment := '~GLOBALS  ';
+segmentKind := 0;                       {this segment is not dynamic!}
 Gen2Name(dc_str, $4000, 0, @'~GLOBALS');
 GenGlobals;
 Gen0(dc_enp);
@@ -870,15 +1133,13 @@ function FindSymbol {var tk: tokenType; class: spaceType; oneLevel: boolean;
 {       A pointer to the symbol table entry is returned.  If    }
 {       there is no entry, nil is returned.                     }
 
-label 1;
+label 1,2;
 
 var
-   doTagSpace: boolean;                 {do we still need to do the tags?}
    hashDisp: longint;                   {disp into the hash table}
    i: integer;                          {loop variable}
    iHandle: ^identPtr;                  {pointer to start of hash bucket}
    iPtr: identPtr;                      {pointer to the current symbol}
-   match: boolean;                      {for comparing substrings}
    name: stringPtr;                     {name to search for}
    np: stringPtr;                       {for searching for static variables}
    sPtr: symbolTablePtr;                {^ to current symbol table}
@@ -888,23 +1149,16 @@ begin {FindSymbol}
 staticAllowed := staticAllowed and (staticNum <> '~0000');
 name := tk.name;                        {use a local variable}
 hashDisp := Hash(name);                 {get the disp into the symbol table}
-sPtr := table;                          {initialize the address of the sym. tbl}
-FindSymbol := nil;                      {assume we won't find it}
 np := nil;                              {no string buffer, yet}
 
 {check for the variable}
+2:
+sPtr := table;                          {initialize the address of the sym. tbl}
 while sPtr <> nil do begin
    iHandle := pointer(hashDisp+ord4(sPtr));
    if class = tagSpace then
       iHandle := pointer(ord4(iHandle) + (hashSize+1)*4);
-   doTagSpace := class = allSpaces;
    iPtr := iHandle^;
-   if iPtr = nil then
-      if doTagSpace then begin
-         iHandle := pointer(ord4(iHandle) + (hashSize+1)*4);
-         iPtr := iHandle^;
-         doTagSpace := false;
-         end; {if}
 
    {scan the hash bucket for a global or auto variable}
    while iPtr <> nil do begin
@@ -916,16 +1170,10 @@ while sPtr <> nil do begin
          goto 1;
          end; {if}
       iPtr := iPtr^.next;
-      if iPtr = nil then
-         if doTagSpace then begin
-            iHandle := pointer(ord4(iHandle) + (hashSize+1)*4);
-            iPtr := iHandle^;
-            doTagSpace := false;
-            end; {if}
       end; {while}
 
    {rescan for a static variable}
-   if staticAllowed then begin
+   if staticAllowed and not sPtr^.noStatics then begin
       if np = nil then begin            {form the static name}
          if length(name^) < 251 then begin
             new(np);
@@ -964,6 +1212,13 @@ while sPtr <> nil do begin
       sPtr := sPtr^.next;
    end; {while}
 
+{we only get here if a symbol was not found}
+if class = allSpaces then begin
+   class := tagSpace;
+   goto 2;
+   end; {if}
+FindSymbol := nil;
+
 1:
 if np <> nil then
    dispose(np);
@@ -1010,6 +1265,12 @@ if pp <> nil then begin			{prototyped parameters}
 	 size := long(sp^.itype^.size).lsw;
 	 if (size = 1) and (sp^.itype^.kind = scalarType) then
             size := 2;
+	 if sp^.itype^.kind = scalarType then
+            if sp^.itype^.baseType in [cgReal,cgDouble,cgComp] then begin
+               {convert floating-point parameters to declared type}
+               Gen1t(pc_fix, pln, sp^.itype^.baseType);
+               size := cgExtendedSize;
+               end; {if}
 	 Gen3(dc_prm, pln, size, sp^.pdisp);
 	 end; {else}
       sp^.pln := pln;
@@ -1036,6 +1297,12 @@ else begin				{K&R parameters}
                size := long(sp^.itype^.size).lsw;
                if (size = 1) and (sp^.itype^.kind = scalarType) then
         	  size := 2;
+               if sp^.itype^.kind = scalarType then
+                  if sp^.itype^.baseType in [cgReal,cgDouble,cgComp] then begin
+                     {convert floating-point parameters to declared type}
+                     Gen1t(pc_fix, pln, sp^.itype^.baseType);
+                     size := cgExtendedSize;
+                     end; {if}
                Gen3(dc_prm, sp^.lln, size, sp^.pdisp);
                end; {else}
             if first then begin
@@ -1276,7 +1543,8 @@ var
       if ip = nil then ip := defaultStruct^.fieldList;
 
       while ip <> nil do begin
-         GenSymbol(ip, none);
+         if ip^.name^[1] <> '~' then
+            GenSymbol(ip, none);
          ip := ip^.next;
          end; {while}
       end; {ExpandStructType}
@@ -1450,9 +1718,12 @@ var
 begin {InitSymbol}
 staticNum := '~0000';                   {no functions processed}
 table := nil;                           {initialize the global symbol table}
+tablePool := nil;                       {table pool is initially empty}
+tablePoolSize := 0;
+tablePoolMaxSize := ord(MaxBlock div 150000); {limit size of pool based on RAM}
 PushTable;
 globalTable := table;
-noDeclarations := false;
+globalTable^.isEmpty := false;          {global table is never treated as empty}
 functionTable := nil;
                                         {declare base types}
 new(sCharPtr);                          {signed char}
@@ -1981,7 +2252,8 @@ end; {Unqualify}
 
 
 function NewSymbol {name: stringPtr; itype: typePtr; class: tokenEnum;
-                   space: spaceType; state: stateKind): identPtr};
+                   space: spaceType; state: stateKind; isInline: boolean):
+                   identPtr};
 
 { insert a new symbol in the symbol table                       }
 {                                                               }
@@ -1999,6 +2271,7 @@ var
    cs: identPtr;                        {current symbol}
    hashPtr: ^identPtr;                  {pointer to hash bucket in symbol table}
    i: integer;                          {loop variable}
+   isFunction: boolean;                 {is this the symbol for a function?}
    isGlobal: boolean;                   {are we using the global table?}
    lUseGlobalPool: boolean;             {use the global symbol pool?}
    needSymbol: boolean;                 {do we need to declare it?}
@@ -2006,105 +2279,164 @@ var
    p: identPtr;                         {work pointer}
    tk: tokenType;                       {fake token; for FindSymbol}
 
+
+   procedure AllocateStaticNum;
+   
+   { Allocate a staticNum value for the current table.          }
+   
+   var
+   done: boolean;                       {loop termination}
+      i: integer;                       {loop index}
+   
+   begin {AllocateStaticNum}
+   i := 5;                              {increment the static var number}
+   repeat
+      staticNum[i] := succ(staticNum[i]);
+      done := staticNum[i] <> succ('9');
+      if not done then begin
+         staticNum[i] := '0';
+         i := i-1;
+         done := i = 1;
+         end; {if}
+   until done;
+   table^.staticNum := staticNum;       {record the static symbol table number}
+   end; {AllocateStaticNum}
+
+
+   procedure UnInline;
+
+   { Generate a non-inline definition for a function previously }
+   { defined with an (apparent) inline definition.              }
+   
+   var
+      fName: stringPtr;                 {name of function}
+      i: integer;                       {loop variable}
+   
+   begin {UnInline}
+   if cs^.iType^.isPascal then begin
+      fName := pointer(Malloc(length(name^)+1));
+      CopyString(pointer(fName), pointer(name));
+      for i := 1 to length(fName^) do
+         if fName^[i] in ['a'..'z'] then
+            fName^[i] := chr(ord(fName^[i]) & $5F);
+      end {if}
+   else
+      fName := name;
+   Gen2Name(dc_str, 0, 0, fName);
+   code^.s := m_jml;
+   code^.q := 0;
+   code^.r := ord(longabsolute);
+   new(code^.lab);
+   code^.lab^ := concat('~inline~',name^);
+   Gen0(pc_nat);
+   Gen0(dc_enp);
+   end; {UnInline}
+
+
 begin {NewSymbol}
 needSymbol := true;                     {assume we need a symbol}
-cs := nil;                              {no current symbol found}
 isGlobal := false;                      {set up defaults}
+isFunction := false;
 lUseGlobalPool := useGlobalPool;
 tk.name := name;
 tk.symbolPtr := nil;
 if space <> fieldListSpace then begin   {are we defining a function?}
    if (itype <> nil) and (itype^.kind = functionType) then begin
-      isGlobal := true;
-      useGlobalPool := true;
+      isFunction := true;
       if class in [autosy, ident] then
-         class := externsy;
-      if not lUseGlobalPool then begin
-         np := pointer(Malloc(length(name^)+1));
-         CopyString(pointer(np), pointer(name));
-         tk.name := np;
-         name := np;
-         end; {if}
-      cs := FindSymbol(tk, space, false, true);
-      if cs <> nil then begin
-         if cs^.state = defined then
-            if state = defined then
-               Error(42);
-         p := cs;
-         needSymbol := false;
-         if not itype^.prototyped then begin
-            itype^.prototyped := cs^.itype^.prototyped;
-            itype^.parameterList := cs^.itype^.parameterList;
-            end; {if}
-         end; {if}
+         class := externsy
+      else                              {If explicit storage class is given,}
+         isInline := false;             {this is not an inline definition.  }
       end {if}
    else if (itype <> nil) and (itype^.kind in [structType,unionType])
       and (itype^.fieldList = nil) and doingParameters then begin
       useGlobalPool := true;
       end; {else if}
-   if noDeclarations then begin         {if we need a symbol table, create it}
-      if not isGlobal then 
-         noDeclarations := false;
-      end {if}
-   else begin                           {check for duplicates}
-      cs := FindSymbol(tk, space, true, false);
-      if cs <> nil then begin
-         if (not CompTypes(cs^.itype, itype))
-            or ((cs^.state = initialized) and (state = initialized))
-            or (globalTable <> table) then
-            if (not doingParameters) or (cs^.state <> declared) then
-               Error(42);
+   cs := FindSymbol(tk, space, true, true); {check for duplicates}
+   if cs <> nil then begin
+      if ((itype = nil)
+         or (cs^.itype = nil)
+         or (not CompTypes(cs^.itype, itype))
+         or ((cs^.state = initialized) and (state = initialized))
+         or ((class = typedefsy) <> (cs^.class = typedefsy))
+         or ((globalTable <> table) 
+            and (not (class in [externsy,typedefsy])
+               or not (cs^.class in [externsy,typedefsy]))))
+         and ((not doingParameters) or (cs^.state <> declared))
+         then
+         Error(42)
+      else begin
+         itype := MakeCompositeType(cs^.itype, itype);
+         if class = externsy then
+            if cs^.class = staticsy then
+               class := staticsy;
+         if cs^.storage = external then
+            if isInline then
+               isInline := cs^.inlineDefinition
+            else if cs^.inlineDefinition then
+               if iType^.kind = functionType then
+                  if cs^.state = defined then
+                     if table = globalTable then
+                        UnInline;
          p := cs;
          needSymbol := false;
+         end; {else}
+      end {if}
+   else if class = externsy then        {check for outer decl of same object/fn}
+      if table <> globalTable then begin
+         cs := FindSymbol(tk, space, false, true);
+         if cs <> nil then
+            if cs^.name^[1] <> '~' then {exclude block-scope statics}
+               if cs^.storage in [global,external,private] then begin
+                  if not CompTypes(cs^.itype, itype) then
+                     Error(47);
+                  itype := MakeCompositeType(cs^.itype, itype);
+                  end; {if}
          end; {if}
-      end; {else}
    end; {if}
-if class = staticsy then                {statics go in the global symbol table}
-   if not isGLobal then
-      if globalTable <> table then begin
-         cs := FindSymbol(tk, space, true, true);
-         if cs <> nil then begin        {check for duplicates}
-            if (not CompTypes(cs^.itype, itype))
-               or ((cs^.state = defined) and (state <> initialized))
-               or (cs^.state = initialized) then
-               Error(42);
-            p := cs;
-            needSymbol := false;
-            end; {if}
-         isGlobal := true;              {note that we will use the global table}
-         useGlobalPool := true;
-         np := pointer(GMalloc(length(name^)+6));
-         np^[0] := chr(5+length(name^));
-         for i := 1 to 5 do
-            np^[i] := table^.staticNum[i];
-         for i := 1 to length(name^) do
-            np^[i+5] := name^[i];
-         name := np;
-         end; {if}
 if needSymbol then begin
+   if class = staticsy then             {statics go in the global symbol table}
+      if not isFunction then
+         if globalTable <> table then begin
+            isGlobal := true;           {note that we will use the global table}
+            useGlobalPool := true;
+            if table^.noStatics then begin
+               table^.noStatics := false;
+               AllocateStaticNum;
+               end; {if}
+            np := pointer(GMalloc(length(name^)+6)); {form static name}
+            np^[0] := chr(5+length(name^));
+            for i := 1 to 5 do
+               np^[i] := table^.staticNum[i];
+            for i := 1 to length(name^) do
+               np^[i+5] := name^[i];
+            name := np;
+            end; {if}
    p := pointer(Calloc(sizeof(identRecord))); {get space for the record}
    {p^.iPtr := nil;}                    {no initializers, yet}
    {p^.saved := 0;}			{not saved}
    p^.state := state;                   {set the state}
    {p^.isForwardDeclared := false;}     {assume no forward declarations are used}
    p^.name := name;                     {record the name}
+   {p^.next := nil;}
+   {p^.used := false;}                  {unused for now}
    if space <> fieldListSpace then      {insert the symbol in the hash bucket}
       begin
-      if itype = nil then
-         hashPtr := pointer(ord4(table)+Hash(name))
-      else if isGlobal then
-         hashPtr := pointer(ord4(globalTable)+Hash(name))
-      else
+      if (itype = nil) or not isGlobal then begin
          hashPtr := pointer(ord4(table)+Hash(name));
+         table^.isEmpty := false;
+         end {if}
+      else
+         hashPtr := pointer(ord4(globalTable)+Hash(name));
       if space = tagSpace then
          hashPtr := pointer(ord4(hashPtr) + 4*(hashSize+1));
       p^.next := hashPtr^;
       hashPtr^ := p;
-      end {if}
-   else
-      p^.next := nil;
+      end; {if}
    end; {if}
-if class in [autosy,registersy] then    {check and set the storage class}
+if space = fieldListSpace then          {check and set the storage class}
+   p^.storage := none
+else if class in [autosy,registersy] then
    begin
    if doingFunction or doingParameters then begin
       p^.storage := stackFrame;
@@ -2123,8 +2455,10 @@ else if class = ident then begin
    else
       p^.storage := global;
    end {else if}
-else if class = externsy then
-   p^.storage := external
+else if class = externsy then begin
+   p^.storage := external;
+   p^.inlineDefinition := isInline;
+   end {else if}
 else if class = staticsy then
    p^.storage := private
 else
@@ -2147,9 +2481,24 @@ begin {PopTable}
 tPtr := table;
 {if printSymbols then                 {debug}
 {   PrintTable(tPtr);                 {debug}
+if (lint & lintUnused) <> 0 then
+   CheckUnused(tPtr);
 if tPtr^.next <> nil then begin
    table := table^.next;
-   dispose(tPtr);
+   if not tPtr^.isEmpty then begin
+      dispose(tPtr);
+      if token.kind = ident then
+         if FindSymbol(token,variableSpace,false,false) <> nil then
+            if token.symbolPtr^.class = typedefsy then
+               token.kind := typedef;
+      end {if}
+   else if (tablePoolSize = tablePoolMaxSize) then
+      dispose(tPtr)
+   else begin
+      tPtr^.next := tablePool;
+      tablePool := tPtr;
+      tablePoolSize := tablePoolSize + 1;
+      end; {else}
    end; {if}
 end; {PopTable}
 
@@ -2162,26 +2511,22 @@ procedure PushTable;
 { Create a new symbol table, pushing the old one                }
 
 var
-   done: boolean;                       {loop termination}
-   i: integer;                          {loop index}
    tPtr: symbolTablePtr;                {work pointer}
 
 begin {PushTable}
-i := 5;                                 {increment the static var number}
-repeat
-   staticNum[i] := succ(staticNum[i]);
-   done := staticNum[i] <> succ('9');
-   if not done then begin
-      staticNum[i] := '0';
-      i := i-1;
-      done := i = 1;
-      end; {if}
-until done;
-new(tPtr);                              {create a new symbol table}
-ClearTable(tPtr^);
+if tablePool <> nil then begin          {use existing empty table if available}
+   tPtr := tablePool;
+   tablePool := tPtr^.next;
+   tablePoolSize := tablePoolSize - 1;
+   end {if}
+else begin
+   new(tPtr);                           {...or create a new symbol table}
+   ClearTable(tPtr^);
+   tPtr^.isEmpty := true;
+   end; {else}
 tPtr^.next := table;
 table := tPtr;
-tPtr^.staticNum := staticNum;           {record the static symbol table number}
+tPtr^.noStatics := true;
 end; {PushTable}
 
 

Table.asm

@@ -19,7 +19,7 @@ charKinds start                         character set
          enum  (illegal,ch_special,ch_dash,ch_plus,ch_lt,ch_gt,ch_eq,ch_exc),0
          enum  (ch_and,ch_bar,ch_dot,ch_white,ch_eol,ch_eof,ch_char,ch_string)
          enum  (ch_asterisk,ch_slash,ch_percent,ch_carot,ch_pound,ch_colon)
-         enum  (ch_backslash,letter,digit)
+         enum  (ch_backslash,ch_other,letter,digit)
 
 ! STANDARD
          dc    i'ch_eof'                nul
@@ -57,8 +57,8 @@ charKinds start                         character set
          dc    i'ch_white'              space
          dc    i'ch_exc'                !
          dc    i'ch_string'             "
-         dc    i'illegal'               #
-         dc    i'illegal'               $
+         dc    i'ch_pound'              #
+         dc    i'ch_other'              $
          dc    i'ch_percent'            %
          dc    i'ch_and'                &
          dc    i'ch_char'               '
@@ -86,7 +86,7 @@ charKinds start                         character set
          dc    i'ch_eq'                 =
          dc    i'ch_gt'                 >
          dc    i'ch_special'            ?
-         dc    i'illegal'               @
+         dc    i'ch_other'              @
          dc    i'letter'                A
          dc    i'letter'                B
          dc    i'letter'                C
@@ -118,7 +118,7 @@ charKinds start                         character set
          dc    i'ch_special'            ]
          dc    i'ch_carot'              ^
          dc    i'letter'                _
-         dc    i'illegal'               `
+         dc    i'ch_other'              `
          dc    i'letter'                a
          dc    i'letter'                b
          dc    i'letter'                c
@@ -183,24 +183,24 @@ charKinds start                         character set
          dc    i'letter'                gs
          dc    i'letter'                rs
          dc    i'letter'                us
-         dc    i'illegal'               space
-         dc    i'illegal'               !
-         dc    i'illegal'               "
-         dc    i'illegal'               #
-         dc    i'illegal'               $
-         dc    i'illegal'               %
-         dc    i'illegal'               &
+         dc    i'ch_other'              space
+         dc    i'ch_other'              !
+         dc    i'ch_other'              "
+         dc    i'ch_other'              #
+         dc    i'ch_other'              $
+         dc    i'ch_other'              %
+         dc    i'ch_other'              &
          dc    i'letter'                '
-         dc    i'illegal'               (
-         dc    i'illegal'               )
-         dc    i'illegal'               *
-         dc    i'illegal'               +
-         dc    i'illegal'               ,
+         dc    i'ch_other'              (
+         dc    i'ch_other'              )
+         dc    i'ch_other'              *
+         dc    i'ch_other'              +
+         dc    i'ch_other'              ,
          dc    i'ch_special'            -
          dc    i'letter'                .
          dc    i'letter'                /
-         dc    i'illegal'               0
-         dc    i'illegal'               1
+         dc    i'ch_other'              0
+         dc    i'ch_other'              1
          dc    i'ch_special'            2
          dc    i'ch_special'            3
          dc    i'letter'                4
@@ -209,76 +209,76 @@ charKinds start                         character set
          dc    i'letter'                7
          dc    i'letter'                8
          dc    i'letter'                9
-         dc    i'illegal'               :
+         dc    i'ch_other'              :
          dc    i'letter'                ;
          dc    i'letter'                <
          dc    i'letter'                =
          dc    i'letter'                >
          dc    i'letter'                ?
-         dc    i'illegal'               @
-         dc    i'illegal'               A
-         dc    i'illegal'               B
-         dc    i'illegal'               C
+         dc    i'ch_other'              @
+         dc    i'ch_other'              A
+         dc    i'ch_other'              B
+         dc    i'ch_other'              C
          dc    i'letter'                D
-         dc    i'illegal'               E
+         dc    i'ch_other'              E
          dc    i'letter'                F
          dc    i'ch_special'            G
          dc    i'ch_special'            H
-         dc    i'illegal'               I
+         dc    i'ch_other'              I
          dc    i'ch_white'              J
          dc    i'letter'                K
          dc    i'letter'                L
          dc    i'letter'                M
          dc    i'letter'                N
          dc    i'letter'                O
-         dc    i'illegal'               P
-         dc    i'illegal'               Q
-         dc    i'illegal'               R
-         dc    i'illegal'               S
-         dc    i'illegal'               T
-         dc    i'illegal'               U
+         dc    i'ch_other'              P
+         dc    i'ch_other'              Q
+         dc    i'ch_other'              R
+         dc    i'ch_other'              S
+         dc    i'ch_other'              T
+         dc    i'ch_other'              U
          dc    i'ch_special'            V
-         dc    i'illegal'               W
+         dc    i'ch_other'              W
          dc    i'letter'                X
-         dc    i'illegal'               Y
-         dc    i'illegal'               Z
-         dc    i'illegal'               [
-         dc    i'illegal'               \
-         dc    i'illegal'               ]
+         dc    i'letter'                Y
+         dc    i'ch_other'              Z
+         dc    i'ch_other'              [
+         dc    i'ch_other'              \
+         dc    i'ch_other'              ]
          dc    i'letter'                ^
          dc    i'letter'                _
-         dc    i'illegal'               `
-         dc    i'illegal'               a
-         dc    i'illegal'               b
-         dc    i'illegal'               c
-         dc    i'illegal'               d
-         dc    i'illegal'               e
-         dc    i'illegal'               f
-         dc    i'illegal'               g
-         dc    i'illegal'               h
-         dc    i'illegal'               i
-         dc    i'illegal'               j
-         dc    i'illegal'               k
-         dc    i'illegal'               l
-         dc    i'illegal'               m
-         dc    i'illegal'               n
-         dc    i'illegal'               o
-         dc    i'illegal'               p
-         dc    i'illegal'               q
-         dc    i'illegal'               r
-         dc    i'illegal'               s
-         dc    i'illegal'               t
-         dc    i'illegal'               u
-         dc    i'illegal'               v
-         dc    i'illegal'               w
-         dc    i'illegal'               x
-         dc    i'illegal'               y
-         dc    i'illegal'               z
-         dc    i'illegal'               {
-         dc    i'illegal'               |
-         dc    i'illegal'               }
-         dc    i'illegal'               ~
-         dc    i'illegal'               rub
+         dc    i'ch_other'              `
+         dc    i'ch_other'              a
+         dc    i'ch_other'              b
+         dc    i'ch_other'              c
+         dc    i'ch_other'              d
+         dc    i'letter'                e
+         dc    i'letter'                f
+         dc    i'letter'                g
+         dc    i'letter'                h
+         dc    i'letter'                i
+         dc    i'letter'                j
+         dc    i'letter'                k
+         dc    i'letter'                l
+         dc    i'letter'                m
+         dc    i'letter'                n
+         dc    i'letter'                o
+         dc    i'ch_other'              p
+         dc    i'letter'                q
+         dc    i'letter'                r
+         dc    i'letter'                s
+         dc    i'letter'                t
+         dc    i'letter'                u
+         dc    i'ch_other'              v
+         dc    i'ch_other'              w
+         dc    i'ch_other'              x
+         dc    i'ch_other'              y
+         dc    i'ch_other'              z
+         dc    i'ch_other'              {
+         dc    i'ch_other'              |
+         dc    i'ch_other'              }
+         dc    i'ch_other'              ~
+         dc    i'ch_other'              rub
          end
 
 charSym  start                          single character symbols
@@ -308,10 +308,13 @@ charSym  start                          single character symbols
          enum  (lteqop,gteqop,eqeqop,exceqop,andandop)
          enum  (barbarop,pluseqop,minuseqop,asteriskeqop,slasheqop)
          enum  (percenteqop,ltlteqop,gtgteqop,andeqop,caroteqop)
-         enum  (bareqop,poundpoundop)
+         enum  (bareqop,poundpoundop,dotdotdotsy)
+         enum  (ppnumber)               preprocessing number
+         enum  (otherch)                other non-whitespace char
          enum  (eolsy,eofsy)            control characters
          enum  (typedef)                user types
-         enum  (uminus,uand,uasterisk)  converted operations
+!                                       converted operations
+         enum  (uminus,uplus,uand,uasterisk)
          enum  (parameteroper,castoper,opplusplus,opminusminus,compoundliteral)
          enum  (macroParm)              macro language
 
@@ -464,10 +467,14 @@ icp      start                          in-coming priority for expression
          dc    i1'3'                    caroteqop
          dc    i1'3'                    bareqop
          dc    i1'200'                  poundpoundop
+         dc    i1'200'                  dotdotdotsy
+         dc    i1'200'                  ppnumber
+         dc    i1'200'                  otherch
          dc    i1'200'                  eolsy
          dc    i1'200'                  eofsy
          dc    i1'200'                  typedef
          dc    i1'16'                   uminus
+         dc    i1'16'                   uplus
          dc    i1'16'                   uand
          dc    i1'16'                   uasterisk
          dc    i1'200'                  parameteroper
@@ -639,10 +646,14 @@ isp      start                          in stack priority for expression
          dc    i1'2'                    caroteqop
          dc    i1'2'                    bareqop
          dc    i1'0'                    poundpoundop
+         dc    i1'0'                    dotdotdotsy
+         dc    i1'0'                    ppnumber
+         dc    i1'0'                    otherch
          dc    i1'0'                    eolsy
          dc    i1'0'                    eofsy
          dc    i1'0'                    typedef
          dc    i1'16'                   uminus
+         dc    i1'16'                   uplus
          dc    i1'16'                   uand
          dc    i1'16'                   uasterisk
          dc    i1'0'                    parameteroper
@@ -936,6 +947,14 @@ wordHash start                          reserved word hash table
          dc    i'shortsy,typedefsy,unionsy,voidsy,whilesy,succwhilesy'
          end
 
+stdcVersion start                       __STDC_VERSION__ values
+
+         dc    i4'199409'               c95
+         dc    i4'199901'               c99
+         dc    i4'201112'               c11
+         dc    i4'201710'               c17
+         end
+
 macRomanToUCS start
          dc    i2'$00C4, $00C5, $00C7, $00C9, $00D1, $00D6, $00DC, $00E1'
          dc    i2'$00E0, $00E2, $00E4, $00E3, $00E5, $00E7, $00E9, $00E8'

Table.pas

@@ -22,6 +22,7 @@ var
    charSym: array[minChar..maxChar] of tokenEnum; {symbols for single char symbols}
    reservedWords: array[_Alignassy..whilesy] of string[14]; {reserved word strings}
    wordHash: array[0..25] of tokenEnum; {for hashing reserved words}
+   stdcVersion: array[c95..c17] of longint; {__STDC_VERSION__ values}
 
                                         {from ASM.PAS}
                                         {------------}

Tech.Support

@@ -0,0 +1,12 @@
+   As with all Byte Works programs, if you have questions or are
+experiencing problems, we want to hear from you.  You can contact us
+through the channels below.
+
+E-mail:         support@byteworks.us
+
+Web Site:       https://www.byteworks.us
+
+ORCA/C is now maintained on GitHub by community members.  Bug reports
+or support requests can be submitted on its issues page:
+
+https://github.com/byteworksinc/ORCA-C/issues

Tests/Conformance/C11.4.2.1.CC

@@ -6,18 +6,18 @@
 
 struct foo {
    int i;
-   const j;
-   volatile k;
+   int const j;
+   volatile int k;
    } ;
 
-main ()
+int main (void)
 
 {
 int i,j;
 
 j = 4;
-i = (const) j;
-i = (volatile) j;
+i = (const int) j;
+i = (int volatile) j;
 
 printf ("Passed Conformance Test 11.4.2.1\n");
 }

Tests/Conformance/C13.1.0.1.CC

@@ -3,9 +3,11 @@
 
 #include <stddef.h>
 
+int printf(const char *, ...);
+
 extended e1 [800];
 
-main ()
+int main (void)
   {
    int i [10] = { 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 };
    int *i1 = i;
@@ -28,7 +30,7 @@ main ()
        goto Fail;
 
    printf ("Passed Conformance Test 13.1.0.1\n");
-   return;
+   return 0;
 
 Fail:
    printf ("Failed Conformance Test 13.1.0.1\n");

Tests/Conformance/C14.1.0.1.CC

@@ -3,7 +3,9 @@
 
 #include <ctype.h>
 
-main ()
+int printf(const char *, ...);
+
+int main (void)
   {
    int   i, j;
    char  ch;
@@ -141,7 +143,7 @@ main ()
      }
 
      printf ("Passed Conformance Test 14.1.0.1\n");
-     return;
+     return 0;
 
 Fail:
      printf ("Failed Conformance Test 14.1.0.1\n");

Tests/Conformance/C14.2.0.1.CC

@@ -2,7 +2,9 @@
 
 #include <ctype.h>
 
-main ()
+int printf(const char *, ...);
+
+int main (void)
   {
    int   i, j;
    char  ch;
@@ -54,7 +56,7 @@ main ()
        goto Fail;
 
      printf ("Passed Conformance Test 14.2.0.1\n");
-     return;
+     return 0;
 
 Fail:
      printf ("Failed Conformance Test 14.2.0.1\n");

Tests/Conformance/C14.3.0.1.CC

@@ -2,7 +2,9 @@
 
 #include <ctype.h>
 
-main ()
+int printf(const char *, ...);
+
+int main (void)
   {
    int   i, j;
    char  ch;
@@ -80,7 +82,7 @@ main ()
 
 
      printf ("Passed Conformance Test 14.3.0.1\n");
-     return;
+     return 0;
 
 Fail:
      printf ("Failed Conformance Test 14.3.0.1\n");

Tests/Conformance/C14.4.0.1.CC

@@ -2,7 +2,9 @@
 
 #include <ctype.h>
 
-main ()
+int printf(const char *, ...);
+
+int main (void)
   {
    int   i, j;
    char  ch;
@@ -71,7 +73,7 @@ main ()
        goto Fail;
 
      printf ("Passed Conformance Test 14.4.0.1\n");
-     return;
+     return 0;
 
 Fail:
      printf ("Failed Conformance Test 14.4.0.1\n");

Tests/Conformance/C14.5.0.1.CC

@@ -2,7 +2,9 @@
 
 #include <ctype.h>
 
-main ()
+int printf(const char *, ...);
+
+int main (void)
   {
    int   i, j;
    char  ch;
@@ -33,7 +35,7 @@ main ()
      }
 
      printf ("Passed Conformance Test 14.5.0.1\n");
-     return;
+     return 0;
 
 Fail:
      printf ("Failed Conformance Test 14.5.0.1\n");

Tests/Conformance/C14.6.0.1.CC

@@ -2,7 +2,9 @@
 
 #include <ctype.h>
 
-main ()
+int printf(const char *, ...);
+
+int main (void)
   {
    int   i, j;
    char  ch;
@@ -30,7 +32,7 @@ main ()
      }
 
      printf ("Passed Conformance Test 14.6.0.1\n");
-     return;
+     return 0;
 
 Fail:
      printf ("Failed Conformance Test 14.6.0.1\n");

Tests/Conformance/C14.7.0.1.CC

@@ -2,7 +2,9 @@
 
 #include <ctype.h>
 
-main ()
+int printf(const char *, ...);
+
+int main (void)
   {
    int   i, j;
    char  ch;
@@ -67,7 +69,7 @@ main ()
 
 
      printf ("Passed Conformance Test 14.7.0.1\n");
-     return;
+     return 0;
 
 Fail:
      printf ("Failed Conformance Test 14.7.0.1\n");

Tests/Conformance/C14.8.0.1.CC

@@ -3,7 +3,7 @@
 #include <ctype.h>
 #include <stdio.h>
 
-main ()
+int main (void)
   {
    int   i, j;
    char  ch;
@@ -42,7 +42,7 @@ main ()
      }
 
      printf ("Passed Conformance Test 14.8.0.1\n");
-     return;
+     return 0;
 
 Fail:
      printf ("Failed Conformance Test 14.8.0.1\n");