home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / draco / draco-1.ark / OPTYPE.REF < prev    next >
Encoding:
Text File  |  1986-11-13  |  8.6 KB  |  292 lines
  1. XV. Operator Types
  2.  
  3.     The basic syntax of operator types was given previously. They will be
  4.     discussed here by means of an example, the construction of a complex
  5.     type based on integers. First, we give an include file which would be
  6.     referenced by programs wanting to use the complex number package:
  7.  
  8.     type Complex_t = ("_cmplx", struct {int c_real, c_imag},
  9.               OPADD | OPSUB | OPMUL | OPDIV | OPNEG |
  10.               OPABS | OPCPR | OPPUT | OPGET);
  11.     Complex_t I = (0, 1);
  12.  
  13.     This declares operator type 'Complex_t' which can be used with the
  14.     binary '+', '-', '*' and '/' operators, with the unary '-', and '|'
  15.     operators, which can be compared, and which can be read/written. The
  16.     type is implemented as a structure containing two integers, and the
  17.     routines the compiler will call will all start with "_cmplx". Also
  18.     declared is a complex constant, 'I', whose value is given using a
  19.     structure constant based on the base type of Complex_t. Using these
  20.     declarations, we could write the following code fragment:
  21.  
  22.     proc main()void:
  23.         Complex_t a, b, c;
  24.  
  25.         a := Complex_t(0, 0);
  26.         b := I;
  27.         write("Enter c: ");
  28.         readln(c);
  29.         if c = Complex_t(0, 0) then
  30.         c := a * I;
  31.         b := b - (a / b);
  32.         elif c < Complex_t(0, 0) then
  33.         c := -c;
  34.         fi;
  35.         writeln("New a, b, c are: ", a, b, c);
  36.     corp;
  37.  
  38.     The various 'OPxxx' names used in the above include file are bitwise
  39.     'or'ed together to produce a 16 bit value giving the operations allowed.
  40.     Definitions of these bits can be found in file "opdef.g", as follows:
  41.  
  42.     OPADD - the binary '+' operator
  43.     OPSUB - the binary '-' operator
  44.     OPMUL - the binary '*' operator
  45.     OPDIV - the binary '/' operator
  46.     OPMOD - the binary '%' operator
  47.     OPNEG - the unary '-' operator
  48.     OPABS - the unary '|' operator
  49.     OPIOR - the binary '|' operator
  50.     OPAND - the binary '&' operator
  51.     OPXOR - the binary '><' operator
  52.     OPSHL - the binary '<<' operator
  53.     OPSHR - the binary '>>' operator
  54.     OPNOT - the unary '~' operator
  55.     OPCPR - the binary comparison operators
  56.     OPPUT - text output using 'write' and 'writeln'
  57.     OPGET - text input using 'read' and 'readln'
  58.  
  59.     The operators all have their normal precedence. The various operators 
  60.     take arguments of the operator type and return a result of that type.
  61.     Exceptions to this are the shift operators, whose right operand must 
  62.     be a numeric value, and the comparison operators, which yield a boolean
  63.     result. It is suggested that any uses of operator types maintain some
  64.     semblance of relation to the operators' normal meanings.
  65.  
  66.     Only a skeleton of the definition file for the above complex type will
  67.     be shown. The important things are the calling sequences used.
  68.  
  69.     \util.g
  70.  
  71.     type Complex_t = struct {int c_real, c_imag};
  72.     word STACK_SIZE = 10;
  73.     [10] Complex_t Stack;
  74.     word StackPointer;
  75.  
  76.     /* the psh and pop routines must be provided with ALL operator type
  77.        implementations, regardless of what else is provided */
  78.  
  79.     /* _cmplxpsh - called to push a value onto our stack */
  80.  
  81.     proc _cmplxpsh(*Complex_t x)void:
  82.  
  83.         if StackPointer = STACK_SIZE then
  84.         writeln();
  85.         writeln("*** Complex_t stack overflow - aborting. ***");
  86.         exit(1);
  87.         fi;
  88.         Stack[StackPointer] := x*;
  89.         StackPointer := StackPointer + 1;
  90.     corp;
  91.  
  92.     /* _cmplxpop - pop a value from our stack. */
  93.  
  94.     proc _cmplxpop(*Complex_t x)void:
  95.  
  96.         StackPointer := StackPointer - 1;
  97.         x* := Stack[StackPointer];
  98.     corp;
  99.  
  100.     /* _cmplxadd - add the two values on top of the stack. */
  101.  
  102.     proc _cmplxadd()void:
  103.  
  104.         StackPointer := StackPointer - 1;
  105.         Stack[StackPointer - 1].c_real :=
  106.         Stack[StackPointer - 1].c_real + Stack[StackPointer].c_real;
  107.         Stack[StackPointer - 1].c_imag :=
  108.         Stack[StackPointer - 1].c_imag + Stack[StackPointer].c_imag;
  109.     corp;
  110.  
  111.     /* similar for _cmplxsub, _cmplxmul, _cmplxdiv */
  112.  
  113.     /* _cmplxneg - negate the top of stack value */
  114.  
  115.     proc _cmplxneg()void:
  116.  
  117.         Stack[StackPointer - 1].c_real :=
  118.         - Stack[StackPointer - 1].c_real;
  119.         Stack[StackPointer - 1].c_imag :=
  120.         - Stack[StackPointer - 1].c_imag;
  121.     corp;
  122.  
  123.     /* similar for _cmplxabs (if you want to define an absolute value
  124.        operator that returns a complex result - if you want a routine
  125.        that returns the integral norm, then you must pick a name for
  126.        it, implement it here, and include a declaration for it in the
  127.        include file) */
  128.  
  129.     /* _cmplxcpr - the comparison routine - return -1, +1 or 0 */
  130.  
  131.     proc _cmplxcpr()short:
  132.         int leftSquared, rightSquared;
  133.  
  134.         StackPointer := StackPointer - 1;
  135.         rightSquared := Stack[StackPointer].c_real *
  136.                 Stack[StackPointer].c_real +
  137.                 Stack[StackPointer].c_imag *
  138.                 Stack[StackPointer].c_imag;
  139.         StackPointer := StackPointer - 1;
  140.         leftSquared := Stack[StackPointer].c_real *
  141.                 Stack[StackPointer].c_real +
  142.                 Stack[StackPointer].c_imag *
  143.                 Stack[StackPointer].c_imag;
  144.         if leftSquared < rightSquared then
  145.         make(-1, short)        /* force the result type of the if */
  146.         elif leftSquared > rightSquared then
  147.         +1
  148.         else
  149.         0
  150.         fi
  151.     corp;
  152.  
  153.     /* doing read/write on operator types requires careful interaction
  154.        with the innards of Draco's run-time system. The special channel
  155.        expression '*' means "this is a call to read/write from within
  156.        a call to read/write - use the channel that is already set up".
  157.        In this situation, the read/write constructs DO NOT return a
  158.        boolean success/fail value, and an internal routine must be
  159.        called to make the check. The special routines that can be called
  160.        are as follows:
  161.  
  162.         _channelPutChar(char ch)void -
  163.         write the character on the current output text channel
  164.         _channelGetChar()char -
  165.         get the next character from the current input text channel
  166.         _channelUnGetChar(char ch) -
  167.         stuff the character back into the current input text channel.
  168.         Only ONE character may be put back this way.
  169.         _channelError(ushort errorCode)void -
  170.         assert an error with the given code (from util.g) on the
  171.         current input text channel.
  172.         _channelHadError()bool -
  173.         return 'true' if the current input text channel has had an
  174.         error during the current top-level read/readln operation.
  175.         _channelSkip()void -
  176.         skip past whitespace (blanks and tabs) in the current input
  177.         text channel.
  178.         _readln()void -
  179.         swallow the remainder of the current input line and move on
  180.         to the next input line.
  181.         _writeln()void -
  182.         terminate the current output line and move on to the next
  183.  
  184.     */
  185.  
  186.     /* _cmplxput - write a complex number out on the current channel */
  187.  
  188.     proc _cmplxput()void:
  189.  
  190.         StackPointer := StackPointer - 1;
  191.         write(*; '(', Stack[StackPointer].c_real, ", ",
  192.             Stack[StackPointer].c_imag, ')');
  193.         /* we could have also used _channelPutChar to output the single
  194.            characters - this would have been more efficient */
  195.     corp;
  196.  
  197.     /* _cmplxget - read a complex number in from the current channel */
  198.  
  199.     proc _cmplxget(*Complex_t x)void:
  200.         extern
  201.         _channelSkip()void,
  202.         _channelGetChar()char,
  203.         _channelHadError()bool,
  204.         _channelUnGetChar(char ch)void,
  205.         _channelError(ushort errorCode)void;
  206.         char ch;
  207.  
  208.         _channelSkip();
  209.         ch := _channelGetChar();
  210.         if ch = '(' then
  211.         read(*; x*.c_real);
  212.         if not _channelHadError() then
  213.             _channelSkip();
  214.             ch := _channelGetChar();
  215.             if ch = ',' then
  216.             read(*; x*.c_imag);
  217.             if not _channelHadError() then
  218.                 _channelSkip();
  219.                 ch := _channelGetChar();
  220.                 if ch ~= ')' then
  221.                 _channelUnGetChar(ch);
  222.                 _channelError(CH_BADCHAR);
  223.                 fi;
  224.             fi;
  225.             else
  226.             _channelUnGetChar(ch);
  227.             _channelError(CH_BADCHAR);
  228.             fi;
  229.         fi;
  230.         else
  231.         _channelUnGetChar(ch);
  232.         _channelError(CH_BADCHAR);
  233.         fi;
  234.     corp;
  235.  
  236.     To solidify all of this somewhat, if we have the following fragment:
  237.  
  238.     proc nonrec test()void:
  239.         Complex_t c1, c2;
  240.  
  241.         if read(c1) then
  242.         if c1 < c2 then
  243.             writeln(c1 + c2);
  244.         fi;
  245.         else
  246.         c1 := - c2;
  247.         fi;
  248.     corp;
  249.  
  250.     It would turn into something like the following (8080 version):
  251.  
  252.     test    proc
  253.     ; a bunch of extern's that I'll omit
  254.     c1    ds    4
  255.     c2    ds    4
  256.         code
  257.         lxi    h,c1
  258.         push    h
  259.         call    _setstdin
  260.         call    _cmplxget
  261.         call    _unchannel
  262.         ana    a
  263.         jnz    L2
  264.         lxi    h,c1
  265.         call    _cmplxpsh
  266.         lxi    h,c2
  267.         call    _cmplxpsh
  268.         call    _cmplxcpr
  269.         ana    a
  270.         jp    L1
  271.         lxi    h,c1
  272.         push    h
  273.         call    _cmplxpsh
  274.         lxi    h,c2
  275.         push    h
  276.         call    _cmplxpsh
  277.         call    _cmplxadd
  278.         call    _setstdout
  279.         call    _cmplxput
  280.         call    _writeln
  281.         call    _unchannel
  282.     L1    jmp    L3
  283.     L2    lxi    h,c1
  284.         push    h
  285.         lxi    h,c2
  286.         push    h
  287.         call    _cmplxpsh
  288.         call    _cmplxneg
  289.         call    _cmplxpop
  290.     L3    ret
  291.         corp
  292.