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,38 +1,30 @@
-Welcome to ORCA/C 2.2.0 B4!  This is an update release containing
-patches from community members (Stephen Heumann and Kelvin Sherlock),
-which fix several bugs and also add some 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
-GNO and Golden Gate.  In these cases, only the directories containing
-files from a standard ORCA installation (normally /lang/orca for GNO)
-should be updated.  The GNO-specific libraries and headers in other
-directories should not be modified.  The ones provided with GNO 2.0.6
-can be used with this version of ORCA/C, although they do not contain
-all the updates and bug fixes described in the ORCA/C release notes.
-
-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)
+GNO and Golden Gate.  In these cases, the update files should be copied
+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

CC.pas

@@ -36,7 +36,7 @@ begin {cc}
 {make sure we quit with restart set}
 SystemQuitFlags($4000);
 
-{get the command line info}
+{initialize file names and parameter strings}
 includeFileGS.maxSize := maxPath+4;
 includeFileGS.theString.size := 0;
 for i := 1 to maxPath do
@@ -44,6 +44,14 @@ for i := 1 to maxPath do
 outFileGS := includeFileGS;
 partialFileGS := includeFileGS;
 infoStringGS := includeFileGS;
+
+{check the version number}
+vDCBGS.pCount := 1;
+VersionGS(vDCBGS);
+if (ToolError <> 0) or (vDCBGS.version[1] < '2') then
+   TermError(10);
+
+{get the command line info}
 with liDCBGS do begin
    pCount := 11;
    sFile := @includeFileGS;
@@ -52,10 +60,19 @@ with liDCBGS do begin
    iString := @infoStringGS;
    end; {with}
 GetLInfoGS(liDCBGS);
+if ToolError <> 0 then begin               {check for buffTooSmall errors}
+   includeFileGS.theString.size := 0;
+   outFileGS.theString.size := 0;
+   partialFileGS.theString.size := 0;
+   infoStringGS.theString.size := 0;
+   enterEditor := false;
+   TermError(13);
+   end; {if}
 sourceFileGS := includeFileGS;
 doingPartial := partialFileGS.theString.size <> 0;
 with liDCBGS do begin
    enterEditor := pFlags & flag_e <> 0;    {enter editor on terminal errors?}
+   filenamesInErrors := pFlags & flag_f <> 0; {filenames in error messages?}
    ignoreSymbols := mFlags & flag_i <> 0;  {ignore symbol file?}
    list := pFlags & flag_l <> 0;           {list the source file?}
    memoryCompile := pflags & flag_m <> 0;  {memory based compile?}
@@ -69,12 +86,6 @@ with liDCBGS do begin
 if list then                               {we don't need both...}
    progress := false;
 
-{check the version number}
-vDCBGS.pCount := 1;
-VersionGS(vDCBGS);
-if vDCBGS.version[1] < '2' then
-   TermError(10);
-
 {write the header}
 if list or progress then begin
    writeln('ORCA/C ', versionStr);
@@ -129,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 */
-      4,				/* 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 2020"
+   "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,11 +74,12 @@ 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}
 					{NOTE: maxPath is used in Scanner.asm}
-   longstringlen = 4000;                {max length of a string constant}
+   longstringlen = 32760;               {max length of a string constant}
  
    minChar      = 0;                    {min ordinal value of source character}
    maxChar      = 255;                  {max ordinal value of source character}
@@ -93,11 +94,14 @@ 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}
                                         {----------------------------}
    flag_d       = $10000000;            {generate debug code?}
    flag_e       = $08000000;            {abort to editor on terminal error?}
+   flag_f       = $04000000;            {print filenames in error messages?}
    flag_i       = $00800000;            {ignore symbol files?}
    flag_l       = $00100000;            {list source lines?}
    flag_m       = $00080000;            {memory based compile?}
@@ -108,12 +112,13 @@ const
    flag_t       = $00001000;            {treat all errors as terminal?}
    flag_w       = $00000200;            {wait when an error is found?}
 
-   versionStr = '2.2.0 B4';		{compiler version}
+   versionStr = '2.2.1 dev';		{compiler version}
 
 type
                                         {Misc.}
                                         {-----}
    long = record lsw,msw: integer; end; {for extracting words from longints}
+   longlong = record lo,hi: longint; end; {64-bit integer representation}
  
    cString = packed array [1..256] of char; {null terminated string}
    cStringPtr = ^cString;
@@ -140,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 }
@@ -148,7 +156,16 @@ type
  
    baseTypeEnum = (cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong,
                    cgReal,cgDouble,cgComp,cgExtended,cgString,
-                   cgVoid,ccPointer);
+                   cgVoid,cgQuad,cgUQuad,ccPointer);
+
+   { Basic types (plus the void type) as defined by the C language.      }
+   { This differs from baseTypeEnum in that different types with the     }
+   { same representation are distinguished from each other.              }
+   { (ctInt32/ctUInt32 are 32-bit int types when using #pragma unix 1.)  }
+
+   cTypeEnum = (ctChar, ctSChar, ctUChar, ctShort, ctUShort, ctInt, ctUInt,
+                ctLong, ctULong, ctFloat, ctDouble, ctLongDouble, ctComp,
+                ctVoid, ctInt32, ctUInt32, ctBool, ctLongLong, ctULongLong);
 
                                         {tokens}
                                         {------}
@@ -157,8 +174,12 @@ type
    tokenEnum = (                        {enumeration of the tokens}
                ident,                   {identifiers}
                                         {constants}
-               intconst,uintconst,longconst,ulongconst,doubleconst,
-               stringconst,
+                                        {Note: compconst and charconst, etc. }
+                                        { are not found in program code.     }
+                                        { They are created only by casts.    }
+               intconst,uintconst,longconst,ulongconst,longlongconst,
+               ulonglongconst,floatconst,doubleconst,extendedconst,compconst,
+               charconst,scharconst,ucharconst,ushortconst,stringconst,
                                         {reserved words}
                _Alignassy,_Alignofsy,_Atomicsy,_Boolsy,_Complexsy,
                _Genericsy,_Imaginarysy,_Noreturnsy,_Static_assertsy,_Thread_localsy,
@@ -180,11 +201,14 @@ 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}
-               parameteroper,castoper,opplusplus,opminusminus,
+                                        {converted operations}
+               uminus,uplus,uand,uasterisk,
+               parameteroper,castoper,opplusplus,opminusminus,compoundliteral,
                macroParm);              {macro language}
 
                                         {Note: this enumeration also    }
@@ -194,11 +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,
-                 doubleConstant,stringConstant,macroParameter);
+                 longlongConstant,realConstant,stringConstant,otherCharacter,
+                 preprocessingNumber,macroParameter);
    identPtr = ^identRecord;             {^ to a symbol table entry}
    tokenType = record                   {a token}
       kind: tokenEnum;                  {kind of token}
@@ -210,9 +238,13 @@ type
                           symbolPtr: identPtr);
          intConstant   : (ival: integer);
          longConstant  : (lval: longint);
-         doubleConstant: (rval: double);
+         longlongConstant: (qval: longlong);
+         realConstant  : (rval: extended);
          stringConstant: (sval: longstringPtr;
-                          ispstring: boolean);
+                          ispstring: boolean;
+                          prefix: charStrPrefixEnum);
+         otherCharacter: (ch: char);    {used for preprocessing tokens only}
+         preprocessingNumber: (errCode: integer);  {used for pp tokens only}
          macroParameter: (pnum: integer);
      end;
  
@@ -259,14 +291,18 @@ type
      parameterType: typePtr;
      end;
 
+  typeQualifierEnum = (tqConst, tqVolatile, tqRestrict);
+  typeQualifierSet = set of typeQualifierEnum;
+
   typeKind = (scalarType,arrayType,pointerType,functionType,enumType,
               enumConst,structType,unionType,definedType);
   typeRecord = record                   {type}
      size: longint;                     {size of the type in bytes}
-     isConstant: boolean;               {is the type a constant?}
+     qualifiers: typeQualifierSet;      {type qualifiers}
      saveDisp: longint;			{disp in symbol file}
      case kind: typeKind of             {NOTE: aType,pType and fType must overlap}
-        scalarType  : (baseType: baseTypeEnum;);
+        scalarType  : (baseType: baseTypeEnum;  {our internal type representation}
+                       cType: cTypeEnum);       {type in the C type system}
         arrayType   : (aType: typePtr;
                        elements: longint;
                       );
@@ -286,31 +322,38 @@ type
         structType,
         unionType   : (fieldList: identPtr;	{field list}
 		       sName: stringPtr;	{struct name; for forward refs}
+		       constMember: boolean;    {does it have a const member?}
+		       flexibleArrayMember: boolean; {does it have a FAM?}
                       );
      end;
 
    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);
-         true : (
-            case itype: baseTypeEnum of
+         false: (
+            iType: typePtr;             {type being initialized}
+            iTree: tokenPtr;            {initializer expression}
+            );
+         true : (                       {Note: qVal.lo must overlap iVal}
+            case basetype: baseTypeEnum of
                cgByte,
                cgUByte,
                cgWord,
                cgUWord,
                cgLong,
                cgULong   : (iVal: longint);
+               cgQuad,
+               cgUQuad   : (qVal: longlong);
                cgString  : (sVal: longstringPtr);
                cgReal,
                cgDouble,
                cgComp,
-               cgExtended: (rVal: double);
+               cgExtended: (rVal: extended);
                cgVoid,
                ccPointer: (
                   pVal: longint;
@@ -337,14 +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 #}
-        parameter: (pln: integer;       {paramater label #}
-                    pdisp: integer;     {disp of parameter}
-                    pnext: identPtr);   {next parameter}
-        external: ();
+        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:   (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}
@@ -446,6 +495,9 @@ 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}
    doingParameters: boolean;            {are we processing parm definitions?}
@@ -457,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}
@@ -467,21 +519,23 @@ var
    oldincludeFileGS: gsosOutString;	{previous includeFile value}
    outFileGS: gsosOutString;		{keep file name}
    partialFileGS: gsosOutString;        {partial compile list}
-   sourceFileGS: gsosOutString;		{debug source file name}
+   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}
 
                                         {expression results}
                                         {------------------}
    doDispose: boolean;                  {dispose of the expression tree as we go?}
-   realExpressionValue: double;         {value of the last real constant expression}
+   realExpressionValue: extended;       {value of the last real constant expression}
+   llExpressionValue: longlong;         {value of the last long long constant expression}
    expressionValue: longint;            {value of the last constant expression}
    expressionType: typePtr;             {the type of the expression}
    initializerTree: tokenPtr;           {for non-constant initializers}
    isConstant: boolean;                 {is the initializer expression constant?}
-
-                                        {type specifier results}
-                                        {----------------------}
-   typeSpec: typePtr;                   {type specifier}
+   expressionIsLongLong: boolean;       {is the last constant expression long long?}
 
                                         {flags}
                                         {-----}
@@ -489,6 +543,7 @@ var
    doingFunction: boolean;              {are we processing a function?}
    doingPartial: boolean;               {are we doing a partial compile?}
    enterEditor: boolean;                {enter editor on terminal errors?}
+   filenamesInErrors: boolean;          {print filenames in error messages?}
    foundFunction: boolean;              {has a function been found?}
    lint: integer;                       {lint flags}
    list: boolean;                       {generate source listing?}
@@ -506,6 +561,8 @@ var
    lintIsError: boolean;                {treat lint messages as errors?}
    fIsNoreturn: boolean;                {is the current function _Noreturn?}
    doingMain: boolean;                  {are we processing the main function?}
+   fenvAccess: boolean;                 {is the FENV_ACCESS pragma on?}
+   fenvAccessInFunction: boolean;       {was FENV_ACCESS on anywhere in current function?}
 
                                         {syntactic classes of tokens}
                                         {---------------------------}
@@ -640,7 +697,7 @@ implementation
 const
                                         {Note: maxLabel is also defined in cgi.pas}
                                         {Note: maxlabel is also defined in CGC.asm}
-   maxLabel = 3200;			{max # compiler generated labels}
+   maxLabel = 3275;			{max # compiler generated labels}
 
 					{spinner}
                                         {-------}
@@ -781,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}
@@ -835,6 +894,10 @@ spinner[0] := '|';			{set up the spinner characters}
 spinner[1] := '/';
 spinner[2] := '-';
 spinner[3] := '\';
+longlong0.hi := 0;
+longlong0.lo := 0;
+longlong1.hi := 0;
+longlong1.lo := 1;
 end; {InitCCommon}
 
 
@@ -954,8 +1017,9 @@ 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
       msg := '';
       Error(57);

CGC.asm

@@ -1,32 +1,65 @@
          mcopy cgc.macros
 ****************************************************************
 *
-*  CnvSX - Convert floating point to SANE extended
+*  CnvSC - Convert floating point to SANE comp
 *
 *  Inputs:
 *        rec - pointer to a record
 *
+*  Note: This avoids calling FX2C on negative numbers,
+*  because it is buggy for certain values.
+*
 ****************************************************************
 *
-CnvSX    start cg
+CnvSC    start cg
 rec      equ   4                        record containing values
-rec_real equ   0                        disp to real value
-rec_ext  equ   8                        disp to extended (SANE) value
+rec_real equ   0                        disp to real (extended) value
+rec_cmp  equ   10                       disp to comp (SANE) value
 
          tsc                            set up DP
          phd
          tcd
+         ldy   #rec_real+8
+         lda   [rec],y
+         pha                            save sign of real number
+         and   #$7fff
+         sta   [rec],y                  set sign of real number to positive
          ph4   rec                      push addr of real number
-         clc                            push addr of SANE number
+         clc                            push addr of SANE comp number
          lda   rec
-         adc   #rec_ext
+         adc   #rec_cmp
          tax
          lda   rec+2
          adc   #0
          pha
          phx
-         fd2x                           convert TOS to extended
-         move4 0,4                      return
+         fx2c                           convert TOS to SANE comp number
+         pla
+         bpl   ret                      if real number was negative
+         ldy   #rec_real+8                restore original sign of real number
+         sta   [rec],y
+         sec                              negate the comp value
+         ldy   #rec_cmp
+         ldx   #0
+         txa
+         sbc   [rec],y
+         sta   [rec],y
+         iny
+         iny
+         txa
+         sbc   [rec],y
+         sta   [rec],y
+         iny
+         iny
+         txa
+         sbc   [rec],y
+         sta   [rec],y
+         iny
+         iny
+         txa
+         sbc   [rec],y
+         sta   [rec],y
+ret      move4 0,4                      return
          pld
          pla
          pla
@@ -35,54 +68,124 @@ rec_ext  equ   8                        disp to extended (SANE) value
 
 ****************************************************************
 *
-*  CnvSC - Convert floating point to SANE comp
+*  procedure CnvXLL (var result: longlong; val: extended);
+*
+*  Convert floating point to long long
 *
 *  Inputs:
-*        rec - pointer to a record
+*        result - longlong to hold the converted value
+*        val - the real value
 *
 ****************************************************************
-*
-CnvSC    start cg
-rec      equ   4                        record containing values
-rec_real equ   0                        disp to real value
-rec_ext  equ   8                        disp to extended (SANE) value
-rec_cmp  equ   18                       disp to comp (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
-         fd2x                           convert TOS to extended
-         clc                            push addr of SANE number
-         lda   rec
-         adc   #rec_ext
-         tax
-         lda   rec+2
-         adc   #0
-         pha
-         phx
-         clc                            push addr of COMP number
-         lda   rec
-         adc   #rec_cmp
-         tax
-         lda   rec+2
-         adc   #0
-         pha
-         phx
-         fx2c                           convert TOS to extended
-         move4 0,4                      return
-         pld
+CnvXLL   start cg
+
+         subroutine (4:result,10:val),0
+
+         pei   (val+8)
+         pei   (val+6)
+         pei   (val+4)
+         pei   (val+2)
+         pei   (val)   
+         jsl   ~CnvRealLongLong
+         pl8   [result]
+         
+         return
+         end
+
+****************************************************************
+*
+*  procedure CnvXULL (var result: longlong; val: extended);
+*
+*  Convert floating point to unsigned long long
+*
+*  Inputs:
+*        result - longlong to hold the converted value
+*        val - the real value
+*
+****************************************************************
+
+CnvXULL  start cg
+
+         subroutine (4:result,10:val),0
+
+         pei   (val+8)
+         pei   (val+6)
+         pei   (val+4)
+         pei   (val+2)
+         pei   (val)   
+         jsl   ~CnvRealULongLong
+         pl8   [result]
+         
+         return
+         end
+
+****************************************************************
+*
+*  function CnvLLX (val: longlong): extended;
+*
+*  convert a long long to a real number
+*
+*  Inputs:
+*        val - the long long value
+*
+****************************************************************
+
+CnvLLX   start cg
+
+         subroutine (4:val),0
+
+         ph8   [val]
+         jsl   ~CnvLongLongReal
          pla
+         sta   >rval
          pla
-         rtl
+         sta   >rval+2
+         pla
+         sta   >rval+4
+         pla
+         sta   >rval+6
+         pla
+         sta   >rval+8
+         
+         lla   val,rval
+         return 4:val
+
+rval     ds    10
+         end
+
+****************************************************************
+*
+*  function CnvULLX (val: longlong): extended;
+*
+*  convert an unsigned long long to a real number
+*
+*  Inputs:
+*        val - the unsigned long long value
+*
+****************************************************************
+
+CnvULLX  start cg
+
+         subroutine (4:val),0
+
+         ph8   [val]
+         jsl   ~CnvULongLongReal
+         pla
+         sta   >rval
+         pla
+         sta   >rval+2
+         pla
+         sta   >rval+4
+         pla
+         sta   >rval+6
+         pla
+         sta   >rval+8
+         
+         lla   val,rval
+         return 4:val
+
+rval     ds    10
          end
 
          datachk off
@@ -97,7 +200,7 @@ rec_cmp  equ   18                       disp to comp (SANE) value
 ****************************************************************
 *
 InitLabels start cg
-maxLabel equ   3200
+maxLabel equ   3275
 
 !                                       with labelTab[0] do begin
          lda   #-1                         val := -1;
@@ -114,3 +217,24 @@ maxLabel equ   3200
          stz   intLabel                 intLabel := 0;
          rtl
          end
+         datachk on
+
+****************************************************************
+*
+*  function SignBit (val: extended): integer;
+*
+*  returns the sign bit of a floating-point number
+*  (0 for positive, 1 for negative)
+*
+****************************************************************
+*
+SignBit  start cg
+
+         subroutine (10:val),0
+         
+         asl   val+8
+         stz   val
+         rol   val
+         
+         return 2:val
+         end

CGC.macros

@@ -175,14 +175,339 @@
  sta 2+&op
  mend
  MACRO
-&LAB FD2X
-&LAB PEA $010E
- LDX #$090A
- JSL $E10000
- MEND
- MACRO
 &LAB FX2C
 &LAB PEA $0510
  LDX #$090A
  JSL $E10000
  MEND
+ macro
+&l pl8 &n1
+ lclc &c
+&l anop
+ aif s:longa=1,.a
+ rep #%00100000
+.a
+&c amid &n1,1,1
+ aif "&c"<>"{",.b
+&c amid &n1,l:&n1,1
+ aif "&c"<>"}",.f
+&n1 amid &n1,2,l:&n1-2
+ pla
+ sta (&n1)
+ ldy #2
+ pla
+ sta (&n1),y
+ ldy #4
+ pla
+ sta (&n1),y
+ ldy #6
+ pla
+ sta (&n1),y
+ ago .d
+.b
+ aif "&c"<>"[",.c
+ pla
+ sta &n1
+ ldy #2
+ pla
+ sta &n1,y
+ ldy #4
+ pla
+ sta &n1,y
+ ldy #6
+ pla
+ sta &n1,y
+ ago .d
+.c
+ pla
+ sta &n1
+ pla
+ sta &n1+2
+ pla
+ sta &n1+4
+ pla
+ sta &n1+6
+.d
+ aif s:longa=1,.e
+ sep #%00100000
+.e
+ mexit
+.f
+ mnote "Missing closing '}'",16
+ mend
+ MACRO
+&lab subroutine &parms,&work
+&lab anop
+ aif c:&work,.a
+ lclc &work
+&work setc 0
+.a
+ gbla &totallen
+ gbla &worklen
+&worklen seta &work
+&totallen seta 0
+ aif c:&parms=0,.e
+ lclc &len
+ lclc &p
+ lcla &i
+&i seta c:&parms
+.b
+&p setc &parms(&i)
+&len amid &p,2,1
+ aif "&len"=":",.c
+&len amid &p,1,2
+&p amid &p,4,l:&p-3
+ ago .d
+.c
+&len amid &p,1,1
+&p amid &p,3,l:&p-2
+.d
+&p equ &totallen+3+&work
+&totallen seta &totallen+&len
+&i seta &i-1
+ aif &i,^b
+.e
+ tsc
+ sec
+ sbc #&work
+ tcs
+ inc a
+ phd
+ tcd
+ mend
+ MACRO
+&lab return &r
+&lab anop
+ lclc &len
+ aif c:&r,.a
+ lclc &r
+&r setc 0
+&len setc 0
+ ago .h
+.a
+&len amid &r,2,1
+ aif "&len"=":",.b
+&len amid &r,1,2
+&r amid &r,4,l:&r-3
+ ago .c
+.b
+&len amid &r,1,1
+&r amid &r,3,l:&r-2
+.c
+ aif &len<>2,.d
+ ldy &r
+ ago .h
+.d
+ aif &len<>4,.e
+ ldx &r+2
+ ldy &r
+ ago .h
+.e
+ aif &len<>10,.g
+ aif &totallen=0,.f
+ lda &worklen+1
+ sta &worklen+&totallen+1
+ lda &worklen
+ sta &worklen+&totallen
+.f
+ pld
+ tsc
+ clc
+ adc #&worklen+&totallen
+ tcs
+ phb
+ plx
+ ply
+ lda &r+8
+ pha
+ lda &r+6
+ pha
+ lda &r+4
+ pha
+ lda &r+2
+ pha
+ lda &r
+ pha
+ phy
+ phx
+ plb
+ rtl
+ mexit
+.g
+ mnote 'Not a valid return length',16
+ mexit
+.h
+ aif &totallen=0,.i
+ lda &worklen+1
+ sta &worklen+&totallen+1
+ lda &worklen
+ sta &worklen+&totallen
+.i
+ pld
+ tsc
+ clc
+ adc #&worklen+&totallen
+ tcs
+ aif &len=0,.j
+ tya
+.j
+ rtl
+ mend
+ macro
+&l lla &ad1,&ad2
+&l anop
+ lcla &lb
+ lclb &la
+ aif s:longa,.a
+ rep #%00100000
+ longa on
+&la setb 1
+.a
+ lda #&ad2
+&lb seta c:&ad1
+.b
+ sta &ad1(&lb)
+&lb seta &lb-1
+ aif &lb,^b
+ lda #^&ad2
+&lb seta c:&ad1
+.c
+ sta 2+&ad1(&lb)
+&lb seta &lb-1
+ aif &lb,^c
+ aif &la=0,.d
+ sep #%00100000
+ longa off
+.d
+ mend
+ macro
+&l ph8 &n1
+ lclc &c
+&l anop
+&c amid &n1,1,1
+ aif s:longa=1,.a
+ rep #%00100000
+.a
+ aif "&c"="#",.d
+ aif "&c"="[",.b
+ aif "&c"<>"{",.c
+&c amid &n1,l:&n1,1
+ aif "&c"<>"}",.g
+&n1 amid &n1,2,l:&n1-2
+&n1 setc (&n1)
+.b
+ ldy #6
+~&SYSCNT lda &n1,y
+ pha
+ dey
+ dey
+ bpl ~&SYSCNT
+ ago .e
+.c
+ ldx #6
+~&SYSCNT lda &n1,x
+ pha
+ dex
+ dex
+ bpl ~&SYSCNT
+ ago .e
+.d
+&n1 amid &n1,2,l:&n1-1
+ bra ~b&SYSCNT
+~a&SYSCNT dc i8"&n1"
+~b&SYSCNT ldx #6
+~c&SYSCNT lda ~a&SYSCNT,x
+ pha
+ dex
+ dex
+ bpl ~c&SYSCNT
+.e
+ aif s:longa=1,.f
+ sep #%00100000
+.f
+ mexit
+.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}
-      itsReal: double;
-      inSANE: packed array[1..10] of byte;
+   realrec = record                     {used to convert from real to comp}
+      itsReal: extended;
       inCOMP: packed array[1..8] of byte;
       end;
 
@@ -58,13 +57,38 @@ procedure CnvSC (rec: realrec); extern;
 {               has space for the result                        }
 
 
-procedure CnvSX (rec: realrec); extern;
+procedure CnvXLL (var result: longlong; val: extended); extern;
 
-{ convert a real number to SANE extended format                 }
+{ convert a real number to long long                            }
 {                                                               }
 { parameters:                                                   }
-{       rec - record containing the value to convert; also      }
-{               has space for the result                        }
+{       result - longlong to hold the converted value           }
+{       val - the real value                                    }
+
+
+procedure CnvXULL (var result: longlong; val: extended); extern;
+
+{ convert a real number to unsigned long long                   }
+{                                                               }
+{ parameters:                                                   }
+{       result - longlong to hold the converted value           }
+{       val - the real value                                    }
+
+
+function CnvLLX (val: longlong): extended; extern;
+
+{ convert a long long to a real number                          }
+{                                                               }
+{ parameters:                                                   }
+{       val - the long long value                               }
+
+
+function CnvULLX (val: longlong): extended; extern;
+
+{ convert an unsigned long long to a real number                }
+{                                                               }
+{ parameters:                                                   }
+{       val - the unsigned long long value                      }
 
 
 procedure InitLabels; extern;
@@ -73,6 +97,12 @@ procedure InitLabels; extern;
 {								}
 { Note: also defined in CGI.pas					}
 
+
+function SignBit (val: extended): integer; extern;
+
+{ returns the sign bit of a floating-point number               }
+{ (0 for positive, 1 for negative)                              }
+
 {-- These routines are defined in the compiler, but used from cg --}
 
 function Calloc (bytes: integer): ptr; extern;

CGI.Comments

@@ -3,13 +3,14 @@
 {  dc_cns - generate a constant value                           }
 {                                                               }
 {  GenL1(dc_cns, lval, count);                                  }
+{  GenQ1(dc_cns, qval, count);                                  }
 {  GenR1t(dc_cns, rval, count, type);                           }
 {  Gen2t(dc_cns, ival, count, type);                            }
 {  GenS(dc_cns, sptr);                                          }
 {                                                               }
-{  Creates COUNT occurrences of the constant lval, rval or      }
-{  ival, based on the type.  In Gen2t can accept byte or word   }
-{  types.  In the case of GenS, the operand is a string         }
+{  Creates COUNT occurrences of the constant lval, qval, rval   }
+{  or ival, based on the type.  In Gen2t can accept byte or     }
+{  word types.  In the case of GenS, the operand is a string    }
 {  constant, and no repeat count is allowed.                    }
 {                                                               }
 {                                                               }
@@ -33,7 +34,8 @@
 {                                                               }
 {  pc_lnm - line number                                         }
 {                                                               }
-{  Gen2(pc_lnm, lc, flag)                                       }
+{  Gen2Name(pc_lnm, lc, flag, nil)                              }
+{  Gen2Name(pc_lnm, lc, flag, pointer(filename))                }
 {                                                               }
 {  Sets the current line number for the traceback facility and  }
 {  debugger.  This p-code should only be generated after the    }
@@ -45,13 +47,17 @@
 {       1 - break point                                         }
 {       2 - auto-go                                             }
 {                                                               }
+{  If filename is not nil, it is a pointer to a GS/OS output    }
+{  string giving the source file name.  This is used to change  }
+{  the file name within a function that spans multiple files.   }
+{                                                               }
 {                                                               }
 {  pc_mov - move memory                                         }
 {                                                               }
 {  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	}
@@ -70,7 +76,7 @@
 {       debugFlag - are we generating debug code?               }
 {       profileFlag - are we profiling?                         }
 {       traceBack - are we doing tracebacks?                    }
-{       sourceFile - current source file name                   }
+{       debugSourceFileGS - current source file name            }
 {                                                               }
 {                                                               }
 {  pc_nat - native code generation                              }
@@ -90,10 +96,12 @@
 {                                                               }
 {  pc_adi - integer addition                                    }
 {  pc_adl - long addition                                       }
+{  pc_adq - long long addition                                  }
 {  pc_adr - real addition                                       }
 {                                                               }
 {  Gen0(pc_adi)         cgByte,cgUByte,cgWord,cgUWord           }
 {  Gen0(pc_adl)         cgLong,cgULong                          }
+{  Gen0(pc_adq)         cgQuad,cgUQuad                          }
 {  Gen0(pc_adr)         cgReal,cgDouble,cgComp,cgExtended       }
 {                                                               }
 {  The two values on the top of the evaluation stack are        }
@@ -117,9 +125,11 @@
 {                                                               }
 {  pc_bnd - bitwise and                                         }
 {  pc_bal - long bitwise and                                    }
+{  pc_baq - long long bitwise and                               }
 {                                                               }
 {  Gen0(pc_bnd)         cgByte,cgUByte,cgWord,cgUWord           }
 {  Gen0(pc_bal)         cgLong,cgULong                          }
+{  Gen0(pc_baq)         cgQuad,cgUQuad                          }
 {                                                               }
 {  The two values on the top of the evaluation stack are        }
 {  removed and anded.  The result is placed back on the stack.  }
@@ -140,9 +150,11 @@
 {                                                               }
 {  pc_bnt - bitwise negation                                    }
 {  pc_bnl - long bitwise negation                               }
+{  pc_bnq - long long bitwise negation                          }
 {                                                               }
 {  Gen0(pc_bnt)         cgByte,cgUByte,cgWord,cgUWord           }
 {  Gen0(pc_bnl)         cgLong,cgULong                          }
+{  Gen0(pc_bnq)         cgQuad,cgUQuad                          }
 {                                                               }
 {  The value on the top of the evaluation stack is removed,     }
 {  exclusive ored with $FFFF, and replaced.  (One's compliment.)}
@@ -150,9 +162,11 @@
 {                                                               }
 {  pc_bor - bitwise or                                          }
 {  pc_blr - long bitwise or                                     }
+{  pc_bqr - long long bitwise or                                }
 {                                                               }
 {  Gen0(pc_bor)         cgByte,cgUByte,cgWord,cgUWord           }
 {  Gen0(pc_blr)         cgLong,cgULong                          }
+{  Gen0(pc_bqr)         cgQuad,cgUQuad                          }
 {                                                               }
 {  The two values on the top of the evaluation stack are        }
 {  removed and ored.  The result is placed back on the stack.   }
@@ -160,9 +174,11 @@
 {                                                               }
 {  pc_bxr - exclusive or                                        }
 {  pc_blx - long exclusive or                                   }
+{  pc_bqx - long long exclusive or                              }
 {                                                               }
 {  Gen0(pc_bxr)         cgByte,cgUByte,cgWord,cgUWord           }
 {  Gen0(pc_blx)         cgLong,cgULong                          }
+{  Gen0(pc_bqx)         cgQuad,cgUQuad                          }
 {                                                               }
 {  The two values on the top of the evaluation stack are        }
 {  removed and exclusive ored.  The result is placed back on    }
@@ -180,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)                            	}
@@ -264,12 +289,16 @@
 {  pc_udi - unsigned integer divide                             }
 {  pc_dvl - long integer divide                                 }
 {  pc_udl - unsigned long divide                                }
+{  pc_dvq - long long integer divide                            }
+{  pc_udq - unsigned long long divide                           }
 {  pc_dvr - real divide                                         }
 {                                                               }
 {  Gen0(pc_dvi)         cgByte,cgWord                           }
 {  Gen0(pc_udi)         cgUByte,cgUWord                         }
 {  Gen0(pc_dvl)         cgLong                                  }
 {  Gen0(pc_udl)         cgULong                                 }
+{  Gen0(pc_dvq)         cgQuad                                  }
+{  Gen0(pc_udq)         cgUQuad                                 }
 {  Gen0(pc_dvr)         cgReal,cgDouble,cgComp,cgExtended       }
 {                                                               }
 {  The two values on the top of the evaluation stack are        }
@@ -286,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           }
@@ -329,11 +366,12 @@
 {                                                               }
 {  pc_ind - load indirect                                       }
 {                                                               }
-{  Gen1t (pc_ind, disp, type)                                   }
+{  Gen2t (pc_ind, volatile, disp, type)                         }
 {                                                               }
 {  A value of type TYPE is loaded from DISP bytes past the      }
 {  address that is on the evaluation stack.  The address is     }
 {  removed from the stack and replaced with the value.          }
+{  VOLATILE is non-zero for a volatile load, or 0 otherwise.    }
 {                                                               }
 {                                                               }
 {  pc_ior - logical or                                          }
@@ -392,7 +430,8 @@
 {  GenS(pc_lca, str)                                            }
 {                                                               }
 {  Loads the address of a string onto the stack.  Str is a      }
-{  pointer to a string constant.                                }
+{  pointer to a string constant.  No null terminator is added;  }
+{  it should be explicitly included in str if desired.          }
 {                                                               }
 {                                                               }
 {  pc_lda - load a local address                                }
@@ -406,9 +445,10 @@
 {                                                               }
 {  Gen1t(pc_ldc, val, type)                                     }
 {  GenLdcLong(val)                                              }
+{  GenLdcQuad(val)                                              }
 {  GenLdcReal(val)                                              }
 {                                                               }
-{  Loads a constant value.  Special calls for long and real     }
+{  Loads a constant value.  Special calls for long, quad & real }
 {  values are provided due to the unique parameter requirements.}
 {                                                               }
 {                                                               }
@@ -453,11 +493,15 @@
 {  pc_uim - unsigned integer modulus/remainder                  }
 {  pc_mdl - long remainder                                      }
 {  pc_ulm - unsigned long modulus/remainder                     }
+{  pc_mdq - long long remainder                                 }
+{  pc_uqm - unsigned long long modulus/remainder                }
 {                                                               }
 {  Gen0(pc_mod)         cgByte,cgWord                           }
 {  Gen0(pc_uim)         cgUByte,cgUWord                         }
 {  Gen0(pc_mdl)         cgLong                                  }
 {  Gen0(pc_ulm)         cgULong                                 }
+{  Gen0(pc_mdq)         cgQuad                                  }
+{  Gen0(pc_uqm)         cgUQuad                                 }
 {                                                               }
 {  The two values on the top of the evaluation stack are        }
 {  removed and the remainder after division is calculated.      }
@@ -469,12 +513,16 @@
 {  pc_umi - unsigned integer multiply                           }
 {  pc_mpl - long integer multiply                               }
 {  pc_uml - unsigned long multiply                              }
+{  pc_mpq - long long integer multiply                          }
+{  pc_umq - unsigned long long multiply                         }
 {  pc_mpr - real multiply                                       }
 {                                                               }
 {  Gen0(pc_mpi)         cgByte,cgWord                           }
 {  Gen0(pc_umi)         cgUByte,cgUWord                         }
 {  Gen0(pc_mpl)         cgLong                                  }
 {  Gen0(pc_uml)         cgULong                                 }
+{  Gen0(pc_mpq)         cgQuad                                  }
+{  Gen0(pc_umq)         cgUQuad                                 }
 {  Gen0(pc_mpr)         cgReal,cgDouble,cgComp,cgExtended       }
 {                                                               }
 {  The two values on the top of the evaluation stack are        }
@@ -484,10 +532,12 @@
 {                                                               }
 {  pc_ngi - integer negation                                    }
 {  pc_ngl - long negation                                       }
+{  pc_ngq - long long negation                                  }
 {  pc_ngr - real negation                                       }
 {                                                               }
 {  Gen0(pc_ngi)         cgByte,cgUByte,cgWord,cgUWord           }
 {  Gen0(pc_ngl)         cgLong,cgULong                          }
+{  Gen0(pc_ngq)         cgQuad,cgUQuad                          }
 {  Gen0(pc_ngr)         cgReal,cgDouble,cgComp,cgExtended       }
 {                                                               }
 {  The value on the top of the evaluation stack is removed,     }
@@ -525,6 +575,14 @@
 {  source address onto the stack.                               }
 {                                                               }
 {                                                               }
+{  pc_rbo - reverse byte order                                  }
+{                                                               }
+{  Gen0(pc_rbo)         cgWord,cgUWord                          }
+{                                                               }
+{  The value on the top of the evaluation stack is removed, has }
+{  the order of its constituent bytes reversed, and is replaced.}
+{                                                               }
+{                                                               }
 {  pc_sbf - save bit field                                      }
 {                                                               }
 {  Gen2t(pc_sbf, disp, size, type)                              }
@@ -537,10 +595,12 @@
 {                                                               }
 {  pc_sbi - integer subtraction                                 }
 {  pc_sbl - long subtraction                                    }
+{  pc_sbq - long long subtraction                               }
 {  pc_sbr - real subtraction                                    }
 {                                                               }
 {  Gen0(pc_sbi)         cgByte,cgUByte,cgWord,cgUWord           }
 {  Gen0(pc_sbl)         cgLong,cgULong                          }
+{  Gen0(pc_sbq)         cgQuad,cgUQuad                          }
 {  Gen0(pc_sbr)         cgReal,cgDouble,cgComp,cgExtended       }
 {                                                               }
 {  The two values on the top of the evaluation stack are        }
@@ -549,25 +609,32 @@
 {                                                               }
 {  pc_shl - shift left                                          }
 {  pc_sll - shift left long                                     }
+{  pc_slq - shift left long long                                }
 {                                                               }
 {  Gen0(pc_shl)         cgByte,cgUByte,cgWord,cgUWord           }
 {  Gen0(pc_sll)         cgLong,cgULong                          }
+{  Gen0(pc_slq)         cgQuad,cgUQuad (tos-1) / cgWord (tos)   }
 {                                                               }
 {  The value at tos-1 is shifted left by the number of bits     }
 {  specified by tos.  The result is an integer, which replaces  }
 {  the operands on the stack.  The right bit positions are      }
-{  filled with zeros.                                           }
+{  filled with zeros.  For pc_slq, only the value at tos-1 is   }
+{  cgQuad/cgUQuad; the shift count at tos is cgWord or cgUWord. }
 {                                                               }
 {                                                               }
 {  pc_shr - shift right                                         }
 {  pc_usr - unsigned shift right                                }
 {  pc_slr - long shift right                                    }
 {  pc_vsr - unsigned long shift right                           }
+{  pc_sqr - long long shift right                               }
+{  pc_wsr - unsigned long long shift right                      }
 {                                                               }
 {  Gen0(pc_shr)         cgByte,cgWord                           }
 {  Gen0(pc_usr)         cgUByte,cgUWord                         }
 {  Gen0(pc_slr)         cgLong                                  }
 {  Gen0(pc_vsr)         cgULong                                 }
+{  Gen0(pc_sqr)         cgQuad (tos-1) / cgWord (tos)           }
+{  Gen0(pc_wsr)         cgUQuad (tos-1) / cgWord (tos)          }
 {                                                               }
 {  The value at tos-1 is shifted right by the number of bits    }
 {  specified by tos.  The result is an integer, which replaces  }
@@ -577,7 +644,9 @@
 {                                                               }
 {  Pc_usr is the unsigned form.  The operation is the same,     }
 {  except that the leftmost bit is replaced with a zero.        }
-{  Pc_vsr is used for unsigned long operations.                 }
+{  Pc_vsr is used for unsigned long operations, and pc_wsr is   }
+{  used for unsigned long long operations.                      }
+{                                                               }
 {                                                               }
 {  pc_stk - stack an operand                                    }
 {                                                               }
@@ -636,7 +705,7 @@
 {                                                               }
 {  dc_lab - define a label                                      }
 {                                                               }
-{  Gen1(pc_lab, lab)                                            }
+{  Gen1(dc_lab, lab)                                            }
 {                                                               }
 {  Defines label number lab at the current location.            }
 {                                                               }
@@ -735,22 +804,36 @@
 {  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)					}
 {                                                               }
 {  Calls a user procedure or function through the address on    }
 {  the top of the evaluation stack.  FTYPE is the return type.	}
-{  Repair is 1 if stack repair should be forced, and 0 if not.	}
+{  Repair is 1 if stack repair should be forced, -1 if stack    }
+{  repair and checking should be disabled, or 0 if the regular  }
+{  settings should be used.                                     }
 {                                                               }
 {                                                               }
 {  pc_cup - call user procedure                                 }
 {                                                               }
-{  Gen1tName(pc_cup, repair, name, ftype)			}
+{  Gen1tName(pc_cup, repair, ftype, name)                       }
 {                                                               }
 {  Calls a user procedure or function.  Ftype is the type.	}
-{  Repair is 1 if stack repair should be forced, and 0 if not.	}
-{  NAME is the name of the procedure.				}
+{  Repair is 1 if stack repair should be forced, -1 if stack    }
+{  repair and checking should be disabled, or 0 if the regular  }
+{  settings should be used.  NAME is the name of the procedure. }
 {                                                               }
 {                                                               }
 {  dc_loc - define local label                                  }

CGI.Debug

@@ -116,10 +116,30 @@ opt[dc_prm] := 'PRM';
 opt[pc_nat] := 'nat';
 opt[pc_bno] := 'bno';
 opt[pc_nop] := 'nop';
+opt[pc_bqr] := 'bqr';
+opt[pc_bqx] := 'bqx';
+opt[pc_baq] := 'baq';
+opt[pc_bnq] := 'bnq';
+opt[pc_ngq] := 'ngq';
+opt[pc_adq] := 'adq';
+opt[pc_sbq] := 'sbq';
+opt[pc_mpq] := 'mpq';
+opt[pc_umq] := 'umq';
+opt[pc_dvq] := 'dvq';
+opt[pc_udq] := 'udq';
+opt[pc_mdq] := 'mdq';
+opt[pc_uqm] := 'uqm';
+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							}
 {								}
@@ -239,6 +259,8 @@ var
       cgUWord:  write('u');
       cgLong:   write('l');
       cgULong:  write('ul');
+      cgQuad:   write('q');
+      cgUQuad:  write('uq');
       cgReal:   write('r');
       cgDouble: write('d');
       cgComp:   write('c');
@@ -259,13 +281,16 @@ with code^ do
       pc_uml,pc_adr,pc_dvr,pc_mpr,pc_adi,pc_sbi,pc_mpi,pc_dvi,
       pc_umi,pc_shl,pc_nop,pc_and,pc_lnd,pc_bnd,pc_lor,pc_ior,pc_bxr,
       pc_bnt,pc_blx,pc_bnl,pc_ngi,pc_ngl,pc_ngr,pc_ixa,pc_mdl,
-      pc_udi,pc_udl: ;
+      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_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
@@ -331,6 +356,8 @@ with code^ do
                write(r:1);
             cgLong,cgULong:
                write(lval:1);
+            cgQuad,cgUQuad:
+               write('***');
             cgReal,cgDouble,cgComp,cgExtended:
                write('***');
             cgString: begin

CGI.pas

@@ -11,7 +11,7 @@
 {  passed on to the code generator for optimization and         }
 {  native code generation.                                      }
 {                                                               }
-{$copy 'cgi.comments'}
+{ copy 'cgi.comments'}
 {---------------------------------------------------------------}
 
 unit CodeGeneratorInterface;
@@ -33,26 +33,35 @@ 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?}
    constantOpnd           =     64;     {the absolute operand is a constant}
    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;
    m_adc_imm              =    $69;
    m_adc_s                =    $63;
+   m_adc_indl             =    $67;
+   m_adc_indly            =    $77;
    m_and_abs              =    $2D;
    m_and_dir              =    $25;
    m_and_imm              =    $29;
    m_and_s                =    $23;
+   m_and_indl             =    $27;
+   m_and_indly            =    $37;
    m_asl_a                =    $0A;
    m_bcc                  =    $90;
    m_bcs                  =    $B0;
@@ -63,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;
@@ -71,10 +81,13 @@ const
    m_cmp_imm              =    $C9;
    m_cmp_long             =    $CF;
    m_cmp_s                =    $C3;
+   m_cmp_indl             =    $C7;
+   m_cmp_indly            =    $D7;
    m_cop                  =    $02;
    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;
@@ -86,6 +99,8 @@ const
    m_eor_dir              =     69;
    m_eor_imm              =     73;
    m_eor_s                =     67;
+   m_eor_indl             =    $47;
+   m_eor_indly             =   $57;
    m_ina                  =     26;
    m_inc_abs              =    238;
    m_inc_absX             =    $FE;
@@ -94,6 +109,7 @@ const
    m_inx                  =    232;
    m_iny                  =    200;
    m_jml                  =     92;
+   m_jmp_indX             =    $7C;
    m_jsl                  =     34;
    m_lda_abs              =    173;
    m_lda_absx             =    189;
@@ -122,6 +138,8 @@ const
    m_ora_long             =     15;
    m_ora_longX            =     31;
    m_ora_s                =      3;
+   m_ora_indl             =    $07;
+   m_ora_indly            =    $17;
    m_pea                  =    244;
    m_pei_dir              =    212;
    m_pha                  =     72;
@@ -137,12 +155,16 @@ const
    m_ply                  =    122;
    m_plp                  =     40;
    m_rep                  =    194;
+   m_rol_a                =    $2A;
+   m_ror_a                =    $6A;
    m_rtl                  =    107;
    m_rts                  =     96;
    m_sbc_abs              =    237;
    m_sbc_dir              =    229;
    m_sbc_imm              =    233;
    m_sbc_s                =    227;
+   m_sbc_indl             =    $E7;
+   m_sbc_indly            =    $F7;
    m_sec                  =     56;
    m_sep                  =    226;
    m_sta_abs              =    141;
@@ -187,23 +209,29 @@ 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}
                                         {---------------}
    maxCBuff     =       191;            {length of constant buffer}
                                         {Note: maxlabel is also defined in CCommon.pas}
                                         {Note: maxlabel is also defined in CGC.asm}
-   maxLabel     =       3200;           {max # of internal labels}
-   maxLocalLabel =      220;            {max # local variables}
-   maxString    =       12500;          {max # chars in string space}
+   maxLabel     =       3275;           {max # of internal labels}
+   maxLocalLabel =      512;            {max # local variables}
+   maxString    =       32760;          {max # chars in string space}
 
                                         {size of internal types}
                                         {----------------------}
    cgByteSize           =       1;
    cgWordSize           =       2;
    cgLongSize           =       4;
+   cgQuadSize           =       8;
    cgPointerSize        =       4;
    cgRealSize           =       4;
    cgDoubleSize         =       8;
@@ -212,6 +240,7 @@ const
 
 type
   segNameType = packed array[1..10] of char; {segment name}
+  stringSpaceType = packed array[1..maxstring] of char; {string space}
 
                                         {p code}
                                         {------}
@@ -227,7 +256,10 @@ type
        pc_mdl,pc_sll,pc_slr,pc_bal,pc_ngl,pc_adl,pc_sbl,pc_blr,pc_blx,
        dc_sym,pc_lnd,pc_lor,pc_vsr,pc_uml,pc_udl,pc_ulm,pc_pop,pc_gil,
        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);
+       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_fix,pc_rev,pc_ckp,
+       pc_ckn);
 
                                         {intermediate code}
                                         {-----------------}
@@ -246,15 +278,23 @@ type
          cgUWord        : (opnd: longint; llab,slab: integer);
          cgLong,
          cgULong        : (lval: longint);
+         cgQuad,
+         cgUQuad        : (qval: longlong);
          cgReal,
          cgDouble,
          cgComp,
-         cgExtended     : (rval: double);
-         cgString       : (str: longStringPtr);
+         cgExtended     : (rval: extended);
+         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}
@@ -300,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}
@@ -307,9 +348,11 @@ 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?}
+   fastMath: boolean;                   {do FP math opts that break IEEE rules?}
    floatCard: integer;                  {0 -> SANE; 1 -> FPE}
    floatSlot: integer;                  {FPE slot}
    loopOptimizations: boolean;          {do loop optimizations?}
@@ -325,7 +368,7 @@ var
    stackSize: integer;                  {amount of stack space to reserve}
    strictVararg: boolean;               {repair stack around vararg calls?}
    stringsize: 0..maxstring;            {amount of string space left}
-   stringspace: packed array[1..maxstring] of char; {string table}
+   stringspace: ^stringSpaceType;       {string table}
    symLength: integer;                  {length of debug symbol table}
    toolParms: boolean;                  {generate tool format parameters?}
    volatile: boolean;			{has a volatile qualifier been used?}
@@ -544,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        }
@@ -553,7 +606,16 @@ procedure GenL1 (fop: pcodes; lval: longint; fp1: integer);
 {       fp1 - integer parameter                                 }
 
 
-procedure GenR1t (fop: pcodes; rval: double; fp1: integer; tp: baseTypeEnum);
+procedure GenQ1 (fop: pcodes; qval: longlong; fp1: integer);
+
+{ generate an instruction that uses a longlong and an int       }
+{                                                               }
+{ parameters:                                                   }
+{       qval - longlong parameter                               }
+{       fp1 - integer parameter                                 }
+
+
+procedure GenR1t (fop: pcodes; rval: extended; fp1: integer; tp: baseTypeEnum);
 
 { generate an instruction that uses a real and an int           }
 {                                                               }
@@ -571,7 +633,15 @@ procedure GenLdcLong (lval: longint);
 {       lval - value to load                                    }
 
 
-procedure GenLdcReal (rval: double);
+procedure GenLdcQuad (qval: longlong);
+
+{ load a long long constant                                     }
+{                                                               }
+{ parameters:                                                   }
+{       qval - value to load                                    }
+
+
+procedure GenLdcReal (rval: extended);
 
 { load a real constant                                          }
 {                                                               }
@@ -590,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				}
@@ -599,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			}
@@ -614,6 +721,15 @@ function TypeSize (tp: baseTypeEnum): integer;
 { Parameters:                                                   }
 {    code - intermediate code instruction to write              }
 
+
+procedure LimitPrecision (var rval: extended; tp: baseTypeEnum);
+
+{ limit the precision and range of a real value to the type.    }
+{                                                               }
+{ parameters:                                                   }
+{       rval - real value                                       }
+{       tp - type to limit precision to                         }
+
 {------------------------------------------------------------------------------}
 
 implementation
@@ -751,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}
@@ -769,14 +888,19 @@ 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}
 peepHole := cLineOptimize;              {not doing peephole optimization (yet)}
 npeepHole := cLineOptimize;
+fastMath := cLineOptimize;
 commonSubexpression := cLineOptimize;	{not doing common subexpression elimination}
 loopOptimizations := cLineOptimize;	{not doing loop optimizations, yet}
 
+{allocate string space}
+new(stringspace);
+
 {allocate the initial p-code}
 code := pointer(Calloc(sizeof(intermediate_code)));
 code^.optype := cgWord;
@@ -850,10 +974,11 @@ if codeGeneration then begin
          end;
 
       pc_cnn,pc_cnv:
-         if fp1 = fp2 then
+         if (fp1 = fp2)
+            and not (baseTypeEnum(fp2) in [cgReal,cgDouble,cgComp]) then
             goto 1
          else if (baseTypeEnum(fp1) in [cgReal,cgDouble,cgComp,cgExtended])
-            and (baseTypeEnum(fp2) in [cgReal,cgDouble,cgComp,cgExtended]) then
+            and (baseTypeEnum(fp2) = cgExtended) then
             goto 1
          else if (baseTypeEnum(fp1) in [cgUByte,cgWord,cgUWord])
             and (baseTypeEnum(fp2) in [cgWord,cgUWord]) then
@@ -1169,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        }
@@ -1191,7 +1340,29 @@ if codeGeneration then begin
 end; {GenL1}
 
 
-procedure GenR1t {fop: pcodes; rval: double; fp1: integer; tp: baseTypeEnum};
+procedure GenQ1 {fop: pcodes; qval: longlong; fp1: integer};
+
+{ generate an instruction that uses a longlong and an int       }
+{                                                               }
+{ parameters:                                                   }
+{       qval - longlong parameter                               }
+{       fp1 - integer parameter                                 }
+
+var
+   lcode: icptr;                        {local copy of code}
+
+begin {GenQ1}
+if codeGeneration then begin
+   lcode := code;
+   lcode^.optype := cgQuad;
+   lcode^.qval := qval;
+   lcode^.q := fp1;
+   Gen0(fop);
+   end; {if}
+end; {GenQ1}
+
+
+procedure GenR1t {fop: pcodes; rval: extended; fp1: integer; tp: baseTypeEnum};
 
 { generate an instruction that uses a real and an int           }
 {                                                               }
@@ -1234,6 +1405,26 @@ if codeGeneration then begin
 end; {GenLdcLong}
 
 
+procedure GenLdcQuad {qval: longlong};
+
+{ load a long long constant                                     }
+{                                                               }
+{ parameters:                                                   }
+{       qval - value to load                                    }
+
+var
+   lcode: icptr;                        {local copy of code}
+
+begin {GenLdcQuad}
+if codeGeneration then begin
+   lcode := code;
+   lcode^.optype := cgQuad;
+   lcode^.qval := qval;
+   Gen0(pc_ldc);
+   end; {if}
+end; {GenLdcQuad}
+
+
 procedure GenTool {fop: pcodes; fp1, fp2: integer; dispatcher: longint};
 
 { generate a tool call                                          }
@@ -1259,7 +1450,7 @@ if codeGeneration then begin
 end; {GenTool}
 
 
-procedure GenLdcReal {rval: double};
+procedure GenLdcReal {rval: extended};
 
 { load a real constant                                          }
 {                                                               }
@@ -1279,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			}
@@ -1291,6 +1550,7 @@ case tp of
    cgByte,cgUByte:   TypeSize := cgByteSize;
    cgWord,cgUWord:   TypeSize := cgWordSize;
    cgLong,cgULong:   TypeSize := cgLongSize;
+   cgQuad,cgUQuad:   TypeSize := cgQuadSize;
    cgReal:           TypeSize := cgRealSize;
    cgDouble:         TypeSize := cgDoubleSize;
    cgComp:           TypeSize := cgCompSize;
@@ -1300,4 +1560,41 @@ case tp of
    end; {case}
 end; {TypeSize}
 
+
+procedure LimitPrecision {rval: var extended; tp: baseTypeEnum};
+
+{ limit the precision and range of a real value to the type.    }
+{                                                               }
+{ parameters:                                                   }
+{       rval - real value                                       }
+{       tp - type to limit precision to                         }
+
+var
+   d: double;
+   s: real;
+   c: comp;
+
+begin {LimitPrecision}
+case tp of
+   cgReal:   begin
+             s := rval;
+             rval := s;
+             end;
+   cgDouble: begin
+             d := rval;
+             rval := d;
+             end;
+   cgComp:   if rval < 0.0 then begin
+                {work around SANE comp conversion bug}
+                c := -rval;
+                rval := -c;
+                end {if}
+             else begin
+                c := rval;
+                rval := c;
+                end; {else}
+   cgExtended: ;
+   end; {case}
+end; {LimitPrecision}
+
 end.

Charset.pas

@@ -28,6 +28,14 @@ const
 
 type
    ucsCodePoint = 0..maxUCSCodePoint;
+   utf8Rec = record
+      length: integer;
+      bytes: packed array [1..4] of byte;
+      end;
+   utf16Rec = record
+      length: integer;
+      codeUnits: packed array [1..2] of integer;
+      end;
 
 
 function ConvertMacRomanToUCS(ch: char): ucsCodePoint;
@@ -36,6 +44,7 @@ function ConvertMacRomanToUCS(ch: char): ucsCodePoint;
 {                                                                }
 { Returns UCS code point value for the character.                }
 
+
 function ConvertUCSToMacRoman(ch: ucsCodePoint): integer;
 
 { convert a character from UCS (Unicode) to MacRoman charset     }
@@ -43,6 +52,23 @@ function ConvertUCSToMacRoman(ch: ucsCodePoint): integer;
 { Returns ordinal value of the character, or -1 if it can't be   }
 { converted.                                                     }
 
+
+procedure UTF16Encode(ch: ucsCodePoint; var utf16: utf16Rec);
+
+{ Encode a UCS code point in UTF-16                              }
+{                                                                }
+{ ch - the code point                                            }
+{ utf16 - set to the UTF-16 representation of the code point     }
+
+
+procedure UTF8Encode(ch: ucsCodePoint; var utf8: utf8Rec);
+
+{ Encode a UCS code point in UTF-8                               }
+{                                                                }
+{ ch - the code point                                            }
+{ utf16 - set to the UTF-8 representation of the code point      }
+
+
 function ValidUCNForIdentifier(ch: ucsCodePoint; initial: boolean): boolean;
 
 { Check if a code point is valid for a UCN in an identifier      }
@@ -50,6 +76,8 @@ function ValidUCNForIdentifier(ch: ucsCodePoint; initial: boolean): boolean;
 { ch - the code point                                            }
 { initial - is this UCN the initial element of the identifier?   }
 
+{----------------------------------------------------------------}
+
 implementation
 
 function ConvertMacRomanToUCS{(ch: char): ucsCodePoint};
@@ -100,6 +128,60 @@ else begin
 end; {ConvertUCSToMacRoman}
 
 
+procedure UTF16Encode{ch: ucsCodePoint; var utf16: utf16Rec};
+
+{ Encode a UCS code point in UTF-16                              }
+{                                                                }
+{ ch - the code point                                            }
+{ utf16 - set to the UTF-16 representation of the code point     }
+
+begin {UTF16Encode}
+if ch <= $00ffff then begin
+   utf16.length := 1;
+   utf16.codeUnits[1] := ord(ch);
+   end {if}
+else begin
+   utf16.length := 2;
+   ch := ch - $010000;
+   utf16.codeUnits[1] := $D800 | ord(ch >> 10);
+   utf16.codeUnits[2] := $DC00 | ord(ch & $03ff);
+   end; {else}
+end; {UTF16Encode}
+
+
+procedure UTF8Encode{ch: ucsCodePoint; var utf8: utf8Rec};
+
+{ Encode a UCS code point in UTF-8                               }
+{                                                                }
+{ ch - the code point                                            }
+{ utf16 - set to the UTF-8 representation of the code point      }
+
+begin {UTF8Encode}
+if ch <= $00007f then begin
+   utf8.length := 1;
+   utf8.bytes[1] := ord(ch);
+   end {if}
+else if ch <= $0007ff then begin
+   utf8.length := 2;
+   utf8.bytes[1] := $C0 | ord(ch >> 6);
+   utf8.bytes[2] := $80 | ord(ch & $3f)
+   end {else if}
+else if ch <= $00ffff then begin
+   utf8.length := 3;
+   utf8.bytes[1] := $E0 | ord(ch >> 12);
+   utf8.bytes[2] := $80 | ord((ch >> 6) & $3f);
+   utf8.bytes[3] := $80 | ord(ch & $3f);
+   end {else if}
+else begin
+   utf8.length := 4;
+   utf8.bytes[1] := $F0 | ord(ch >> 18);
+   utf8.bytes[2] := $80 | ord((ch >> 12) & $3f);
+   utf8.bytes[3] := $80 | ord((ch >> 6) & $3f);
+   utf8.bytes[4] := $80 | ord(ch & $3f);
+   end; {else}
+end; {UTF8Encode}
+
+
 function ValidUCNForIdentifier{(ch: ucsCodePoint; initial: boolean): boolean};
 
 { Check if a code point is valid for a UCN in an identifier      }

Debugger.md

@@ -105,14 +105,14 @@ The following table shows the format used to store the variable’s current valu
     7       Pascal-style string
     8       character
     9       boolean
-    10      SANE COMP number
+    10      SANE COMP number or 8-byte integer
     11      pointer
     12      structure, union or record
     13      derived type
     14      object
 
 
-One-byte integers default to unsigned, while two-byte and four-byte integers default to signed format.  `OR`ing the format code with `$40` reverses this default, giving signed one-byte integers or unsigned four-byte integers.  (The signed flag is not supported by PRIZM 1.1.3.)
+One-byte integers default to unsigned, while two-byte, four-byte, and eight-byte integers default to signed format.  `OR`ing the format code with `$40` reverses this default, giving signed one-byte integers or unsigned four-byte integers.  (The signed flag is not supported by PRIZM 1.1.3.)
 
 A pointer to a scalar type (1-10) is indicated by `OR`ing the value’s format code with `$80`. For example, `$82` would be a pointer to a 4-byte integer.
 

Exp.macros

@@ -162,3 +162,107 @@
  LONGI OFF
 .I
  MEND
+ macro
+&l ph8 &n1
+ lclc &c
+&l anop
+&c amid &n1,1,1
+ aif s:longa=1,.a
+ rep #%00100000
+.a
+ aif "&c"="#",.d
+ aif "&c"="[",.b
+ aif "&c"<>"{",.c
+&c amid &n1,l:&n1,1
+ aif "&c"<>"}",.g
+&n1 amid &n1,2,l:&n1-2
+&n1 setc (&n1)
+.b
+ ldy #6
+~&SYSCNT lda &n1,y
+ pha
+ dey
+ dey
+ bpl ~&SYSCNT
+ ago .e
+.c
+ ldx #6
+~&SYSCNT lda &n1,x
+ pha
+ dex
+ dex
+ bpl ~&SYSCNT
+ ago .e
+.d
+&n1 amid &n1,2,l:&n1-1
+ bra ~b&SYSCNT
+~a&SYSCNT dc i8"&n1"
+~b&SYSCNT ldx #6
+~c&SYSCNT lda ~a&SYSCNT,x
+ pha
+ dex
+ dex
+ bpl ~c&SYSCNT
+.e
+ aif s:longa=1,.f
+ sep #%00100000
+.f
+ mexit
+.g
+ mnote "Missing closing '}'",16
+ mend
+ macro
+&l pl8 &n1
+ lclc &c
+&l anop
+ aif s:longa=1,.a
+ rep #%00100000
+.a
+&c amid &n1,1,1
+ aif "&c"<>"{",.b
+&c amid &n1,l:&n1,1
+ aif "&c"<>"}",.f
+&n1 amid &n1,2,l:&n1-2
+ pla
+ sta (&n1)
+ ldy #2
+ pla
+ sta (&n1),y
+ ldy #4
+ pla
+ sta (&n1),y
+ ldy #6
+ pla
+ sta (&n1),y
+ ago .d
+.b
+ aif "&c"<>"[",.c
+ pla
+ sta &n1
+ ldy #2
+ pla
+ sta &n1,y
+ ldy #4
+ pla
+ sta &n1,y
+ ldy #6
+ pla
+ sta &n1,y
+ ago .d
+.c
+ pla
+ sta &n1
+ pla
+ sta &n1+2
+ pla
+ sta &n1+4
+ pla
+ sta &n1+6
+.d
+ aif s:longa=1,.e
+ sep #%00100000
+.e
+ mexit
+.f
+ mnote "Missing closing '}'",16
+ mend

Expression.asm

@@ -382,3 +382,559 @@ ml6      ror   a                        shift the answer
 ;
 ml7      return 4:ans                   fix the stack
          end
+
+****************************************************************
+*
+*  procedure umul64 (var x: longlong; y: longlong);
+*
+*  Inputs:
+*        x,y - operands
+*
+*  Outputs:
+*        x - result
+*
+****************************************************************
+*
+umul64   start exp
+
+         subroutine (4:x,4:y),0
+
+         ph8   [x]
+         ph8   [y]
+         jsl   ~UMUL8
+         pl8   [x]
+         
+         return
+         end
+
+****************************************************************
+*
+*  procedure udiv64 (var x: longlong; y: longlong);
+*
+*  Inputs:
+*        x,y - operands
+*
+*  Outputs:
+*        x - result
+*
+****************************************************************
+*
+udiv64   start exp
+
+         subroutine (4:x,4:y),0
+
+         ph8   [x]
+         ph8   [y]
+         jsl   ~UDIV8
+         pl8   [x]
+         pla
+         pla
+         pla
+         pla
+         
+         return
+         end
+
+****************************************************************
+*
+*  procedure div64 (var x: longlong; y: longlong);
+*
+*  Inputs:
+*        x,y - operands
+*
+*  Outputs:
+*        x - result
+*
+****************************************************************
+*
+div64    start exp
+
+         subroutine (4:x,4:y),0
+
+         ph8   [x]
+         ph8   [y]
+         jsl   ~CDIV8
+         pl8   [x]
+         pla
+         pla
+         pla
+         pla
+         
+         return
+         end
+
+****************************************************************
+*
+*  procedure umod64 (var x: longlong; y: longlong);
+*
+*  Inputs:
+*        x,y - operands
+*
+*  Outputs:
+*        x - result
+*
+****************************************************************
+*
+umod64   start exp
+
+         subroutine (4:x,4:y),0
+
+         ph8   [x]
+         ph8   [y]
+         jsl   ~UDIV8
+         pla
+         pla
+         pla
+         pla
+         pl8   [x]
+         
+         return
+         end
+
+****************************************************************
+*
+*  procedure rem64 (var x: longlong; y: longlong);
+*
+*  Inputs:
+*        x,y - operands
+*
+*  Outputs:
+*        x - result
+*
+****************************************************************
+*
+rem64    start exp
+
+         subroutine (4:x,4:y),0
+
+         ph8   [x]
+         ph8   [y]
+         jsl   ~CDIV8
+         pla
+         pla
+         pla
+         pla
+         pl8   [x]
+         
+         return
+         end
+
+****************************************************************
+*
+*  procedure add64 (var x: longlong; y: longlong);
+*
+*  Inputs:
+*        x,y - operands
+*
+*  Outputs:
+*        x - result
+*
+****************************************************************
+*
+add64    start exp
+
+         subroutine (4:x,4:y),0
+
+         ph8   [x]
+         ph8   [y]
+         jsl   ~ADD8
+         pl8   [x]
+         
+         return
+         end
+
+****************************************************************
+*
+*  procedure sub64 (var x: longlong; y: longlong);
+*
+*  Inputs:
+*        x,y - operands
+*
+*  Outputs:
+*        x - result
+*
+****************************************************************
+*
+sub64    start exp
+
+         subroutine (4:x,4:y),0
+
+         ph8   [x]
+         ph8   [y]
+         jsl   ~SUB8
+         pl8   [x]
+         
+         return
+         end
+
+****************************************************************
+*
+*  procedure shl64 (var x: longlong; y: integer);
+*
+*  Inputs:
+*        x,y - operands
+*
+*  Outputs:
+*        x - result
+*
+****************************************************************
+*
+shl64    start exp
+
+         subroutine (4:x,2:y),0
+
+         ph8   [x]
+         lda   y
+         jsl   ~SHL8
+         pl8   [x]
+         
+         return
+         end
+
+****************************************************************
+*
+*  procedure ashr64 (var x: longlong; y: integer);
+*
+*  Inputs:
+*        x,y - operands
+*
+*  Outputs:
+*        x - result
+*
+****************************************************************
+*
+ashr64   start exp
+
+         subroutine (4:x,2:y),0
+
+         ph8   [x]
+         lda   y
+         jsl   ~ASHR8
+         pl8   [x]
+         
+         return
+         end
+
+****************************************************************
+*
+*  procedure lshr64 (var x: longlong; y: integer);
+*
+*  Inputs:
+*        x,y - operands
+*
+*  Outputs:
+*        x - result
+*
+****************************************************************
+*
+lshr64   start exp
+
+         subroutine (4:x,2:y),0
+
+         ph8   [x]
+         lda   y
+         jsl   ~LSHR8
+         pl8   [x]
+         
+         return
+         end
+
+****************************************************************
+*
+*  function ult64(a,b: longlong): integer;
+*
+****************************************************************
+*
+ult64    start exp
+result   equ   0
+
+         subroutine (4:a,4:b),2
+
+         stz   result
+         ldy   #6
+         lda   [a],y
+         cmp   [b],y
+         bne   lb1
+         dey
+         dey
+         lda   [a],y
+         cmp   [b],y
+         bne   lb1
+         dey
+         dey
+         lda   [a],y
+         cmp   [b],y
+         bne   lb1
+         lda   [a]
+         cmp   [b]
+lb1      bge   lb2
+         inc   result
+
+lb2      return 2:result
+         end
+
+****************************************************************
+*
+*  function uge64(a,b: longlong): integer;
+*
+****************************************************************
+*
+uge64    start exp
+result   equ   0
+
+         subroutine (4:a,4:b),2
+
+         stz   result
+         ldy   #6
+         lda   [a],y
+         cmp   [b],y
+         bne   lb1
+         dey
+         dey
+         lda   [a],y
+         cmp   [b],y
+         bne   lb1
+         dey
+         dey
+         lda   [a],y
+         cmp   [b],y
+         bne   lb1
+         lda   [a]
+         cmp   [b]
+lb1      blt   lb2
+         inc   result
+
+lb2      return 2:result
+         end
+
+****************************************************************
+*
+*  function ule64(a,b: longlong): integer;
+*
+****************************************************************
+*
+ule64    start exp
+result   equ   0
+
+         subroutine (4:a,4:b),2
+
+         stz   result
+         ldy   #6
+         lda   [a],y
+         cmp   [b],y
+         bne   lb1
+         dey
+         dey
+         lda   [a],y
+         cmp   [b],y
+         bne   lb1
+         dey
+         dey
+         lda   [a],y
+         cmp   [b],y
+         bne   lb1
+         lda   [a]
+         cmp   [b]
+lb1      bgt   lb2
+         inc   result
+
+lb2      return 2:result
+         end
+
+****************************************************************
+*
+*  function ugt64(a,b: longlong): integer;
+*
+****************************************************************
+*
+ugt64    start exp
+result   equ   0
+
+         subroutine (4:a,4:b),2
+
+         stz   result
+         ldy   #6
+         lda   [a],y
+         cmp   [b],y
+         bne   lb1
+         dey
+         dey
+         lda   [a],y
+         cmp   [b],y
+         bne   lb1
+         dey
+         dey
+         lda   [a],y
+         cmp   [b],y
+         bne   lb1
+         lda   [a]
+         cmp   [b]
+lb1      ble   lb2
+         inc   result
+
+lb2      return 2:result
+         end
+
+****************************************************************
+*
+*  function slt64(a,b: longlong): integer;
+*
+****************************************************************
+*
+slt64    start exp
+result   equ   0
+
+         subroutine (4:a,4:b),2
+
+         stz   result
+         ldy   #6
+         lda   [a],y
+         eor   [b],y
+         bpl   lb0
+         lda   [b],y
+         cmp   [a],y
+         bra   lb1
+
+lb0      lda   [a],y
+         cmp   [b],y
+         bne   lb1
+         dey
+         dey
+         lda   [a],y
+         cmp   [b],y
+         bne   lb1
+         dey
+         dey
+         lda   [a],y
+         cmp   [b],y
+         bne   lb1
+         lda   [a]
+         cmp   [b]
+lb1      bge   lb2
+         inc   result
+
+lb2      return 2:result
+         end
+
+****************************************************************
+*
+*  function sge64(a,b: longlong): integer;
+*
+****************************************************************
+*
+sge64    start exp
+result   equ   0
+
+         subroutine (4:a,4:b),2
+
+         stz   result
+         ldy   #6
+         lda   [a],y
+         eor   [b],y
+         bpl   lb0
+         lda   [b],y
+         cmp   [a],y
+         bra   lb1
+
+lb0      lda   [a],y
+         cmp   [b],y
+         bne   lb1
+         dey
+         dey
+         lda   [a],y
+         cmp   [b],y
+         bne   lb1
+         dey
+         dey
+         lda   [a],y
+         cmp   [b],y
+         bne   lb1
+         lda   [a]
+         cmp   [b]
+lb1      blt   lb2
+         inc   result
+
+lb2      return 2:result
+         end
+
+****************************************************************
+*
+*  function sle64(a,b: longlong): integer;
+*
+****************************************************************
+*
+sle64    start exp
+result   equ   0
+
+         subroutine (4:a,4:b),2
+
+         stz   result
+         ldy   #6
+         lda   [a],y
+         eor   [b],y
+         bpl   lb0
+         lda   [b],y
+         cmp   [a],y
+         bra   lb1
+
+lb0      lda   [a],y
+         cmp   [b],y
+         bne   lb1
+         dey
+         dey
+         lda   [a],y
+         cmp   [b],y
+         bne   lb1
+         dey
+         dey
+         lda   [a],y
+         cmp   [b],y
+         bne   lb1
+         lda   [a]
+         cmp   [b]
+lb1      bgt   lb2
+         inc   result
+
+lb2      return 2:result
+         end
+
+****************************************************************
+*
+*  function sgt64(a,b: longlong): integer;
+*
+****************************************************************
+*
+sgt64    start exp
+result   equ   0
+
+         subroutine (4:a,4:b),2
+
+         stz   result
+         ldy   #6
+         lda   [a],y
+         eor   [b],y
+         bpl   lb0
+         lda   [b],y
+         cmp   [a],y
+         bra   lb1
+
+lb0      lda   [a],y
+         cmp   [b],y
+         bne   lb1
+         dey
+         dey
+         lda   [a],y
+         cmp   [b],y
+         bne   lb1
+         dey
+         dey
+         lda   [a],y
+         cmp   [b],y
+         bne   lb1
+         lda   [a]
+         cmp   [b]
+lb1      ble   lb2
+         inc   result
+
+lb2      return 2:result
+         end

Header.pas

@@ -15,10 +15,10 @@ interface
 
 uses CCommon, MM, Scanner, Symbol, CGI;
 
-{$segment 'SCANNER'}
+{$segment 'HEADER'}
 
 const
-   symFileVersion = 7;                  {version number of .sym file format}
+   symFileVersion = 44;                 {version number of .sym file format}
 
 var
    inhibitHeader: boolean;		{should .sym includes be blocked?}
@@ -280,19 +280,19 @@ if numErrors <> 0 then
 end; {CloseSymbols}
 
 
-function ReadDouble: double;
+function ReadExtended: extended;
 
-{ Read a double precision real from the symbol file		}
+{ Read an extended precision real from the symbol file		}
 {								}
 { Returns: value read						}
 
 type
-   doubleptr = ^double;
+   extendedptr = ^extended;
 
-begin {ReadDouble}
-ReadDouble := doubleptr(symPtr)^;
-symPtr := pointer(ord4(symPtr)+8);
-end; {ReadDouble}
+begin {ReadExtended}
+ReadExtended := extendedptr(symPtr)^;
+symPtr := pointer(ord4(symPtr)+10);
+end; {ReadExtended}
 
 
 function ReadLong: longint;
@@ -400,24 +400,24 @@ symPtr := pointer(ord4(symPtr) + len);
 end; {ReadChars}
 
 
-procedure WriteDouble (d: double);
+procedure WriteExtended (e: extended);
 
-{ Write a double constant to the symbol file			}
+{ Write an extended constant to the symbol file			}
 {								}
 { parameters:							}
-{    d - constant to write					}
+{    e - constant to write					}
 
 var
-   dPtr: ^double;			{work pointer}
+   ePtr: ^extended;			{work pointer}
 
-begin {WriteDouble}
-if bufLen < 8 then
+begin {WriteExtended}
+if bufLen < 10 then
    Purge;
-dPtr := pointer(bufPtr);
-dPtr^ := d;
-bufPtr := pointer(ord4(bufPtr) + 8);
-bufLen := bufLen - 8;
-end; {WriteDouble}
+ePtr := pointer(bufPtr);
+ePtr^ := e;
+bufPtr := pointer(ord4(bufPtr) + 10);
+bufLen := bufLen - 10;
+end; {WriteExtended}
 
 
 procedure WriteLong (i: longint);
@@ -711,11 +711,18 @@ procedure EndInclude {chPtr: ptr};
 	    identifier:		WriteString(token.name);
 	    intConstant:	WriteWord(token.ival);
 	    longConstant:	WriteLong(token.lval);
-	    doubleConstant:	WriteDouble(token.rval);
+	    longlongConstant:	begin
+                		WriteLong(token.qval.lo);
+                		WriteLong(token.qval.hi);
+                		end;
+	    realConstant:	WriteExtended(token.rval);
 	    stringConstant:	begin
 				WriteLongString(token.sval);
                 		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 
@@ -739,7 +746,6 @@ procedure EndInclude {chPtr: ptr};
                tp := mp^.tokens;	{loop over token list}
                while tp <> nil do begin
 		  WriteByte(1);		{write tokenListRecord}
-        	  WriteLongString(tp^.tokenString);
         	  WriteToken(tp^.token);
         	  WriteByte(ord(tp^.expandEnabled));
         	  WriteChars(tp^.tokenStart, tp^.tokenEnd);
@@ -793,10 +799,10 @@ procedure EndInclude {chPtr: ptr};
                      WriteWord(floatSlot);
                      end;
 
-                  p_keep: WriteLongString(@outFileGS.theString);
+                  p_keep: WriteLongString(@pragmaKeepFile^.theString);
 
                   p_line: begin
-                     WriteWord(lineNumber);
+                     WriteLong(lineNumber);
                      WriteLongString(@sourceFileGS.theString);
                      end;
 
@@ -822,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
@@ -840,7 +847,8 @@ procedure EndInclude {chPtr: ptr};
                         | (ord(saveStack) << 3)
                         | (ord(commonSubexpression) << 4)
                         | (ord(loopOptimizations) << 5)
-                        | (ord(strictVararg) << 6));
+                        | (ord(strictVararg) << 6)
+                        | (ord(fastMath) << 7));
 
                   p_stacksize: WriteWord(stackSize);
 
@@ -872,7 +880,8 @@ procedure EndInclude {chPtr: ptr};
                         | (ord(allowLongIntChar) << 1)
                         | (ord(allowTokensAfterEndif) << 2)
                         | (ord(allowSlashSlashComments) << 3)
-                        | (ord(allowMixedDeclarations) << 4));
+                        | (ord(allowMixedDeclarations) << 4)
+                        | (ord(looseTypeChecks) << 5));
 
                   p_segment: begin
                      for i := 1 to 10 do begin
@@ -880,9 +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)
+                        | (ord(extendedParameters) << 1));
 
                   end; {case}
                end; {if}
@@ -969,19 +985,19 @@ procedure EndInclude {chPtr: ptr};
 
 
             begin {WriteType}
-            if tp = bytePtr then
+            if tp = sCharPtr then
                WriteByte(2)
-            else if tp = uBytePtr then
+            else if tp = charPtr then
                WriteByte(3)
-            else if tp = wordPtr then
+            else if tp = intPtr then
                WriteByte(4)
-            else if tp = uWordPtr then
+            else if tp = uIntPtr then
                WriteByte(5)
             else if tp = longPtr then
                WriteByte(6)
             else if tp = uLongPtr then
                WriteByte(7)
-            else if tp = realPtr then
+            else if tp = floatPtr then
                WriteByte(8)
             else if tp = doublePtr then
                WriteByte(9)
@@ -995,6 +1011,16 @@ procedure EndInclude {chPtr: ptr};
                WriteByte(13)
             else if tp = defaultStruct then
                WriteByte(14)
+            else if tp = uCharPtr then
+               WriteByte(15)
+            else if tp = shortPtr then
+               WriteByte(16)
+            else if tp = uShortPtr then
+               WriteByte(17)
+            else if tp = utf16StringTypePtr then
+               WriteByte(18)
+            else if tp = utf32StringTypePtr then
+               WriteByte(19)
             else if tp^.saveDisp <> 0 then begin
                WriteByte(1);
                WriteLong(tp^.saveDisp);
@@ -1003,11 +1029,15 @@ procedure EndInclude {chPtr: ptr};
                WriteByte(0);
                tp^.saveDisp := GetMark;
                WriteLong(tp^.size);
-               WriteByte(ord(tp^.isConstant));
+               WriteByte(ord(tqConst in tp^.qualifiers)
+                  | (ord(tqVolatile in tp^.qualifiers) << 1)
+                  | (ord(tqRestrict in tp^.qualifiers) << 2));
                WriteByte(ord(tp^.kind));
                case tp^.kind of
-        	  scalarType:
+        	  scalarType: begin
         	     WriteByte(ord(tp^.baseType));
+        	     WriteByte(ord(tp^.cType));
+        	     end;
 
         	  arrayType: begin
         	     WriteLong(tp^.elements);
@@ -1040,6 +1070,8 @@ procedure EndInclude {chPtr: ptr};
                 	ip := ip^.next;
                 	end; {while}
         	     WriteByte(0);
+        	     WriteByte(ord(tp^.constMember));
+        	     WriteByte(ord(tp^.flexibleArrayMember));
         	     end;
 
 		  otherwise: ;
@@ -1076,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}
          
 
@@ -1170,6 +1205,8 @@ type
 var
    done: boolean;			{for loop termination test}
    typeDispList: typeDispPtr;		{type displacement/pointer table}
+   includesPtr: ptr;			{ptr to includes section from sym file}
+   i: 1..maxint;			{loop/index variable}
 
 
    procedure DisposeTypeDispList;
@@ -1228,6 +1265,7 @@ var
          symRefnum := opRec.refnum;
          OpenSymbols := true;
          WriteWord(symFileVersion);
+         WriteLongString(pointer(@infoStringGS.theString));
          tokenMark := GetMark;
          includeMark := false;
          end; {if}
@@ -1280,17 +1318,39 @@ var
          match := false;
          len := 0;
          end; {else}
-      if match and progress then begin
-	 write('Including ');
-	 for i := 1 to giRec.pathname^.size do
-            write(giRec.pathname^.theString[i]);
-	 writeln;
-	 end; {if}
       end; {while}
    DatesMatch := match;
    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				}
@@ -1322,11 +1382,18 @@ var
 	 identifier:		token.name := ReadString;
 	 intConstant:		token.ival := ReadWord;
 	 longConstant:		token.lval := ReadLong;
-	 doubleConstant:	token.rval := ReadDouble;
+	 longlongConstant:	begin
+			        token.qval.lo := ReadLong;
+                	        token.qval.hi := ReadLong;
+                	        end;
+	 realConstant:		token.rval := ReadExtended;
 	 stringConstant:	begin
 			        token.sval := ReadLongString;
                 	        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 
@@ -1359,7 +1426,6 @@ var
       while ReadByte <> 0 do begin
          tp := pointer(GMalloc(sizeof(tokenListRecord)));
          tp^.next := nil;
-         tp^.tokenString := ReadLongString;
          ReadToken(tp^.token);
          tp^.expandEnabled := boolean(ReadByte);
          ReadChars(tp^.tokenStart, tp^.tokenEnd);
@@ -1414,15 +1480,17 @@ var
             end;
 
          p_keep: begin
-            liDCBGS.kFlag := 1;
             lsPtr := ReadLongString;
-            outFileGS.theString.size := lsPtr^.length;
-            for i := 1 to outFileGS.theString.size do
-               outFileGS.theString.theString[i] := lsPtr^.str[i];
+            if liDCBGS.kFlag = 0 then begin
+               liDCBGS.kFlag := 1;
+               outFileGS.theString.size := lsPtr^.length;
+               for i := 1 to outFileGS.theString.size do
+                  outFileGS.theString.theString[i] := lsPtr^.str[i];
+               end; {if}
             end;
 
          p_line: begin
-            lineNumber := ReadWord;
+            lineNumber := ReadLong - 1;
             lsPtr := ReadLongString;
             sourceFileGS.theString.size := lsPtr^.length;
             for i := 1 to sourceFileGS.theString.size do
@@ -1458,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;
 
@@ -1479,6 +1548,7 @@ var
             commonSubexpression := odd(val >> 4);
             loopOptimizations := odd(val >> 5);
             strictVararg := odd(val >> 6);
+            fastMath := odd(val >> 7);
             end;
 
          p_stacksize: stackSize := ReadWord;
@@ -1516,6 +1586,7 @@ var
             allowSlashSlashComments := odd(i >> 3);
             allowMixedDeclarations := odd(i >> 4);
             c99Scope := allowMixedDeclarations;
+            looseTypeChecks := odd(i >> 5);
             end;
          
          p_segment: begin
@@ -1524,10 +1595,24 @@ 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: begin
+            i := ReadByte;
+            extendedKeywords := odd(i);
+            extendedParameters := odd(i >> 1);
+            end;
 
+         otherwise: begin
+            PurgeSymbols;
+            DestroySymbolFile;
+            TermError(12);
+            end;
          end; {case}
       end; {while}
    symPtr := pePtr;
@@ -1609,11 +1694,23 @@ var
                tdisp^.tPtr := tp;
 	       tp^.size := ReadLong;
                tp^.saveDisp := 0;
-	       tp^.isConstant := boolean(ReadByte);
+	       val := ReadByte;
+	       if odd(val) then
+	          tp^.qualifiers := [tqConst]
+	       else
+	          tp^.qualifiers := [];
+	       if odd(val >> 1) then begin
+	          tp^.qualifiers := tp^.qualifiers + [tqVolatile];
+	          volatile := true;
+	          end; {if}
+	       if odd(val >> 2) then
+	          tp^.qualifiers := tp^.qualifiers + [tqRestrict];
 	       tp^.kind := typeKind(ReadByte);
 	       case tp^.kind of
-        	  scalarType:
+        	  scalarType: begin
         	     tp^.baseType := baseTypeEnum(ReadByte);
+        	     tp^.cType := cTypeEnum(ReadByte);
+        	     end;
 
         	  arrayType: begin
         	     tp^.elements := ReadLong;
@@ -1651,10 +1748,18 @@ var
                 	   ep^.next := ip;
         		ep := ip;
         		end; {while}
+        	     tp^.constMember := boolean(ReadByte);
+        	     tp^.flexibleArrayMember := boolean(ReadByte);
+        	     end;
+
+        	  enumType: ;
+
+        	  otherwise: begin
+        	     PurgeSymbols;
+        	     DestroySymbolFile;
+        	     TermError(12);
         	     end;
 
-		  otherwise: ;
-         
         	  end; {case}
                end; {case 0}
 
@@ -1676,19 +1781,30 @@ var
                   end; {if}
                end; {case 1}
 
-            2: tp := bytePtr;
-            3: tp := uBytePtr;
-            4: tp := wordPtr;
-            5: tp := uWordPtr;
+            2: tp := sCharPtr;
+            3: tp := charPtr;
+            4: tp := intPtr;
+            5: tp := uIntPtr;
             6: tp := longPtr;
             7: tp := uLongPtr;
-            8: tp := realPtr;
+            8: tp := floatPtr;
             9: tp := doublePtr;
             10: tp := extendedPtr;
             11: tp := stringTypePtr;
             12: tp := voidPtr;
             13: tp := voidPtrPtr;
             14: tp := defaultStruct;
+            15: tp := uCharPtr;
+            16: tp := shortPtr;
+            17: tp := uShortPtr;
+            18: tp := utf16StringTypePtr;
+            19: tp := utf32StringTypePtr;
+
+            otherwise: begin
+               PurgeSymbols;
+               DestroySymbolFile;
+               TermError(12);
+               end;
             end; {case}
 	 end; {ReadType}
 
@@ -1725,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}
 
@@ -1804,15 +1925,31 @@ var
    end; {OpenSymbolFile}
 
 
-   function SymbolVersion: integer;
+   function SymbolFileIsUsable: boolean;
 
-   { Read the symbol file version number			}
+   { Read the symbol file header to check if it is usable	}
    {								}
-   { Returns: version number					}
+   { Returns: True if the symbol file is usable, false if not	}
 
-   begin {SymbolVersion}
-   SymbolVersion := ReadWord;
-   end; {SymbolVersion}
+   label 1;
+
+   var
+      ccPtr: longStringPtr;             {cc= string recorded in symbol file}
+      i: integer;                       {loop counter}
+
+   begin {SymbolFileIsUsable}
+   SymbolFileIsUsable := false;
+   if ReadWord = symFileVersion then begin
+      ccPtr := ReadLongString;
+      if ccPtr^.length = infoStringGS.theString.size then begin
+         for i := 1 to infoStringGS.theString.size do
+            if ccPtr^.str[i] <> infoStringGS.theString.theString[i] then
+               goto 1;
+         SymbolFileIsUsable := true;
+         end; {if}
+      end; {if}
+1:
+   end; {SymbolFileIsUsable}
 
 
    function SourceMatches: boolean;
@@ -1866,14 +2003,17 @@ if not ignoreSymbols then begin
    includeLevel := 0;			{no nested includes}
    symChPtr := chPtr;			{record initial source location}
    if OpenSymbolFile(fName) then begin	{check for symbol file}
-      if SymbolVersion = symFileVersion then begin
+      if SymbolFileIsUsable then begin
 	 done := EndOfSymbols;		{valid file found - process it}
 	 if done then
             PurgeSymbols;
 	 typeDispList := nil;
 	 while not done do begin
+            includesPtr := symPtr;
             if DatesMatch then begin
                if SourceMatches then begin
+                  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.                         }
@@ -168,8 +178,11 @@ var
 
 begin {GMalloc}
 if bytes > globalSize then begin        {allocate a new pool, if needed}
-   globalSize := poolSize;
-   myhandle := NewHandle(poolSize, globalID, $C010, nil);
+   if bytes > poolSize then
+      globalSize := bytes
+   else
+      globalSize := poolSize;
+   myhandle := NewHandle(globalSize, globalID, $C010, nil);
    if ToolError <> 0 then TermError(5);
    globalPtr := myhandle^;
    end; {if}
@@ -179,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                                       }
@@ -209,8 +240,11 @@ var
 
 begin {LMalloc}
 if bytes > localSize then begin         {allocate a new pool, if needed}
-   localSize := poolSize;
-   myhandle := NewHandle(poolSize, localID, $C010, nil);
+   if bytes > poolSize then
+      localSize := bytes
+   else
+      localSize := poolSize;
+   myhandle := NewHandle(localSize, localID, $C010, nil);
    if ToolError <> 0 then TermError(5);
    localPtr := myhandle^;
    end; {if}
@@ -227,6 +261,8 @@ procedure MMQuit;
 begin {MMQuit}
 DisposeAll(globalID);
 DisposeAll(localID);
+globalID := 0;                          {do not use old IDs after restart}
+localID := 0;
 end; {MMQuit}
 
 end.

Native.asm

@@ -50,7 +50,8 @@ rtl      dec   nNextSpot                nnextspot := nnextspot-1;
 *
 ****************************************************************
 *
-Short    start
+Short    start CodeGen
+         using ShortData
 elSize   equ   12                       size of npeep array element
 peep_opcode equ 0                       disp in nativeType of opcode
 peep_mode equ  2                        disp in nativeType of mode
@@ -86,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
@@ -122,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
@@ -138,7 +141,9 @@ lb5      anop                                 end;
 lb6      stz   fn                         Short := false;
 lab1     anop                           1:end; {Short}
          return 2:fn
-
+         end
+         
+ShortData privdata
 fn       ds    2                        function return value
 
 size     dc    i1'2,2,2,2,2,2,2,2,1,3,1,1,3,3,3,4'
@@ -159,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

@@ -86,6 +86,14 @@ procedure GenImplied (p_opcode: integer);
 {       p_code - operation code                                 }
 
 
+procedure GenImpliedForFlags (p_opcode: integer);
+
+{ Generate implied addressing instruction used for flags only.  }
+{                                                               }
+{ parameters:                                                   }
+{       p_code - operation code (m_tax or m_tay)                }
+
+
 procedure GenCall (callNum: integer);
 
 { short form of jsl to library subroutine - reduces code size   }
@@ -102,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					}
@@ -180,11 +196,15 @@ type
       end;
 
 var
-                                        {native peephole optimization}
-                                        {----------------------------}
+                                        {register optimization}
+                                        {---------------------}
    aRegister,                           {current register contents}
       xRegister,
       yRegister: registerType;
+   lastRegOpcode: integer;              {opcode of last reg/flag-setting instr.}
+   
+                                        {native peephole optimization}
+                                        {----------------------------}
    nleadOpcodes: set of 0..max_opcode;  {instructions that can start an opt.}
    nstopOpcodes: set of 0..max_opcode;  {instructions not involved in opt.}
    nnextspot: npeepRange;               {next empty spot in npeep}
@@ -281,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}
@@ -300,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
@@ -322,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;
@@ -346,16 +365,19 @@ procedure WriteNative (opcode: integer; mode: addressingMode; operand: integer;
 label 1;
 
 type
-   rkind = (k1,k2,k3);                  {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}
       case rkind of
          k1: (rval: real;);
          k2: (dval: double;);
-         k3: (ival1,ival2,ival3,ival4: integer;);
+         k3: (qval: longlong);
+         k4: (eval: extended);
+         k5: (ival1,ival2,ival3,ival4,ival5: integer;);
       end;
    count: integer;                      {number of constants to repeat}
    i,j,k: integer;                      {loop variables}
@@ -381,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
@@ -413,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
@@ -445,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}
@@ -461,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
@@ -474,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
@@ -492,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}
@@ -511,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}
@@ -522,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);
@@ -532,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)
@@ -551,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)
@@ -606,6 +649,13 @@ case mode of
                                   CnOut2(long(lval).lsw);
                                   CnOut2(long(lval).msw);
                                   end;
+            cgQuad,cgUQuad      : begin
+                                  cnv.qval := icptr(name)^.qval;
+                                  CnOut2(cnv.ival1);
+                                  CnOut2(cnv.ival2);
+                                  CnOut2(cnv.ival3);
+                                  CnOut2(cnv.ival4);
+                                  end;
             cgReal              : begin
                                   cnv.rval := icptr(name)^.rval;
                                   CnOut2(cnv.ival1);
@@ -625,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
@@ -666,12 +729,11 @@ case mode of
                                      GenImmediate2;
                                      sptr := icptr(name)^.pStr;
                                      j := sptr^.length;
-                                     if maxString-stringSize >= j+1 then begin
+                                     if maxString-stringSize >= j then begin
                                         for k := 1 to j do
-                                           stringSpace[k+stringSize] :=
+                                           stringSpace^[k+stringSize] :=
                                               sptr^.str[k];
-                                        stringSpace[stringSize+j+1] := chr(0);
-                                        stringSize := stringSize+j+1;
+                                        stringSize := stringSize+j;
                                         end {if}
                                      else
                                         Error(cge3);
@@ -682,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;
@@ -712,8 +774,10 @@ case mode of
             LabelSearch(operand, 2, 16, 0)
          else
             LabelSearch(operand, 1, 16, 0)
+      else if (flags & subtract1) <> 0 then
+         LabelSearch(operand, 0, ShiftSize(flags), 0)
       else
-         LabelSearch(operand, 0, 0, 0);
+         LabelSearch(operand, 2, 0, 0);
       end;
 
    special:
@@ -758,7 +822,25 @@ procedure CheckRegisters(p_opcode: integer; p_mode: addressingMode;
 {       p_name - named operand                                  }
 {       p_flags - operand modifier flags                        }
 
-label 1,2;
+label 1,2,3;
+
+   function NZMatchA: boolean;
+   
+   { Are the N and Z flags known to match the value in A?       }
+   {                                                            }
+   { Note: Assumes long registers                               }
+   
+   begin {NZMatchA}
+   NZMatchA := lastRegOpcode in
+      [m_adc_abs,m_adc_dir,m_adc_imm,m_adc_s,m_adc_indl,m_adc_indly,
+      m_and_abs,m_and_dir,m_and_imm,m_and_s,m_and_indl,m_and_indly,m_asl_a,
+      m_dea,m_eor_abs,m_eor_dir,m_eor_imm,m_eor_s,m_eor_indl,m_eor_indly,
+      m_ina,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_lsr_a,m_ora_abs,m_ora_dir,
+      m_ora_dirX,m_ora_imm,m_ora_long,m_ora_longX,m_ora_s,m_ora_indl,
+      m_ora_indly,m_pla,m_rol_a,m_ror_a,m_sbc_abs,m_sbc_dir,m_sbc_imm,m_sbc_s,
+      m_sbc_indl,m_sbc_indly,m_tax,m_tay,m_tcd,m_tdc,m_txa,m_tya];
+   end; {NZMatchA}
 
 begin {CheckRegisters}
 case p_opcode of
@@ -766,7 +848,9 @@ case p_opcode of
    m_and_s,m_asl_a,m_dea,m_eor_abs,m_eor_dir,m_eor_imm,m_eor_s,m_lda_absx,
    m_lda_dirx,m_lda_indl,m_lda_indly,m_lda_longx,m_lda_s,m_lsr_a,m_ora_abs,
    m_ora_dir,m_ora_dirX,m_ora_imm,m_ora_long,m_ora_longX,m_ora_s,m_pla,
-   m_sbc_abs,m_sbc_dir,m_sbc_imm,m_sbc_s,m_tdc,m_tsc:
+   m_sbc_abs,m_sbc_dir,m_sbc_imm,m_sbc_s,m_tdc,m_tsc,m_adc_indl,m_adc_indly,
+   m_and_indl,m_and_indly,m_ora_indl,m_ora_indly,m_sbc_indl,m_sbc_indly,
+   m_eor_indl,m_eor_indly,m_rol_a,m_ror_a:
       aRegister.condition := regUnknown;
 
    m_ldy_absX,m_ldy_dirX,m_ply:
@@ -775,10 +859,13 @@ case p_opcode of
    m_plx:
       xRegister.condition := regUnknown;
 
-   m_bcc,m_bcs,m_beq,m_bmi,m_bne,m_bpl,m_bra,m_brl,m_bvs,m_clc,m_cmp_abs,
-   m_cmp_dir,m_cmp_imm,m_cmp_s,m_cpx_imm,m_jml,m_pha,m_phb,m_phd,
-   m_phx,m_phy,m_plb,m_pld,m_rtl,m_rts,m_sec,m_tcs,m_tcd,d_add,d_pin,
-   m_pei_dir,m_cpx_abs,m_cpx_dir,m_cmp_dirx,m_php,m_plp,m_cop,d_wrd:   ;
+   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_cpy_imm,m_cmp_dirx,m_plp,m_cop,d_wrd:    ;
 
    m_pea: begin
       if aRegister.condition = regImmediate then
@@ -808,9 +895,20 @@ case p_opcode of
         	     goto 2;
         	     end; {if}
          end; {if}
+      goto 3;
       end;
 
    m_sta_s: begin
+      if aRegister.condition = regLocal then
+         aRegister.condition := regUnknown;
+      if xRegister.condition = regLocal then
+         xRegister.condition := regUnknown;
+      if yRegister.condition = regLocal then
+         yRegister.condition := regUnknown;
+      goto 3;
+      end;
+   
+   m_pld,m_tcd: begin
       if aRegister.condition = regLocal then
          aRegister.condition := regUnknown;
       if xRegister.condition = regLocal then
@@ -826,6 +924,7 @@ case p_opcode of
          xRegister.condition := regUnknown;
       if yRegister.condition <> regImmediate then
          yRegister.condition := regUnknown;
+      goto 3;
       end;
 
    m_sta_absX,m_stz_absX,m_sta_longX: begin
@@ -838,10 +937,25 @@ case p_opcode of
       if yRegister.condition = regAbsolute then
          if yRegister.lab = p_name then
             yRegister.condition := regUnknown;
+      goto 3;
       end;
 
-   m_dec_abs,m_inc_abs,m_sta_abs,m_stx_abs,m_sty_abs,m_sta_long,m_stz_abs,
-   m_tsb_abs: begin
+   m_dec_abs,m_inc_abs,m_tsb_abs: begin
+      if aRegister.condition = regAbsolute then
+         if aRegister.lab = p_name then
+            if aRegister.value = p_operand then
+               aRegister.condition := regUnknown;
+      if xRegister.condition = regAbsolute then
+         if xRegister.lab = p_name then
+            if xRegister.value = p_operand then
+               xRegister.condition := regUnknown;
+      if yRegister.condition = regAbsolute then
+         if yRegister.lab = p_name then
+            if yRegister.value = p_operand then
+               yRegister.condition := regUnknown;
+      end;
+   
+   m_sta_abs,m_stx_abs,m_sty_abs,m_sta_long,m_stz_abs: begin
       if aRegister.condition = regAbsolute then
          if aRegister.lab = p_name then
             if aRegister.value = p_operand then
@@ -857,9 +971,22 @@ case p_opcode of
             if yRegister.value = p_operand then
                if p_opcode <> m_sty_abs then
                   yRegister.condition := regUnknown;
+      goto 3;
       end;
 
-   m_dec_dir,m_inc_dir,m_tsb_dir,m_sta_dir,m_stx_dir,m_sty_dir,m_stz_dir: begin
+   m_dec_dir,m_inc_dir,m_tsb_dir: begin
+      if aRegister.condition = regLocal then
+         if aRegister.value = p_operand then
+            aRegister.condition := regUnknown;
+      if xRegister.condition = regLocal then
+         if xRegister.value = p_operand then
+            xRegister.condition := regUnknown;
+      if yRegister.condition = regLocal then
+         if yRegister.value = p_operand then
+            yRegister.condition := regUnknown;
+      end;
+   
+   m_sta_dir,m_stx_dir,m_sty_dir,m_stz_dir: begin
       if aRegister.condition = regLocal then
          if aRegister.value = p_operand then
             if p_opcode <> m_sta_dir then
@@ -872,9 +999,10 @@ case p_opcode of
          if yRegister.value = p_operand then
             if p_opcode <> m_sty_dir then
                yRegister.condition := regUnknown;
+      goto 3;
       end;
 
-   m_dec_dirX,m_inc_dirX,m_sta_dirX,m_sty_dirX,m_stz_dirX: begin
+   m_dec_dirX,m_inc_dirX: begin
       if aRegister.condition = regLocal then
          if aRegister.value >= p_operand-1 then
             aRegister.condition := regUnknown;
@@ -885,6 +1013,19 @@ case p_opcode of
          if yRegister.value >= p_operand-1 then
             yRegister.condition := regUnknown;
       end;
+   
+   m_sta_dirX,m_sty_dirX,m_stz_dirX: begin
+      if aRegister.condition = regLocal then
+         if aRegister.value >= p_operand-1 then
+            aRegister.condition := regUnknown;
+      if xRegister.condition = regLocal then
+         if xRegister.value >= p_operand-1 then
+            xRegister.condition := regUnknown;
+      if yRegister.condition = regLocal then
+         if yRegister.value >= p_operand-1 then
+            yRegister.condition := regUnknown;
+      goto 3;
+      end;
 
    m_dex:
       if xRegister.condition = regImmediate then
@@ -1221,7 +1362,13 @@ case p_opcode of
       end;
 
    m_tax: begin
-      if aRegister.condition <> regUnknown then
+      if (p_flags & forFlags) <> 0 then begin
+         if longA then
+            if longI then
+               if NZMatchA then
+                  goto 1;
+         end {if}
+      else if aRegister.condition <> regUnknown then
          if aRegister.condition = xRegister.condition then
             if aRegister.value = xRegister.value then
                if aRegister.flags = xRegister.flags then
@@ -1233,7 +1380,13 @@ case p_opcode of
       end;
 
    m_tay: begin
-      if aRegister.condition <> regUnknown then
+      if (p_flags & forFlags) <> 0 then begin
+         if longA then
+            if longI then
+               if NZMatchA then
+                  goto 1;
+         end {if}
+      else if aRegister.condition <> regUnknown then
          if aRegister.condition = yRegister.condition then
             if aRegister.value = yRegister.value then
                if aRegister.flags = yRegister.flags then
@@ -1292,9 +1445,12 @@ case p_opcode of
       xRegister := yRegister;
       end;
    end; {case}
-2:
+2:                                      {emit the instruction normally}
+lastRegOpcode := p_opcode;
+3:                                      {branch here for instructions that}
+                                        {do not modify A/X/Y or flags     }
 WriteNative(p_opcode, p_mode, p_operand, p_name, p_flags);
-1:
+1:                                      {branch here to skip the instruction}
 end; {CheckRegisters}
 
 
@@ -1328,16 +1484,16 @@ Purge;                                  {dump constant buffer}
 if stringsize <> 0 then begin           {define string space}
    UpDate(maxLabel, pc);                {define the local label for the string space}
    for i := 1 to stringsize do
-      CnOut(ord(stringspace[i]));
+      CnOut(ord(stringspace^[i]));
    Purge;
    end; {if}
 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;
@@ -1412,11 +1568,11 @@ 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_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,d_add,d_pin,d_wrd,
-             d_sym,d_cns] then begin
+            [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_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;
             end {if}
@@ -1489,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
@@ -1524,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
@@ -1533,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
@@ -1548,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
@@ -1627,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;
@@ -1693,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:
@@ -1725,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}
@@ -1744,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:
@@ -1763,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);
@@ -1797,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}
@@ -1806,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
@@ -1935,6 +2181,18 @@ GenNative(p_opcode, implied, 0, nil, 0);
 end; {GenImplied}
 
 
+procedure GenImpliedForFlags {p_opcode: integer};
+
+{ Generate implied addressing instruction used for flags only.  }
+{                                                               }
+{ parameters:                                                   }
+{       p_code - operation code (m_tax or m_tay)                }
+
+begin {GenImpliedForFlags}
+GenNative(p_opcode, implied, 0, nil, forFlags);
+end; {GenImpliedForFlags}
+
+
 procedure GenCall {callNum: integer};
 
 { short form of jsl to library subroutine - reduces code size   }
@@ -2025,6 +2283,26 @@ case callNum of
    76: sp := @'~STACKERR';              {CC}
    77: sp := @'~LOADSTRUCT';            {CC}
    78: sp := @'~DIV4';                  {CC}
+   79: sp := @'~MUL8';
+   80: sp := @'~UMUL8';
+   81: sp := @'~CDIV8';
+   82: sp := @'~UDIV8';
+   83: sp := @'~CNVLONGLONGREAL';
+   84: sp := @'~CNVULONGLONGREAL';
+   85: sp := @'~SHL8';
+   86: sp := @'~ASHR8';
+   87: sp := @'~LSHR8';
+   88: sp := @'~SCMP8';
+   89: sp := @'~CNVREALLONGLONG';
+   90: sp := @'~CNVREALULONGLONG';
+   91: sp := @'~SINGLEPRECISION';
+   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}
@@ -2044,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					}
@@ -2082,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}
 
 
@@ -2096,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);
@@ -2117,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);
@@ -2157,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}
@@ -2174,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);
@@ -2200,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}
@@ -2257,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)
@@ -2266,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
@@ -2274,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
@@ -2293,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);
@@ -2329,11 +2655,12 @@ begin {InitNative}
 aRegister.condition := regUnknown;	{set up the peephole optimizer}
 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/assert.h

@@ -15,15 +15,20 @@
 #endif
 
 #ifndef NDEBUG
-#define assert(expression) (expression) ? ((void) 0) : (__assert(__FILE__, __LINE__, #expression))
+#ifndef __GNO__
+#define assert(expression) (expression) ? ((void) 0) : (__assert2(__FILE__, __LINE__, __func__, #expression))
 #else
-#define assert(expression)  ((void) 0)
+#define assert(expression) (expression) ? ((void) 0) : (__assert(__FILE__, __LINE__, #expression))
+#endif
+#else
+#define assert(expression)  ((void)0)
 #endif
 
 #ifndef __assert__
 #define __assert__
 
-extern void __assert(char *, int, char *);
+extern void __assert(const char *, unsigned, const char *);
+extern void __assert2(const char *, unsigned, const char *, const char *);
 
 #define static_assert _Static_assert
 

ORCACDefs/ctype.h

@@ -81,11 +81,13 @@ int             isblank(int);
 #define isblank(c)      ((__ctype2)[(c)+1] & __blank)
 #ifndef __KeepNamespacePure__
    #define toascii(c)      ((c) & 0x7F)
+   int                     toint(char);
 #endif
-int                     toint(char);
 int                     tolower(int);
 int                     toupper(int);
-#define _tolower(c)     ((c) | 0x20)
-#define _toupper(c)     ((c) & 0x5F)
+#ifndef __KeepNamespacePure__
+   #define _tolower(c)     ((c) | 0x20)
+   #define _toupper(c)     ((c) & 0x5F)
+#endif
 
 #endif

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/errno.h

@@ -25,7 +25,9 @@
 #define EACCESS                 9       /* alias for EACCES */
 #define EEXIST                  10      /* the file exists */
 #define ENOSPC                  11      /* the file is too large */
+#define EILSEQ                  12      /* encoding error */
 
 extern int errno;
+#define errno errno
 
 #endif

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/fenv.h

@@ -0,0 +1,45 @@
+/****************************************************************
+*
+*  fenv.h - floating-point environment access
+*
+*  February 2021
+*  Stephen Heumann
+*
+****************************************************************/
+
+#ifndef __fenv__
+#define __fenv__
+
+typedef unsigned short fenv_t;
+typedef unsigned short fexcept_t;
+
+/* Floating-point exceptions */
+#define FE_INVALID    0x01
+#define FE_UNDERFLOW  0x02
+#define FE_OVERFLOW   0x04
+#define FE_DIVBYZERO  0x08
+#define FE_INEXACT    0x10
+#define FE_ALL_EXCEPT 0x1F
+
+/* Rounding directions */
+#define FE_DOWNWARD   0x80
+#define FE_TONEAREST  0x00
+#define FE_TOWARDZERO 0xC0
+#define FE_UPWARD     0x40
+
+extern const fenv_t __FE_DFL_ENV[1];
+#define FE_DFL_ENV (&*__FE_DFL_ENV)
+
+int feclearexcept(int);
+int fegetexceptflag(fexcept_t *, int);
+int feraiseexcept(int);
+int fesetexceptflag(const fexcept_t *, int);
+int fetestexcept(int);
+int fegetround(void);
+int fesetround(int);
+int fegetenv(fenv_t *);
+int feholdexcept(fenv_t *);
+int fesetenv(const fenv_t *);
+int feupdateenv(const fenv_t *);
+
+#endif

ORCACDefs/float.h

@@ -13,7 +13,14 @@
 #ifndef __float__
 #define __float__
 
-#define FLT_ROUNDS      1
+int __get_flt_rounds(void);
+#define FLT_ROUNDS      (__get_flt_rounds())
+
+#define FLT_EVAL_METHOD 2
+
+#define FLT_HAS_SUBNORM 1
+#define DBL_HAS_SUBNORM 1
+#define LDBL_HAS_SUBNORM 1
 
 #define FLT_RADIX       2
 
@@ -21,17 +28,23 @@
 #define DBL_MANT_DIG    53
 #define LDBL_MANT_DIG   64
 
+#define FLT_DECIMAL_DIG 9
+#define DBL_DECIMAL_DIG 17
+#define LDBL_DECIMAL_DIG 21
+
+#define DECIMAL_DIG     21
+
 #define FLT_DIG         6
 #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
@@ -41,16 +54,20 @@
 #define DBL_MAX_10_EXP  308
 #define LDBL_MAX_10_EXP 4932
 
-#define FLT_MAX         3.40282347E+38F
-#define DBL_MAX         1.7976931348623157E+308
-#define LDBL_MAX        1.7976931348623157E+308 /* wrong; really ~1.19E+4932 */
+#define FLT_MAX         3.4028234663852885981E+38F
+#define DBL_MAX         1.7976931348623157081E+308
+#define LDBL_MAX        1.189731495357231765E+4932L
 
-#define FLT_EPSILON     1.19209290E-07F
-#define DBL_EPSILON     2.2204460492503131E-16
-#define LDBL_EPSILON    1.0842021724855044E-19
+#define FLT_EPSILON     1.1920928955078125E-07F
+#define DBL_EPSILON     2.2204460492503130808E-16
+#define LDBL_EPSILON    1.084202172485504434007E-19L
 
-#define FLT_MIN         1.17549435E-38F
-#define DBL_MIN         2.2250738585072014E-308
-#define LDBL_MIN        2.2250738585072014E-308 /* wrong; really ~1.68E-4932 */
+#define FLT_MIN         1.175494350822287508E-38F
+#define DBL_MIN         2.2250738585072013831E-308
+#define LDBL_MIN        1.6810515715560467531E-4932L
+
+#define FLT_TRUE_MIN    1.401298464324817070924E-45F
+#define DBL_TRUE_MIN    4.940656458412465441766E-324
+#define LDBL_TRUE_MIN   1.822599765941237E-4951L
 
 #endif

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/inttypes.h

@@ -7,15 +7,6 @@
 *
 ****************************************************************/
 
-/*
- * Note: The format specifier macros defined here generally comply with the
- * C99 and C11 standards, except that those associated with intmax_t and
- * uintmax_t correspond to their non-standard definitions as 32-bit types.
- * 
- * The functions that the standards specify should be declared in this header
- * are not available.
- */
-
 #ifndef __inttypes__
 #define __inttypes__
 
@@ -26,25 +17,31 @@
 #define PRId8           "d"     /* int8_t */
 #define PRId16          "d"     /* int16_t */
 #define PRId32          "ld"    /* int32_t */
+#define PRId64          "lld"   /* int64_t */
 #define PRIdLEAST8      "d"     /* int_least8_t */
 #define PRIdLEAST16     "d"     /* int_least16_t */
 #define PRIdLEAST32     "ld"    /* int_least32_t */
+#define PRIdLEAST64     "lld"   /* int_least64_t */
 #define PRIdFAST8       "d"     /* int_fast8_t */
 #define PRIdFAST16      "d"     /* int_fast16_t */
 #define PRIdFAST32      "ld"    /* int_fast32_t */
-#define PRIdMAX         "ld"    /* intmax_t */
+#define PRIdFAST64      "lld"   /* int_fast64_t */
+#define PRIdMAX         "jd"    /* intmax_t */
 #define PRIdPTR         "ld"    /* intptr_t */
 
 #define PRIi8           "i"     /* int8_t */
 #define PRIi16          "i"     /* int16_t */
 #define PRIi32          "li"    /* int32_t */
+#define PRIi64          "lli"   /* int64_t */
 #define PRIiLEAST8      "i"     /* int_least8_t */
 #define PRIiLEAST16     "i"     /* int_least16_t */
 #define PRIiLEAST32     "li"    /* int_least32_t */
+#define PRIiLEAST64     "lli"   /* int_least64_t */
 #define PRIiFAST8       "i"     /* int_fast8_t */
 #define PRIiFAST16      "i"     /* int_fast16_t */
 #define PRIiFAST32      "li"    /* int_fast32_t */
-#define PRIiMAX         "li"    /* intmax_t */
+#define PRIiFAST64      "lli"   /* int_fast64_t */
+#define PRIiMAX         "ji"    /* intmax_t */
 #define PRIiPTR         "li"    /* intptr_t */
 
 /* fprintf macros for unsigned integers */
@@ -52,49 +49,61 @@
 #define PRIo8           "o"     /* uint8_t */
 #define PRIo16          "o"     /* uint16_t */
 #define PRIo32          "lo"    /* uint32_t */
+#define PRIo64          "llo"   /* uint64_t */
 #define PRIoLEAST8      "o"     /* uint_least8_t */
 #define PRIoLEAST16     "o"     /* uint_least16_t */
 #define PRIoLEAST32     "lo"    /* uint_least32_t */
+#define PRIoLEAST64     "llo"   /* uint_least64_t */
 #define PRIoFAST8       "o"     /* uint_fast8_t */
 #define PRIoFAST16      "o"     /* uint_fast16_t */
 #define PRIoFAST32      "lo"    /* uint_fast32_t */
-#define PRIoMAX         "lo"    /* uintmax_t */
+#define PRIoFAST64      "llo"   /* uint_fast64_t */
+#define PRIoMAX         "jo"    /* uintmax_t */
 #define PRIoPTR         "lo"    /* uintptr_t */
 
 #define PRIu8           "u"     /* uint8_t */
 #define PRIu16          "u"     /* uint16_t */
 #define PRIu32          "lu"    /* uint32_t */
+#define PRIu64          "llu"   /* uint64_t */
 #define PRIuLEAST8      "u"     /* uint_least8_t */
 #define PRIuLEAST16     "u"     /* uint_least16_t */
 #define PRIuLEAST32     "lu"    /* uint_least32_t */
+#define PRIuLEAST64     "llu"   /* uint_least64_t */
 #define PRIuFAST8       "u"     /* uint_fast8_t */
 #define PRIuFAST16      "u"     /* uint_fast16_t */
 #define PRIuFAST32      "lu"    /* uint_fast32_t */
-#define PRIuMAX         "lu"    /* uintmax_t */
+#define PRIuFAST64      "llu"   /* uint_fast64_t */
+#define PRIuMAX         "ju"    /* uintmax_t */
 #define PRIuPTR         "lu"    /* uintptr_t */
 
 #define PRIx8           "x"     /* uint8_t */
 #define PRIx16          "x"     /* uint16_t */
 #define PRIx32          "lx"    /* uint32_t */
+#define PRIx64          "llx"   /* uint64_t */
 #define PRIxLEAST8      "x"     /* uint_least8_t */
 #define PRIxLEAST16     "x"     /* uint_least16_t */
 #define PRIxLEAST32     "lx"    /* uint_least32_t */
+#define PRIxLEAST64     "llx"   /* uint_least64_t */
 #define PRIxFAST8       "x"     /* uint_fast8_t */
 #define PRIxFAST16      "x"     /* uint_fast16_t */
 #define PRIxFAST32      "lx"    /* uint_fast32_t */
-#define PRIxMAX         "lx"    /* uintmax_t */
+#define PRIxFAST64      "llx"   /* uint_fast64_t */
+#define PRIxMAX         "jx"    /* uintmax_t */
 #define PRIxPTR         "lx"    /* uintptr_t */
 
 #define PRIX8           "X"     /* uint8_t */
 #define PRIX16          "X"     /* uint16_t */
 #define PRIX32          "lX"    /* uint32_t */
+#define PRIX64          "llX"   /* uint64_t */
 #define PRIXLEAST8      "X"     /* uint_least8_t */
 #define PRIXLEAST16     "X"     /* uint_least16_t */
 #define PRIXLEAST32     "lX"    /* uint_least32_t */
+#define PRIXLEAST64     "llX"   /* uint_least64_t */
 #define PRIXFAST8       "X"     /* uint_fast8_t */
 #define PRIXFAST16      "X"     /* uint_fast16_t */
 #define PRIXFAST32      "lX"    /* uint_fast32_t */
-#define PRIXMAX         "lX"    /* uintmax_t */
+#define PRIXFAST64      "llX"   /* uint_fast64_t */
+#define PRIXMAX         "jX"    /* uintmax_t */
 #define PRIXPTR         "lX"    /* uintptr_t */
 
 /* fscanf macros for signed integers */
@@ -102,25 +111,31 @@
 #define SCNd8           "hhd"   /* int8_t */
 #define SCNd16          "hd"    /* int16_t */
 #define SCNd32          "ld"    /* int32_t */
+#define SCNd64          "lld"   /* int64_t */
 #define SCNdLEAST8      "hhd"   /* int_least8_t */
 #define SCNdLEAST16     "hd"    /* int_least16_t */
 #define SCNdLEAST32     "ld"    /* int_least32_t */
+#define SCNdLEAST64     "lld"   /* int_least64_t */
 #define SCNdFAST8       "hd"    /* int_fast8_t */
 #define SCNdFAST16      "hd"    /* int_fast16_t */
 #define SCNdFAST32      "ld"    /* int_fast32_t */
-#define SCNdMAX         "ld"    /* intmax_t */
+#define SCNdFAST64      "lld"   /* int_fast64_t */
+#define SCNdMAX         "jd"    /* intmax_t */
 #define SCNdPTR         "ld"    /* intptr_t */
 
 #define SCNi8           "hhi"   /* int8_t */
 #define SCNi16          "hi"    /* int16_t */
 #define SCNi32          "li"    /* int32_t */
+#define SCNi64          "lli"   /* int64_t */
 #define SCNiLEAST8      "hhi"   /* int_least8_t */
 #define SCNiLEAST16     "hi"    /* int_least16_t */
 #define SCNiLEAST32     "li"    /* int_least32_t */
+#define SCNiLEAST64     "lli"   /* int_least64_t */
 #define SCNiFAST8       "hi"    /* int_fast8_t */
 #define SCNiFAST16      "hi"    /* int_fast16_t */
 #define SCNiFAST32      "li"    /* int_fast32_t */
-#define SCNiMAX         "li"    /* intmax_t */
+#define SCNiFAST64      "lli"   /* int_fast64_t */
+#define SCNiMAX         "ji"    /* intmax_t */
 #define SCNiPTR         "li"    /* intptr_t */
 
 /* fscanf macros for unsigned integers */
@@ -128,53 +143,63 @@
 #define SCNo8           "hho"   /* uint8_t */
 #define SCNo16          "ho"    /* uint16_t */
 #define SCNo32          "lo"    /* uint32_t */
+#define SCNo64          "llo"   /* uint64_t */
 #define SCNoLEAST8      "hho"   /* uint_least8_t */
 #define SCNoLEAST16     "ho"    /* uint_least16_t */
 #define SCNoLEAST32     "lo"    /* uint_least32_t */
+#define SCNoLEAST64     "llo"   /* uint_least64_t */
 #define SCNoFAST8       "ho"    /* uint_fast8_t */
 #define SCNoFAST16      "ho"    /* uint_fast16_t */
 #define SCNoFAST32      "lo"    /* uint_fast32_t */
-#define SCNoMAX         "lo"    /* uintmax_t */
+#define SCNoFAST64      "llo"   /* uint_fast64_t */
+#define SCNoMAX         "jo"    /* uintmax_t */
 #define SCNoPTR         "lo"    /* uintptr_t */
 
 #define SCNu8           "hhu"   /* uint8_t */
 #define SCNu16          "hu"    /* uint16_t */
 #define SCNu32          "lu"    /* uint32_t */
+#define SCNu64          "llu"   /* uint64_t */
 #define SCNuLEAST8      "hhu"   /* uint_least8_t */
 #define SCNuLEAST16     "hu"    /* uint_least16_t */
 #define SCNuLEAST32     "lu"    /* uint_least32_t */
+#define SCNuLEAST64     "llu"   /* uint_least64_t */
 #define SCNuFAST8       "hu"    /* uint_fast8_t */
 #define SCNuFAST16      "hu"    /* uint_fast16_t */
 #define SCNuFAST32      "lu"    /* uint_fast32_t */
-#define SCNuMAX         "lu"    /* uintmax_t */
+#define SCNuFAST64      "llu"   /* uint_fast64_t */
+#define SCNuMAX         "ju"    /* uintmax_t */
 #define SCNuPTR         "lu"    /* uintptr_t */
 
 #define SCNx8           "hhx"   /* uint8_t */
 #define SCNx16          "hx"    /* uint16_t */
 #define SCNx32          "lx"    /* uint32_t */
+#define SCNx64          "llx"   /* uint64_t */
 #define SCNxLEAST8      "hhx"   /* uint_least8_t */
 #define SCNxLEAST16     "hx"    /* uint_least16_t */
 #define SCNxLEAST32     "lx"    /* uint_least32_t */
+#define SCNxLEAST64     "llx"   /* uint_least64_t */
 #define SCNxFAST8       "hx"    /* uint_fast8_t */
 #define SCNxFAST16      "hx"    /* uint_fast16_t */
 #define SCNxFAST32      "lx"    /* uint_fast32_t */
-#define SCNxMAX         "lx"    /* uintmax_t */
+#define SCNxFAST64      "llx"   /* uint_fast64_t */
+#define SCNxMAX         "jx"    /* uintmax_t */
 #define SCNxPTR         "lx"    /* uintptr_t */
 
+#if defined(__ORCAC_HAS_LONG_LONG__) || __STDC_VERSION__ >= 199901L
+typedef struct {intmax_t quot,rem;} imaxdiv_t;
+
+intmax_t  imaxabs(intmax_t);
+imaxdiv_t imaxdiv(intmax_t, intmax_t);
+intmax_t  strtoimax(const char * restrict, char ** restrict, int);
+uintmax_t strtoumax(const char * restrict, char ** restrict, int);
+#endif
+
 /*
- * The C99 and C11 standards require the following functions and the
- * type imaxdiv_t to be declared here, but they are not currently supported.
+ * The C99 and C11 standards require the following functions
+ * to be declared here, but they are not currently supported.
  * 
- * intmax_t imaxabs(intmax_t j);
- * imaxdiv_t imaxdiv(intmax_t numer, intmax_t denom);
- * intmax_t strtoimax(const char * restrict nptr,
- *         char ** restrict endptr, int base);
- * uintmax_t strtoumax(const char * restrict nptr,
- *         char ** restrict endptr, int base);
- * intmax_t wcstoimax(const wchar_t * restrict nptr,
- *         wchar_t ** restrict endptr, int base);
- * uintmax_t wcstoumax(const wchar_t * restrict nptr,
- *         wchar_t ** restrict endptr, int base);
+ * intmax_t  wcstoimax(const wchar_t * restrict, wchar_t ** restrict, int);
+ * uintmax_t wcstoumax(const wchar_t * restrict, wchar_t ** restrict, int);
  */
 
 #endif

ORCACDefs/limits.h

@@ -29,5 +29,10 @@
 #define UINT_MAX        65535u
 #define ULONG_MAX       4294967295u
 #define USHRT_MAX       65535u
+#if defined(__ORCAC_HAS_LONG_LONG__) || __STDC_VERSION__ >= 199901L
+#define LLONG_MIN       (-9223372036854775807-1)
+#define LLONG_MAX       9223372036854775807
+#define ULLONG_MAX      18446744073709551615u
+#endif
 
 #endif

ORCACDefs/locale.h

@@ -0,0 +1,54 @@
+/****************************************************************
+*
+*  locale.h - locales
+*
+*  September 2021
+*  Stephen Heumann
+*
+****************************************************************/
+
+#ifndef __locale__
+#define __locale__
+
+struct lconv {
+   char *decimal_point;
+   char *thousands_sep;
+   char *grouping;
+   char *mon_decimal_point;
+   char *mon_thousands_sep;
+   char *mon_grouping;
+   char *positive_sign;
+   char *negative_sign;
+   char *currency_symbol;
+   char frac_digits;
+   char p_cs_precedes;
+   char n_cs_precedes;
+   char p_sep_by_space;
+   char n_sep_by_space;
+   char p_sign_posn;
+   char n_sign_posn;
+   char *int_curr_symbol;
+   char int_frac_digits;
+   char int_p_cs_precedes;
+   char int_n_cs_precedes;
+   char int_p_sep_by_space;
+   char int_n_sep_by_space;
+   char int_p_sign_posn;
+   char int_n_sign_posn;
+   };
+
+#ifndef NULL
+#define NULL  (void *) 0L
+#endif
+
+#define LC_ALL          0
+#define LC_COLLATE      1
+#define LC_CTYPE        2
+#define LC_MONETARY     3
+#define LC_NUMERIC      4
+#define LC_TIME         5
+
+struct lconv   *localeconv(void);
+char           *setlocale(int, const char *);
+
+#endif

ORCACDefs/math.h

@@ -13,33 +13,231 @@
 #ifndef __math__
 #define __math__
 
+typedef long double float_t;
+typedef long double double_t;
+
 #define HUGE_VAL 1e5000
+#define HUGE_VALF 1e5000F
+#define HUGE_VALL 1e5000L
+
+#define INFINITY 1e5000F
+
+#define NAN (0.0F/0.0F)
+
+#define FP_ILOGB0   (-32767-1)
+#define FP_ILOGBNAN (-32767-1)
+
+#define MATH_ERRNO       1
+#define MATH_ERREXCEPT   2
+#define math_errhandling 2
+
+#define FP_INFINITE  0xFE
+#define FP_NAN       0xFD
+#define FP_NORMAL    0x00
+#define FP_SUBNORMAL 0x01
+#define FP_ZERO      0xFF
+
+int __fpclassifyf(float);
+int __fpclassifyd(double);
+int __fpclassifyl(long double);
+int __signbit(long double);
+int __fpcompare(long double, long double, short);
+
+#define __fpclassify(x) _Generic((x), \
+   float: __fpclassifyf, \
+   double: __fpclassifyd, \
+   long double: __fpclassifyl)(x)
+
+#define fpclassify(x) __fpclassify(x)
+#define isfinite(x)  (((__fpclassify(x) + 1) & 0xF0) == 0)
+#define isinf(x)     (__fpclassify(x) == FP_INFINITE)
+#define isnan(x)     (__fpclassify((long double)(x)) == FP_NAN)
+#define isnormal(x)  (__fpclassify(x) == FP_NORMAL)
+#define signbit(x)   __signbit(x)
+
+#define isgreater(x,y)      __fpcompare((x),(y),0x40)
+#define isgreaterequal(x,y) __fpcompare((x),(y),0x42)
+#define isless(x,y)         __fpcompare((x),(y),0x80)
+#define islessequal(x,y)    __fpcompare((x),(y),0x82)
+#define islessgreater(x,y)  __fpcompare((x),(y),0xC0)
+#define isunordered(x,y)    __fpcompare((x),(y),0x01)
 
 #ifndef __KeepNamespacePure__
-   #define arctan(x) atan(x)        
+   #define arctan(x) atan(x)
 #endif
 
 double          acos(double);
+float           acosf(float);
+long double     acosl(long double);
+double          acosh(double);
+float           acoshf(float);
+long double     acoshl(long double);
 double          asin(double);
+float           asinf(float);
+long double     asinl(long double);
+double          asinh(double);
+float           asinhf(float);
+long double     asinhl(long double);
 double          atan(double);
-double          cos(double);
-double          cosh(double);
-double          exp(double);
-double          log(double);
-double          log10(double);
-double          sin(double);
-double          sinh(double);
-double          sqrt(double);
-double          tan(double);
-double          tanh(double);
+float           atanf(float);
+long double     atanl(long double);
+double          atanh(double);
+float           atanhf(float);
+long double     atanhl(long double);
 double          atan2(double, double);
+float           atan2f(float, float);
+long double     atan2l(long double, long double);
+double          cbrt(double);
+float           cbrtf(float);
+long double     cbrtl(long double);
 double          ceil(double);
+float           ceilf(float);
+long double     ceill(long double);
+double          copysign(double, double);
+float           copysignf(float, float);
+long double     copysignl(long double, long double);
+double          cos(double);
+float           cosf(float);
+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);
+double          exp2(double);
+float           exp2f(float);
+long double     exp2l(long double);
+double          expm1(double);
+float           expm1f(float);
+long double     expm1l(long double);
 double          fabs(double);
+float           fabsf(float);
+long double     fabsl(long double);
+double          fdim(double, double);
+float           fdimf(float, float);
+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);
+double          fmin(double, double);
+float           fminf(float, float);
+long double     fminl(long double, long double);
 double          fmod(double, double);
+float           fmodf(float, float);
+long double     fmodl(long double, long double);
 double          frexp(double, int *);
+float           frexpf(float, int *);
+long double     frexpl(long double, int *);
+double          hypot(double, double);
+float           hypotf(float, float);
+long double     hypotl(long double, long double);
+int             ilogb(double);
+int             ilogbf(float);
+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);
+long long       llrintl(long double);
+long long       llround(double);
+long long       llroundf(float);
+long long       llroundl(long double);
+#endif
+double          log(double);
+float           logf(float);
+long double     logl(long double);
+double          log10(double);
+float           log10f(float);
+long double     log10l(long double);
+double          log1p(double);
+float           log1pf(float);
+long double     log1pl(long double);
+double          log2(double);
+float           log2f(float);
+long double     log2l(long double);
+double          logb(double);
+float           logbf(float);
+long double     logbl(long double);
+long            lrint(double);
+long            lrintf(float);
+long            lrintl(long double);
+long            lround(double);
+long            lroundf(float);
+long            lroundl(long double);
 double          modf(double, double *);
+float           modff(float, float *);
+long double     modfl(long double, long double *);
+double          nearbyint(double);
+float           nearbyintf(float);
+long double     nearbyintl(long double);
+double          nan(const char *);
+float           nanf(const char *);
+long double     nanl(const char *);
+double          nextafter(double, double);
+float           nextafterf(float, float);
+long double     nextafterl(long double, long double);
+double          nexttoward(double, long double);
+float           nexttowardf(float, long double);
+long double     nexttowardl(long double, long double);
 double          pow(double, double);
+float           powf(float, float);
+long double     powl(long double, long double);
+double          remainder(double, double);
+float           remainderf(float, float);
+long double     remainderl(long double, long double);
+double          remquo(double, double, int *);
+float           remquof(float, float, int *);
+long double     remquol(long double, long double, int *);
+double          rint(double);
+float           rintf(float);
+long double     rintl(long double);
+double          round(double);
+float           roundf(float);
+long double     roundl(long double);
+double          scalbln(double, long);
+float           scalblnf(float, long);
+long double     scalblnl(long double, long);
+double          scalbn(double, int);
+float           scalbnf(float, int);
+long double     scalbnl(long double, int);
+double          sin(double);
+float           sinf(float);
+long double     sinl(long double);
+double          sinh(double);
+float           sinhf(float);
+long double     sinhl(long double);
+double          sqrt(double);
+float           sqrtf(float);
+long double     sqrtl(long double);
+double          tan(double);
+float           tanf(float);
+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);
 
 #endif

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

@@ -14,6 +14,11 @@
 *
 *  Thanks to Doug Gwyn for the new va_start & va_arg declarations.
 *
+*****************************************************************
+*
+*  Modified October 2021 for better standards conformance.
+*  This version will only work with ORCA/C 2.2.0 B6 or later.
+*
 ****************************************************************/
 
 #ifndef __stdarg__
@@ -25,10 +30,13 @@ typedef char *__va_list[2];
 #endif
 
 typedef __va_list va_list;
-#define va_end(a) __va_end(a)
-#define	va_start(ap,LastFixedParm) ((void) ((ap)[0] = (ap)[1] = (char *) (&LastFixedParm + 1)))
-#define	va_arg(ap,type)	((type *)((ap)[0] += sizeof(type)))[-1]
+#define va_end(ap) __record_va_info(ap)
+#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])
+#define va_copy(dest,src) ((void)((dest)[0]=(src)[0],(dest)[1]=(src)[1]))
 
-void __va_end(va_list);
+void __record_va_info(va_list);
 
 #endif

ORCACDefs/stdbool.h

@@ -0,0 +1,15 @@
+/****************************************************************
+*
+*  stdbool.h - boolean type and values
+*
+****************************************************************/
+
+#ifndef __stdbool__
+#define __stdbool__
+
+#define bool _Bool
+#define true 1
+#define false 0
+#define __bool_true_false_are_defined 1
+
+#endif

ORCACDefs/stdint.h

@@ -7,12 +7,6 @@
 *
 ****************************************************************/
 
-/*
- * Note: This header mostly complies with the C99 and C11 standards,
- * except that 64-bit types are not provided because ORCA/C does not
- * support them.  See comments below for further details.
- */
-
 #ifndef __stdint__
 #define __stdint__
 
@@ -20,80 +14,122 @@
 typedef signed char     int8_t;
 typedef short           int16_t;
 typedef long            int32_t;
+#if defined(__ORCAC_HAS_LONG_LONG__) || __STDC_VERSION__ >= 199901L
+typedef long long       int64_t;
+#endif
 
 typedef unsigned char   uint8_t;
 typedef unsigned short  uint16_t;
 typedef unsigned long   uint32_t;
+#if defined(__ORCAC_HAS_LONG_LONG__) || __STDC_VERSION__ >= 199901L
+typedef unsigned long long uint64_t;
+#endif
 
 /* Minimum-width integer types */
 typedef signed char     int_least8_t;
 typedef short           int_least16_t;
 typedef long            int_least32_t;
+#if defined(__ORCAC_HAS_LONG_LONG__) || __STDC_VERSION__ >= 199901L
+typedef long long       int_least64_t;
+#endif
 
 typedef unsigned char   uint_least8_t;
 typedef unsigned short  uint_least16_t;
 typedef unsigned long   uint_least32_t;
+#if defined(__ORCAC_HAS_LONG_LONG__) || __STDC_VERSION__ >= 199901L
+typedef unsigned long long uint_least64_t;
+#endif
 
 /* Fastest minimum-width integer types */
 typedef short           int_fast8_t;    /* Note: 16-bit type */
 typedef short           int_fast16_t;
 typedef long            int_fast32_t;
+#if defined(__ORCAC_HAS_LONG_LONG__) || __STDC_VERSION__ >= 199901L
+typedef long long       int_fast64_t;
+#endif
 
 typedef unsigned short  uint_fast8_t;   /* Note: 16-bit type */
 typedef unsigned short  uint_fast16_t;
 typedef unsigned long   uint_fast32_t;
+#if defined(__ORCAC_HAS_LONG_LONG__) || __STDC_VERSION__ >= 199901L
+typedef unsigned long long uint_fast64_t;
+#endif
 
 /* Integer types capable of holding object pointers */
 typedef long            intptr_t;
 typedef unsigned long   uintptr_t;
 
 /* Greatest-width integer types */
-/* 
- * Note: In C99 and C11, these are required to be at least 64 bits.
- * Since ORCA/C does not currently support 64-bit integer types,
- * they are currently defined as 32-bit types instead.
- */
-typedef long            intmax_t;
-typedef unsigned long   uintmax_t;
+#if defined(__ORCAC_HAS_LONG_LONG__) || __STDC_VERSION__ >= 199901L
+typedef long long          intmax_t;
+typedef unsigned long long uintmax_t;
+#endif
 
 /* Limits of exact-width integer types */
 #define INT8_MIN        (-128)
 #define INT16_MIN       (-32767-1)
 #define INT32_MIN       (-2147483647-1)
+#if defined(__ORCAC_HAS_LONG_LONG__) || __STDC_VERSION__ >= 199901L
+#define INT64_MIN       (-9223372036854775807-1)
+#endif
 
 #define INT8_MAX        127
 #define INT16_MAX       32767
 #define INT32_MAX       2147483647
+#if defined(__ORCAC_HAS_LONG_LONG__) || __STDC_VERSION__ >= 199901L
+#define INT64_MAX       9223372036854775807
+#endif
 
 #define UINT8_MAX       255
 #define UINT16_MAX      65535u
 #define UINT32_MAX      4294967295u
+#if defined(__ORCAC_HAS_LONG_LONG__) || __STDC_VERSION__ >= 199901L
+#define UINT64_MAX      18446744073709551615u
+#endif
 
 /* Limits of minimum-width integer types */
 #define INT_LEAST8_MIN  (-128)
 #define INT_LEAST16_MIN (-32767-1)
 #define INT_LEAST32_MIN (-2147483647-1)
+#if defined(__ORCAC_HAS_LONG_LONG__) || __STDC_VERSION__ >= 199901L
+#define INT_LEAST64_MIN (-9223372036854775807-1)
+#endif
 
 #define INT_LEAST8_MAX  127
 #define INT_LEAST16_MAX 32767
 #define INT_LEAST32_MAX 2147483647
+#if defined(__ORCAC_HAS_LONG_LONG__) || __STDC_VERSION__ >= 199901L
+#define INT_LEAST64_MAX 9223372036854775807
+#endif
 
 #define UINT_LEAST8_MAX  255
 #define UINT_LEAST16_MAX 65535u
 #define UINT_LEAST32_MAX 4294967295u
+#if defined(__ORCAC_HAS_LONG_LONG__) || __STDC_VERSION__ >= 199901L
+#define UINT_LEAST64_MAX 18446744073709551615u
+#endif
 
 /* Limits of fastest minimum-width integer types */
 #define INT_FAST8_MIN   (-32767-1)
 #define INT_FAST16_MIN  (-32767-1)
 #define INT_FAST32_MIN  (-2147483647-1)
+#if defined(__ORCAC_HAS_LONG_LONG__) || __STDC_VERSION__ >= 199901L
+#define INT_FAST64_MIN  (-9223372036854775807-1)
+#endif
 
 #define INT_FAST8_MAX   32767
 #define INT_FAST16_MAX  32767
 #define INT_FAST32_MAX  2147483647
+#if defined(__ORCAC_HAS_LONG_LONG__) || __STDC_VERSION__ >= 199901L
+#define INT_FAST64_MAX  9223372036854775807
+#endif
 
 #define UINT_FAST8_MAX  65535u
 #define UINT_FAST16_MAX 65535u
 #define UINT_FAST32_MAX 4294967295u
+#if defined(__ORCAC_HAS_LONG_LONG__) || __STDC_VERSION__ >= 199901L
+#define UINT_FAST64_MAX 18446744073709551615u
+#endif
 
 /* Limits of integer types capable of holding object pointers */
 #define INTPTR_MIN      (-2147483647-1)
@@ -101,10 +137,11 @@ typedef unsigned long   uintmax_t;
 #define UINTPTR_MAX     4294967295u
 
 /* Limits of greatest-width integer types */
-/* Note: These limits are smaller than C99 and C11 require. */
-#define INTMAX_MIN      (-2147483647-1)
-#define INTMAX_MAX      2147483647
-#define UINTMAX_MAX     4294967295u
+#if defined(__ORCAC_HAS_LONG_LONG__) || __STDC_VERSION__ >= 199901L
+#define INTMAX_MIN      (-9223372036854775807-1)
+#define INTMAX_MAX      9223372036854775807
+#define UINTMAX_MAX     18446744073709551615u
+#endif
 
 /* Limits of other integer types */
 #define PTRDIFF_MIN     (-2147483647-1)
@@ -128,14 +165,21 @@ typedef unsigned long   uintmax_t;
 #define INT8_C(val)     (val)
 #define INT16_C(val)    (val)
 #define INT32_C(val)    (val ## L)
+#if defined(__ORCAC_HAS_LONG_LONG__) || __STDC_VERSION__ >= 199901L
+#define INT64_C(val)    (val ## LL)
+#endif
 
 #define UINT8_C(val)    (val)
 #define UINT16_C(val)   (val ## U)
 #define UINT32_C(val)   (val ## UL)
+#if defined(__ORCAC_HAS_LONG_LONG__) || __STDC_VERSION__ >= 199901L
+#define UINT64_C(val)   (val ## ULL)
+#endif
 
 /* Macros for greatest-width integer constants */
-/* Note: These use 32-bit types, consistent with intmax_t and uintmax_t. */
-#define INTMAX_C(val)   (val ## L)
-#define UINTMAX_C(val)  (val ## UL)
+#if defined(__ORCAC_HAS_LONG_LONG__) || __STDC_VERSION__ >= 199901L
+#define INTMAX_C(val)   (val ## LL)
+#define UINTMAX_C(val)  (val ## ULL)
+#endif
 
 #endif

ORCACDefs/stdio.h

@@ -61,7 +61,7 @@ typedef struct __file {
                         *_end;          /* end of the file buffer */
    unsigned long        _size,          /* size of the file buffer */
                         _cnt;           /* # chars that can be read/written to buffer */
-   int                  _pbk;           /* put back buffer */
+   int                  _pbk[2];        /* put back buffer */
    unsigned int         _flag,          /* buffer flags */
                         _file;          /* GS/OS file ID */
    } FILE;
@@ -80,10 +80,14 @@ typedef struct __file {
 #define _IOERR          0x0100          /* has an error occurred? */
 #define _IOTEXT         0x0200          /* is this file a text file? */
 #define _IOTEMPFILE     0x0400          /* was this file created by tmpfile()? */
+#define _IOAPPEND       0x0800          /* is this file open in append mode? */
 
 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 */
@@ -99,16 +103,6 @@ extern FILE *stdout;
 
 typedef long fpos_t;
 
-/*
- *  Function declared as a macro
- */
-
-void            rewind(FILE *);
-#define rewind(stream)          (__fseek((stream),0L,SEEK_SET))
-
-/* Private function used in the above macro (not to be used otherwise) */
-int             __fseek(FILE *, long, int);
-
 /*
  *  Function declarations
  */
@@ -134,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 *);
@@ -142,6 +138,7 @@ int             putchar(int);
 int             puts(const char *);
 int             remove(const char *);
 int             rename(const char *, const char *);
+void            rewind(FILE *);
 int             scanf(const char *, ...);
 void            setbuf(FILE *, char *);
 int             setvbuf(FILE *, char *, int, size_t);
@@ -152,8 +149,11 @@ FILE           *tmpfile(void);
 char           *tmpnam(char *);
 int             ungetc(int c, FILE *);
 int             vfprintf(FILE *, const char *, __va_list);
+int             vfscanf(FILE *, const char *, __va_list);
 int             vprintf(const char *, __va_list);
+int             vscanf(const char *, __va_list);
 int             vsprintf(char *, const char *, __va_list);
 int             vsnprintf(char *, size_t, const char *, __va_list);
+int             vsscanf(const char *, const char *, __va_list);
 
 #endif

ORCACDefs/stdlib.h

@@ -25,10 +25,13 @@ typedef unsigned long size_t;
 #define RAND_MAX        32767
 #define EXIT_FAILURE    (-1)
 #define EXIT_SUCCESS    0
-#define MB_CUR_MAX      1
+#define MB_CUR_MAX      1UL
 
 typedef struct {int quot,rem;} div_t;
 typedef struct {long quot,rem;} ldiv_t;
+#if defined(__ORCAC_HAS_LONG_LONG__) || __STDC_VERSION__ >= 199901L
+typedef struct {long long quot,rem;} lldiv_t;
+#endif
 
 #ifndef __KeepNamespacePure__
    #define clalloc(x,y)    calloc((x),(y))
@@ -45,6 +48,9 @@ int             at_quick_exit(void (*__func)(void));
 double          atof(const char *);
 int             atoi(const char *);
 long            atol(const char *);
+#if defined(__ORCAC_HAS_LONG_LONG__) || __STDC_VERSION__ >= 199901L
+long long       atoll(const char *);
+#endif
 void           *bsearch(const void *, const void *, size_t, size_t, int (*__compar)(const void *, const void *));
 void           *calloc(size_t, size_t);
 div_t           div(int, int);
@@ -55,15 +61,26 @@ void            free(void *);
 char           *getenv(const char *);
 long            labs(long);
 ldiv_t          ldiv(long, long);
+#if defined(__ORCAC_HAS_LONG_LONG__) || __STDC_VERSION__ >= 199901L
+long long       llabs(long long);
+lldiv_t         lldiv(long long, long long);
+#endif
 void           *malloc(size_t);
+int             mblen(const char *, size_t);
 void            qsort(void *, size_t, size_t, int (*__compar)(const void *, const void *));
 void            quick_exit(int);
 int             rand(void);
 void           *realloc(void *, size_t);
 void            srand(unsigned);
 double          strtod(const char *, char **);
+float           strtof(const char *, char **);
+long double     strtold(const char *, char **);
 long            strtol(const char *, char **, int);
 unsigned long   strtoul(const char *, char **, int);
+#if defined(__ORCAC_HAS_LONG_LONG__) || __STDC_VERSION__ >= 199901L
+long long       strtoll(const char * restrict, char ** restrict, int);
+unsigned long long strtoull(const char * restrict, char ** restrict, int);
+#endif
 int             system(const char *);
 
 #endif

ORCACDefs/string.h

@@ -22,16 +22,21 @@ typedef unsigned long size_t;
 #define NULL  (void *) 0L
 #endif
 
-char           *c2pstr(char *);
+#ifndef __KeepNamespacePure__
+   char        *c2pstr(const char *);
+#endif
 void           *memchr(const void *, int, size_t);
 int             memcmp(const void *, const void *, size_t);
 void           *memcpy(void *, const void *, size_t);
 void           *memmove(void *, const void *, size_t);
 void           *memset(void *, int, size_t);
-char           *p2cstr(char *);
+#ifndef __KeepNamespacePure__
+   char        *p2cstr(const char *);
+#endif
 char           *strcat(char *, const char *);
 char           *strchr(const char *, int);
 int             strcmp(const char *, const char *);
+int             strcoll(const char *, const char *);
 char           *strcpy(char *, const char *);
 size_t          strcspn(const char *, const char *);
 char           *strerror(int);
@@ -40,12 +45,18 @@ char           *strncat(char *, const char *, size_t);
 int             strncmp(const char *, const char *, size_t);
 char           *strncpy(char *, const char *, size_t);
 char           *strpbrk(const char *, const char *);
-int             strpos(char *, char);
+#ifndef __KeepNamespacePure__
+   int          strpos(const char *, char);
+#endif
 char           *strrchr(const char *, int);
-char           *strrpbrk(char *, char *);
-int             strrpos(char *, char);
+#ifndef __KeepNamespacePure__
+   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 *);
 char           *strtok(char *, const char *);
+size_t          strxfrm(char *, const char *, size_t);
+
 
 #endif

ORCACDefs/tgmath.h

@@ -0,0 +1,104 @@
+/****************************************************************
+*
+*  tgmath.h - type-generic math macros
+*
+*  November 2021
+*  Stephen Heumann
+*
+****************************************************************/
+
+#ifndef __tgmath__
+#define __tgmath__
+
+#include <math.h>
+
+#define __tg_real_x(fn,x) _Generic((x), \
+   float: fn##f, \
+   long double: fn##l, \
+   default: fn)(x)
+
+#define __tg_real_x_other(fn,x,other) _Generic((x), \
+   float: fn##f, \
+   long double: fn##l, \
+   default: fn)((x),(other))
+
+#define __tg_real_x_y(fn,x,y) _Generic((x), \
+   float: _Generic((y), float: fn##f, long double: fn##l, default: fn), \
+   long double: fn##l, \
+   default: _Generic((y), long double: fn##l, default: fn))((x),(y))
+
+#define __tg_real_x_y_other(fn,x,y,other) _Generic((x), \
+   float: _Generic((y), float: fn##f, long double: fn##l, default: fn), \
+   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))
+
+#define acos(x)         __tg_x(acos,(x))
+#define acosh(x)        __tg_x(acosh,(x))
+#define asin(x)         __tg_x(asin,(x))
+#define asinh(x)        __tg_x(asinh,(x))
+#define atan(x)         __tg_x(atan,(x))
+#define atanh(x)        __tg_x(atanh,(x))
+#define atan2(y,x)      __tg_real_x_y(atan2,(y),(x))
+#define cbrt(x)         __tg_real_x(cbrt,(x))
+#define ceil(x)         __tg_real_x(ceil,(x))
+#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))
+#define fmod(x,y)       __tg_real_x_y(fmod,(x),(y))
+#define frexp(x,nptr)   __tg_real_x_other(frexp,(x),(nptr))
+#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))
+#define log10(x)        __tg_real_x(log10,(x))
+#define log1p(x)        __tg_real_x(log1p,(x))
+#define log2(x)         __tg_real_x(log2,(x))
+#define logb(x)         __tg_real_x(logb,(x))
+#define lrint(x)        __tg_real_x(lrint,(x))
+#define lround(x)       __tg_real_x(lround,(x))
+#define nearbyint(x)    __tg_real_x(nearbyint,(x))
+#define nextafter(x,y)  __tg_real_x_y(nextafter,(x),(y))
+#define nexttoward(x,y) __tg_real_x_y(nexttoward,(x),(y))
+#define pow(x,y)        __tg_x_y(pow,(x),(y))
+#define remainder(x,y)  __tg_real_x_y(remainder,(x),(y))
+#define remquo(x,y,quo) __tg_real_x_y_other(remquo,(x),(y),(quo))
+#define rint(x)         __tg_real_x(rint,(x))
+#define round(x)        __tg_real_x(round,(x))
+#define scalbn(x,n)     __tg_real_x_other(scalbn,(x),(n))
+#define scalbln(x,n)    __tg_real_x_other(scalbln,(x),(n))
+#define sin(x)          __tg_x(sin,(x))
+#define sinh(x)         __tg_x(sinh,(x))
+#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,10 +28,21 @@ struct tm {
         int tm_isdst;
         };
 
-#ifndef __KeepNamespacePure__
-   #define CLK_TCK      60
+#ifndef __struct_timespec__
+#define __struct_timespec__
+struct timespec {
+        time_t tv_sec;
+        long   tv_nsec;
+        };
 #endif
-#define CLOCKS_PER_SEC  60
+
+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
@@ -42,6 +53,8 @@ struct tm {
 typedef unsigned long size_t;
 #endif
 
+extern int      __useTimeTool;
+
 char           *asctime(const struct tm *);
 clock_t         clock(void);
 char           *ctime(const time_t *);
@@ -49,6 +62,8 @@ double          difftime(time_t, time_t);
 struct tm      *gmtime(const time_t *);
 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/types.h

@@ -27,10 +27,18 @@
 
 #define dispatcher 0xE10000L            /* tool locator dispatch address */
 
+#ifndef TRUE
 #define TRUE 1
-#define true TRUE
+#endif
+#ifndef true
+#define true 1
+#endif
+#ifndef FALSE
 #define FALSE 0
-#define false FALSE
+#endif
+#ifndef false
+#define false 0
+#endif
 
 /* RefDescriptors */
 #define refIsPointer 0x0000

ORCACDefs/uchar.h

@@ -0,0 +1,28 @@
+/****************************************************************
+*
+*  uchar.h - Unicode utilities
+*
+*  October 2021
+*  Stephen Heumann
+*
+****************************************************************/
+
+#ifndef __uchar__
+#define __uchar__
+
+typedef unsigned long mbstate_t;
+
+#ifndef __size_t__
+#define __size_t__ 1
+typedef unsigned long size_t;
+#endif
+
+typedef unsigned short char16_t;
+typedef unsigned long char32_t;
+
+size_t  c16rtomb(char *, char16_t, mbstate_t *);
+size_t  c32rtomb(char *, char32_t, mbstate_t *);
+size_t  mbrtoc16(char16_t *, const char *, size_t, mbstate_t *);
+size_t  mbrtoc32(char32_t *, const char *, size_t, mbstate_t *);
+
+#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

@@ -49,9 +49,10 @@ implementation
 
 const
    feature_hh = true;
-   feature_ll = false;
+   feature_ll = true;
    feature_s_long = false;
    feature_n_size = true;
+   feature_scanf_ld = true;
 
 type
    length_modifier = (default, h, hh, l, ll, j, z, t, ld);
@@ -135,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
@@ -166,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
@@ -252,6 +253,24 @@ var
    end; {expect_long}
 
 
+   procedure expect_long_long;
+   { Verify the current argument is a long long int.}
+   var
+      ty: typePtr;
+
+   begin {expect_long_long}
+   ty := popType;
+   if ty <> nil then begin
+      if (ty^.kind <> scalarType) or (not (ty^.baseType in [cgQuad, cgUQuad])) then begin
+         Warning(@'expected long long int');
+         end; {if}
+      end {if}
+   else begin
+      Warning(@'argument missing; expected long long int');
+      end; {else}
+   end; {expect_long_long}
+
+
    procedure expect_int;
    var
       ty: typePtr;
@@ -456,9 +475,9 @@ var
                has_suppress := true;
                end;
 
-            'b': begin
+            'b', 'P': begin
                if has_length <> default then
-                  Warning(@'length modifier may not be used with %b');
+                  Warning(@'length modifier may not be used with %b or %P');
                expected := [cgByte, cgUByte];
                name := @'char';
                end;
@@ -489,10 +508,14 @@ var
                      expected := [cgByte, cgUByte];
                      name := @'char';
                      end;
-                  l, ll, j, z, t: begin
+                  l, z, t: begin
                      expected := [cgLong, cgULong];
                      name := @'long';
                      end;
+                  ll, j: begin
+                     expected := [cgQuad, cgUQuad];
+                     name := @'long long';
+                     end;
                   h: begin
                      expected := [cgWord, cgUWord];
                      name := @'short';
@@ -523,10 +546,14 @@ var
                      expected := [cgByte, cgUByte];
                      name := @'char';
                      end;
-                  l, ll, j, z, t: begin
+                  l, z, t: begin
                      expected := [cgLong, cgULong];
                      name := @'long';
                      end;
+                  ll, j: begin
+                     expected := [cgQuad, cgUQuad];
+                     name := @'long long';
+                     end;
                   h: begin
                      expected := [cgWord, cgUWord];
                      name := @'short';
@@ -552,6 +579,9 @@ var
 
                   case has_length of
                      ld: begin
+                        if not feature_scanf_ld then
+                           if not has_suppress then
+                              Warning(@'L length modifier is not currently supported');
                         expected := [cgExtended];
                         name := @'long double';
                         end;
@@ -606,7 +636,7 @@ var
    length_set := ['h', 'l', 'j', 't', 'z', 'L']; 
    flag_set := ['#', '0', '-', '+', ' '];
    format_set := ['%', '[', 'b', 'c', 's', 'd', 'i', 'o', 'x', 'X', 'u', 
-      'f', 'F', 'e', 'E', 'a', 'A', 'g', 'G', 'n', 'p'];
+      'f', 'F', 'e', 'E', 'a', 'A', 'g', 'G', 'n', 'p', 'P'];
 
 
    for i := 1 to s^.length do begin
@@ -711,9 +741,9 @@ var
                end;
 
              { %b: orca-specific - pascal string }
-            'b': begin
+            'b', 'P': begin
                if has_length <> default then
-                  Warning(@'length modifier may not be used with %b');
+                  Warning(@'length modifier may not be used with %b or %P');
                expect_pointer_to([cgByte, cgUByte], @'char');
                end;
             
@@ -739,9 +769,12 @@ var
                   hh:
                      expect_pointer_to([cgByte, cgUByte], @'char');
 
-                  l, ll, j, z, t:
+                  l, z, t:
                         expect_pointer_to([cgLong, cgULong], @'long');
 
+                  ll, j:
+                        expect_pointer_to([cgQuad, cgUQuad], @'long long');
+
                   otherwise: begin
                      if feature_n_size and (has_length = ld) then
                         Warning(@'invalid length modifier');
@@ -767,9 +800,12 @@ var
 
             { chars are passed as ints so %hhx can be ignored here. }
             'd', 'i', 'o', 'x', 'X', 'u':
-               if has_length in [l, ll, j, z, t] then begin
+               if has_length in [l, z, t] then begin
                   expect_long;
                   end
+               else if has_length in [ll, j] then begin
+                  expect_long_long;
+                  end
                else if has_length = ld then begin
                   Warning(@'invalid length modifier');
                   expect_int;
@@ -805,7 +841,7 @@ var
    length_set := ['h', 'l', 'j', 't', 'z', 'L']; 
    flag_set := ['#', '0', '-', '+', ' '];
    format_set := ['%', 'b', 'c', 's', 'd', 'i', 'o', 'x', 'X', 'u', 
-      'f', 'F', 'e', 'E', 'a', 'A', 'g', 'G', 'n', 'p'];
+      'f', 'F', 'e', 'E', 'a', 'A', 'g', 'G', 'n', 'p', 'P'];
 
    for i := 1 to s^.length do begin
       c := s^.str[i];

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

@@ -1,5 +1,305 @@
          mcopy scanner.macros
          datachk off
+****************************************************************
+*
+*  ConvertHexFloat - Parse a hexadecimal floating-point constant
+*
+*  Inputs:
+*        str - pointer to the string (p-string)
+*
+*  Outputs:
+*        Returns the extended value (or a NAN on error).
+*
+****************************************************************
+*
+ConvertHexFloat start scanner
+
+         subroutine (4:str),26
+end_idx  equ   0                        index one past end of string
+got_period equ end_idx+2                flag: have we encountered a period?
+full     equ   got_period+2             flag: is mantissa full?
+mantissa equ   full+2                   mantissa
+extrabits equ  mantissa+8               extra bits that do not fit in mantissa
+exp_adjust equ extrabits+2              exponent adjustment
+negate_exp equ exp_adjust+2             flag: is exponent negative?
+exp      equ   negate_exp+2             exponent
+nonzero  equ   exp+2                    flag: is mantissa non-zero?
+got_digit equ  nonzero+2                flag: got any digit yet?
+
+         stz   got_period               no period yet
+         stz   full                     not full yet
+         stz   negate_exp               assume positive exponent
+         stz   got_digit                no digit yet
+         stz   exp                      exponent value = 0
+         stz   mantissa                 mantissa = 0.0
+         stz   mantissa+2
+         stz   mantissa+4
+         stz   mantissa+6
+         stz   extrabits                extrabits = 0
+         lda   #63                      exponent adjustment = 63
+         sta   exp_adjust
+         
+         lda   [str]                    end_idx = string length + 1 
+         and   #$00FF
+         inc   a
+         sta   end_idx
+         ldy   #1                       string index = 1
+         
+         jsr   nextch                   check for 0x or 0X prefix
+         cmp   #'0'
+         beq   check_x
+         brl   error
+check_x  jsr   nextch
+         and   #$df
+         cmp   #'X'
+         beq   digitlp
+         brl   error
+         
+digitlp  jsr   nextch                   get a character
+         ldx   got_period               if there was no period yet
+         bne   check_p
+         cmp   #'.'                       if character is '.'
+         bne   check_p
+         dec   got_period                   flag that we got a period
+         bra   digitlp                      loop for another digit
+check_p  cmp   #'p'                     if character is 'p' or 'P'
+         beq   normal                     mantissa is done: normalize it
+         cmp   #'P'
+         beq   normal
+         sta   got_digit                flag that we (presumably) got a digit
+         jsr   hexdigit                 must be a hex digit: get value
+         ldx   full                     if mantissa is full
+         beq   donibble
+         ora   extrabits                  record extra bits for rounding
+         sta   extrabits
+         lda   got_period                 if we are not past the period
+         bne   digitlp
+         lda   #4                           exp_adjust += 4
+         clc
+         adc   exp_adjust
+;        bvs   error                        no overflow with p-string input
+         sta   exp_adjust
+         bra   digitlp                    loop for another digit
+
+donibble xba                            get nibble value in high bits
+         asl   a
+         asl   a
+         asl   a
+         asl   a
+         ldx   #4                       for each bit in nibble:
+bitloop  bit   mantissa+6                 if mantissa is now full
+         bpl   notfull
+         inc   full                         full = true
+         sta   extrabits                    record next bit(s) for rounding
+         lda   got_period                   if we are not past the period
+         bne   digitlp
+         txa                                  exp_adjust += number of extra bits
+         clc
+         adc   exp_adjust
+         sta   exp_adjust
+         bra   digitlp                      loop for another digit
+notfull  asl   a                          shift bit into mantissa
+         rol   mantissa
+         rol   mantissa+2
+         rol   mantissa+4
+         rol   mantissa+6
+         bit   got_period                 if we are past the period
+         bpl   nextbit
+         dec   exp_adjust                   exp_adjust-- (no overflow w/ p-str)
+nextbit  dex
+         bne   bitloop
+         bra   digitlp
+         
+normal   lda   got_digit                check that there was a mantissa digit
+         bne   chkzero
+         brl   error
+chkzero  lda   mantissa                 check if mantissa is nonzero
+         ora   mantissa+2
+         ora   mantissa+4
+         ora   mantissa+6
+         sta   nonzero                  set nonzero flag as appropriate
+         beq   do_exp                   if mantissa is nonzero, normalize:
+         lda   mantissa+6                 if high bit of mantissa is not 1:
+         bmi   do_exp                       do    
+normallp dec   exp_adjust                     exp_adjust--
+         asl   mantissa                       shift mantissa left one bit
+         rol   mantissa+2
+         rol   mantissa+4
+         rol   mantissa+6
+         bpl   normallp                     while high bit of mantissa is not 1
+         
+do_exp   jsr   nextch                   get next character
+         cmp   #'+'                     if it is '+'
+         bne   chkminus
+         jsr   nextch                     ignore it and get next char
+         bra   exploop
+chkminus cmp   #'-'                     else if it is '-'
+         bne   exploop
+         jsr   nextch                     get next character
+         inc   negate_exp                 flag that exponent is negative
+exploop  jsr   decdigit                 for each exponent digit
+         asl   exp                        exp = exp*10 + digit
+         pei   exp
+         bcs   bigexp
+         bmi   bigexp
+         asl   exp
+         asl   exp
+         bcs   bigexp
+         bmi   bigexp
+         adc   1,s
+         bvs   bigexp
+         clc
+         adc   exp
+         bvs   bigexp
+         sta   exp
+         pla
+         jsr   nextch
+         bpl   exploop
+         bra   neg_exp
+bigexp   pla
+         lda   #$7fff                   if exponent value overflows
+         sta   exp                        exp = INT_MAX
+bigexplp jsr   nextch
+         bpl   bigexplp
+neg_exp  lda   negate_exp               if exponent is negative
+         beq   finalexp
+         lda   exp                        negate exp
+         eor   #$ffff
+         inc   a
+         sta   exp
+finalexp lda   exp                      add in exponent adjustment
+         clc
+         adc   exp_adjust
+         bvc   expdone                  if addition overflows
+         lda   #$7fff                     positive exponent -> INT_MAX
+         ldx   negate_exp
+         beq   expdone
+         inc   a                          negative exponent -> INT_MIN
+expdone  ldx   nonzero                  if value is zero
+         bne   bias
+         txa                              exponent field = 0
+         bra   storeexp
+
+bias     clc                            else
+         adc   #16383                     compute biased exp. [-16385..49150]
+storeexp sta   exp
+         cmp   #32767                   if it is [0..32766], it is valid
+         blt   round
+         cmp   #32767+16383+1           if it is larger, generate an infinity
+         blt   inf                      otherwise, denormalize:
+denormlp lsr   mantissa+6               while biased exponent is negative:
+         ror   mantissa+4                 shift mantissa left one bit
+         ror   mantissa+2
+         ror   mantissa
+         ror   extrabits                  adjust extrabits
+         bcc   dn_next
+         lda   extrabits
+         ora   #1
+         sta   extrabits
+dn_next  inc   exp                        exp++
+         bmi   denormlp
+         
+round    lda   extrabits                implement SANE/IEEE round-to-nearest:
+         cmp   #$8000                   if less than halfway to next number
+         blt   done                       return value as-is
+         bne   roundup                  if more than halfway to next: round up
+         lda   mantissa                 if exactly halfway to next number
+         lsr   a                          if least significant bit is 0
+         bcc   done                         return value as-is
+roundup  inc   mantissa                 otherwise, round up to next number:
+         bne   done                       increment mantissa
+         inc   mantissa+2
+         bne   done
+         inc   mantissa+4
+         bne   done
+         inc   mantissa+6
+         bne   done
+         lda   #$8000                     if mantissa overflowed:
+         sta   mantissa+6                   mantissa = 1.0
+         inc   exp                          exp++ (could generate an infinity)
+
+done     jsr   nextch                   if we have not consumed the full input
+         bpl   error                      flag an error
+         lda   mantissa                 done: store return value
+         sta   >retval
+         lda   mantissa+2
+         sta   >retval+2
+         lda   mantissa+4
+         sta   >retval+4
+         lda   mantissa+6
+         sta   >retval+6
+         lda   exp
+         sta   >retval+8
+         bra   ret
+
+inf      lda   #32767                   infinity: exponent field = 32767
+         sta   >retval+8                mantissa = 1.0
+         inc   a
+         sta   >retval+6
+         asl   a
+         sta   >retval+4
+         sta   >retval+2
+         sta   >retval+0
+         bra   ret
+         
+error    lda   #32767                   bad input: return NANASCBIN
+         sta   >retval+8
+         lda   #$C011
+         sta   >retval+6
+         lda   #0
+         sta   >retval+4
+         sta   >retval+2
+         sta   >retval
+         
+ret      lda   #retval
+         sta   str
+         lda   #^retval
+         sta   str+2
+
+         return 4:str
+
+;get next character of string, or -1 if none (nz flags also set based on value)
+nextch   cpy   end_idx
+         bge   no_ch
+         lda   [str],y
+         iny
+         and   #$00FF
+         rts
+no_ch    lda   #-1
+         rts
+
+;get value of A, taken as a hex digit
+;branches to error if it is not a valid digit
+hexdigit cmp   #'0'
+         blt   baddigit
+         cmp   #'9'+1
+         bge   letter
+         and   #$000F
+         rts
+letter   and   #$df
+         cmp   #'A'
+         blt   baddigit
+         cmp   #'F'+1
+         bge   baddigit
+         and   #$000F
+         adc   #9
+         rts
+
+;get value of A, taken as a decimal digit
+;branches to error if it is not a valid digit
+decdigit cmp   #'0'
+         blt   baddigit
+         cmp   #'9'+1
+         bge   baddigit
+         and   #$000F
+         rts
+baddigit pla
+         brl   error
+
+retval   ds    10
+         end
+
+
 ****************************************************************
 *
 *  Convertsl - Convert a string to a long integer
@@ -53,6 +353,54 @@ lb2      iny                            next character
          return 4:val
          end
 
+****************************************************************
+*
+*  Convertsll - Convert a string to a long long integer
+*
+*  Inputs:
+*        qval - pointer to location to save value
+*        str - pointer to the string
+*
+*  Outputs:
+*        Saves the value to [qval].
+*
+*  Notes:
+*        Assumes the string is valid.
+*
+****************************************************************
+*
+Convertsll start scanner
+disp     equ   0                        displacement into the string
+count    equ   2                        number of characters remaining to read
+
+         subroutine (4:qval,4:str),4
+
+         lda   [str]                    set count to length of string
+         and   #$00FF
+         sta   count
+         lda   #1                       start reading from character 1
+         sta   disp
+         ph8   #0                       initialize the number to zero
+         bra   lb1a
+lb1      ph8   #10                      multiply by 10
+         jsl   ~UMUL8
+lb1a     pea   $0000
+         pea   $0000
+         pea   $0000
+         ldy   disp
+         lda   [str],Y                  add in the new digit
+         and   #$000F
+         pha
+         jsl   ~ADD8
+lb2      inc   disp                     next character
+         dec   count
+         bne   lb1
+
+         pl8   [qval]                   save the value
+
+         return
+         end
+
 ****************************************************************
 *
 *  KeyPress - Has a key been pressed?
@@ -64,16 +412,16 @@ lb2      iny                            next character
 *
 ****************************************************************
 *
-KeyPress start
+KeyPress start scanner
 
          KeyPressGS kpRec
-         lda   kpAvailable
+         lda   >kpAvailable
          beq   rts
          ReadKeyGS rkRec
-         lda   rkKey
+         lda   >rkKey
          cmp   #'.'
          bne   lb1
-         lda   rkModifiers
+         lda   >rkModifiers
          and   #$0100
          beq   lb1
          ph2   #4
@@ -98,6 +446,7 @@ rkModifiers ds 2
 *
 *  Outputs:
 *        ch - character read
+*        currentChPtr - pointer to ch in source file
 *
 ****************************************************************
 *
@@ -116,8 +465,9 @@ 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
          sec
          sbc   #stackFrameSize
@@ -144,21 +494,24 @@ pf1      dey
 pf2      sty   lastWasReturn
 ! 1:
 lab1     anop
+! currentChPtr := chPtr;
 ! if chPtr = eofPtr then begin          {flag end of file if we're there}
          lda   chPtr
+         sta   currentChPtr
+         ldx   chPtr+2
+         stx   currentChPtr+2
          cmp   eofPtr
          bne   la1
-         lda   chPtr+2
-         cmp   eofPtr+2
+         cpx   eofPtr+2
          beq   la2
 la1      brl   lb5
 la2      anop
 !    if not lastWasReturn then begin
-!      lastWasReturn := true;
-!      needWriteLine := true;
-!      ch := chr(eolChar);
-!      goto le2;
-!      end; {if}
+!       lastWasReturn := true;
+!       needWriteLine := true;
+!       ch := chr(eolChar);
+!       goto le2;
+!       end; {if}
          lda   lastWasReturn
          bne   la3
          lda   #1
@@ -167,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;
@@ -180,7 +535,7 @@ la3      stz   ch
          beq   lb1
          jsl   WriteLine
          stz   wroteLine
-         inc   lineNumber
+         inc4  lineNumber
          move4 chPtr,firstPtr
 lb1      anop
 
@@ -195,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;
@@ -229,10 +591,17 @@ lb4      lda   [p1],Y
          dey
          bpl   lb4
          long  M
+!       changedSourceFile := true;
+         lda   #1
+         sta   changedSourceFile
 !       lineNumber := fp^.lineNumber;
          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);
@@ -240,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
@@ -261,15 +630,21 @@ 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}
 
 ! else begin
 lb5      anop
 !    ch := chr(chPtr^);                 {fetch the character}
-         move4 chPtr,p1
+         sta   p1
+         stx   p1+2
          lda   [p1]
          and   #$00FF
          sta   ch
@@ -284,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;
@@ -370,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);
@@ -385,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
@@ -408,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);
@@ -522,7 +913,7 @@ le1      sta   ch
 !          goto 2;
          brl   lab2
 !          end; {if}
-!       end; {if}
+!       end; {else if}
 !    end; {else}
 le2      anop
          pld
@@ -560,22 +951,24 @@ db1      sta   p1
          and   #$00FF
          cmp   #$07
          bne   db2
-!   debugType := break
+!    debugType := break;
          lda   #break
          sta   debugType
+!    chPtr := pointer(ord4(chPtr) + 1);
+!    end {else if}
          bra   db3
-! else if ord(chPtr^) = $06 then
+! else if ord(chPtr^) = $06 then begin
 db2      cmp   #$06
          bne   db4
-!   debugType := autoGo;
+!    debugType := autoGo;
          lda   #autoGo
          sta   debugType
 !    chPtr := pointer(ord4(chPtr) + 1);
 db3      inc4  chPtr
-!    end {if}
+!    end {else if}
          bra   db5
 ! else
-!   debugType := stop;
+!    debugType := stop;
 db4      stz   debugType
 ! end; {DebugCheck}
 db5      rts
@@ -591,7 +984,7 @@ db5      rts
 *
 ****************************************************************
 *
-SetDateTime private
+SetDateTime private scanner
 
          pha                            get the date/time
          pha
@@ -601,13 +994,13 @@ SetDateTime private
          lda   1,S                      set the minutes
          xba
          jsr   convert
-         sta   time+5
+         sta   >time+5
          pla                            set the seconds
          jsr   convert
-         sta   time+8
+         sta   >time+8
          lda   1,S                      set the hour
          jsr   convert
-         sta   time+2
+         sta   >time+2
          pla                            set the year
          xba
          and   #$00FF
@@ -620,10 +1013,10 @@ yearloop sec
 yeardone clc
          adc   #100
          jsr   convert
-         sta   date+11
+         sta   >date+11
          tya
          jsr   convert
-         sta   date+9
+         sta   >date+9
          lda   1,S                      set the day
          inc   A
          jsr   convert
@@ -632,17 +1025,17 @@ yeardone clc
          bne   dateOK
          lda   #' '
 dateOK   long  M
-         sta   date+6
+         sta   >date+6
          pla                            set the month
          xba
          and   #$00FF
          asl   A
          asl   A
          tax
-         lda   month,X
-         sta   date+2
-         lda   month+1,X
-         sta   date+3
+         lda   >month,X
+         sta   >date+2
+         lda   >month+1,X
+         sta   >date+3
          pla
          lla   timeStr,time             set the addresses
          lla   dateStr,date

Scanner.macros

@@ -529,3 +529,155 @@
  dc i4'&p'
  ~restm
  mend
+ macro
+&l ph8 &n1
+ lclc &c
+&l anop
+&c amid &n1,1,1
+ aif s:longa=1,.a
+ rep #%00100000
+.a
+ aif "&c"="#",.d
+ aif "&c"="[",.b
+ aif "&c"<>"{",.c
+&c amid &n1,l:&n1,1
+ aif "&c"<>"}",.g
+&n1 amid &n1,2,l:&n1-2
+&n1 setc (&n1)
+.b
+ ldy #6
+~&SYSCNT lda &n1,y
+ pha
+ dey
+ dey
+ bpl ~&SYSCNT
+ ago .e
+.c
+ aif "&c"<>"<",.c1
+ pei &n1+6
+ pei &n1+4
+ pei &n1+2
+ pei &n1
+ ago .e
+.c1
+ ldx #6
+~&SYSCNT lda &n1,x
+ pha
+ dex
+ dex
+ bpl ~&SYSCNT
+ ago .e
+.d
+&n1 amid &n1,2,l:&n1-1
+ pea +(&n1)|-48
+ pea +(&n1)|-32
+ pea +(&n1)|-16
+ pea &n1
+.e
+ aif s:longa=1,.f
+ sep #%00100000
+.f
+ mexit
+.g
+ mnote "Missing closing '}'",16
+ mend
+ macro
+&l pl8 &n1
+ lclc &c
+&l anop
+ aif s:longa=1,.a
+ rep #%00100000
+.a
+&c amid &n1,1,1
+ aif "&c"<>"{",.b
+&c amid &n1,l:&n1,1
+ aif "&c"<>"}",.f
+&n1 amid &n1,2,l:&n1-2
+ pla
+ sta (&n1)
+ ldy #2
+ pla
+ sta (&n1),y
+ ldy #4
+ pla
+ sta (&n1),y
+ ldy #6
+ pla
+ sta (&n1),y
+ ago .d
+.b
+ aif "&c"<>"[",.c
+ pla
+ sta &n1
+ ldy #2
+ pla
+ sta &n1,y
+ ldy #4
+ pla
+ sta &n1,y
+ ldy #6
+ pla
+ sta &n1,y
+ ago .d
+.c
+ pla
+ sta &n1
+ pla
+ sta &n1+2
+ pla
+ sta &n1+4
+ pla
+ sta &n1+6
+.d
+ aif s:longa=1,.e
+ sep #%00100000
+.e
+ mexit
+.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