ftp.nice.ch/pub/next/developer/languages/translator/schemetoc.s.tar.gz#/schemetoc/xlib/xarc.c

This is xarc.c in view mode; [Download] [Up]

/* SCHEME->C */

#include <objects.h>

DEFSTRING( t1690, 
           "Argument not an unsigned 8-bit INTEGER: ~s", 42 );
DEFSTATICTSCP2( c1627, t1690 );
DEFSTRING( t1691, "INTEGER->CHAR", 13 );
DEFSTATICTSCP( c1626 );
DEFSTRING( t1692, "XARCP", 5 );
DEFSTATICTSCP( c1598 );

static void  init_constants()
{
        c1626 = STRINGTOSYMBOL( U_TX( ADR( t1691 ) ) );
        CONSTANTEXP( ADR( c1626 ) );
        c1598 = STRINGTOSYMBOL( U_TX( ADR( t1692 ) ) );
        CONSTANTEXP( ADR( c1598 ) );
}

DEFTSCP( xarc_make_2dxarc_v );
DEFSTRING( t1693, "MAKE-XARC", 9 );
EXTERNTSCPP( sc_cons );
EXTERNTSCP( sc_cons_v );
EXTERNTSCPP( sc_make_2dstring );
EXTERNTSCP( sc_make_2dstring_v );
EXTERNTSCPP( scrt2__3c_2dtwo );
EXTERNTSCP( scrt2__3c_2dtwo_v );
EXTERNTSCPP( scrt2__3e_2dtwo );
EXTERNTSCP( scrt2__3e_2dtwo_v );
EXTERNTSCPP( scrt6_error );
EXTERNTSCP( scrt6_error_v );

TSCP  xarc_make_2dxarc(  )
{
        TSCP  X4, X3, X2, X1;

        X3 = BOOLEAN( NEQ( TSCPTAG( _TSCP( 0 ) ), FIXNUMTAG ) );
        if  ( TRUE( X3 ) )  goto  L1700;
        if  ( BITAND( BITOR( INT( _TSCP( 0 ) ), 
                             INT( _TSCP( 0 ) ) ), 
                      3 ) )  goto  L1701;
        X4 = BOOLEAN( LT( INT( _TSCP( 0 ) ), 
                          INT( _TSCP( 0 ) ) ) );
        goto L1702;
L1701:
        X4 = scrt2__3c_2dtwo( _TSCP( 0 ), _TSCP( 0 ) );
L1702:
        if  ( TRUE( X4 ) )  goto  L1700;
        if  ( BITAND( BITOR( INT( _TSCP( 0 ) ), 
                             INT( _TSCP( 1020 ) ) ), 
                      3 ) )  goto  L1709;
        if  ( GT( INT( _TSCP( 0 ) ), INT( _TSCP( 1020 ) ) ) )  goto  L1700;
        goto L1716;
L1709:
        if  ( FALSE( scrt2__3e_2dtwo( _TSCP( 0 ), _TSCP( 1020 ) ) )
            )  goto  L1716;
L1700:
        scrt6_error( c1626, 
                     c1627, CONS( _TSCP( 0 ), EMPTYLIST ) );
L1716:
        X1 = sc_make_2dstring( _TSCP( 48 ), 
                               CONS( FIX_CHAR( _TSCP( 0 ) ), 
                                     EMPTYLIST ) );
        return( sc_cons( c1598, X1 ) );
}

DEFTSCP( xarc_xarc_2dx_v );
DEFSTRING( t1717, "XARC-X", 6 );
EXTERNTSCPP( scrt4_c_2dshortint_2dref );
EXTERNTSCP( scrt4_c_2dshortint_2dref_v );
EXTERNTSCPP( xlibtypes_chk_2dxarcp );
EXTERNTSCP( xlibtypes_chk_2dxarcp_v );

TSCP  xarc_xarc_2dx( x1630 )
        TSCP  x1630;
{
        TSCP  X1;

        X1 = xlibtypes_chk_2dxarcp( x1630 );
        return( scrt4_c_2dshortint_2dref( X1, _TSCP( 0 ) ) );
}

DEFTSCP( xarc_xarc_2dx_21_v );
DEFSTRING( t1719, "XARC-X!", 7 );
EXTERNTSCPP( scrt4_c_2dshortint_2dset_21 );
EXTERNTSCP( scrt4_c_2dshortint_2dset_21_v );

TSCP  xarc_xarc_2dx_21( x1633, y1634 )
        TSCP  x1633, y1634;
{
        TSCP  X1;

        X1 = xlibtypes_chk_2dxarcp( x1633 );
        return( scrt4_c_2dshortint_2dset_21( X1, _TSCP( 0 ), y1634 ) );
}

DEFTSCP( xarc_xarc_2dy_v );
DEFSTRING( t1721, "XARC-Y", 6 );

TSCP  xarc_xarc_2dy( x1637 )
        TSCP  x1637;
{
        TSCP  X1;

        X1 = xlibtypes_chk_2dxarcp( x1637 );
        return( scrt4_c_2dshortint_2dref( X1, _TSCP( 8 ) ) );
}

DEFTSCP( xarc_xarc_2dy_21_v );
DEFSTRING( t1723, "XARC-Y!", 7 );

TSCP  xarc_xarc_2dy_21( x1641, y1642 )
        TSCP  x1641, y1642;
{
        TSCP  X1;

        X1 = xlibtypes_chk_2dxarcp( x1641 );
        return( scrt4_c_2dshortint_2dset_21( X1, _TSCP( 8 ), y1642 ) );
}

DEFTSCP( xarc_xarc_2dwidth_v );
DEFSTRING( t1725, "XARC-WIDTH", 10 );
EXTERNTSCPP( scrt4_c_2dshortunsigned_2dref );
EXTERNTSCP( scrt4_c_2dshortunsigned_2dref_v );

TSCP  xarc_xarc_2dwidth( x1645 )
        TSCP  x1645;
{
        TSCP  X1;

        X1 = xlibtypes_chk_2dxarcp( x1645 );
        return( scrt4_c_2dshortunsigned_2dref( X1, _TSCP( 16 ) ) );
}

DEFTSCP( xarc_xarc_2dwidth_21_v );
DEFSTRING( t1727, "XARC-WIDTH!", 11 );
EXTERNTSCPP( scrt4_d_2dset_21_828269c5 );
EXTERNTSCP( scrt4_d_2dset_21_828269c5_v );

TSCP  xarc_xarc_2dwidth_21( x1649, y1650 )
        TSCP  x1649, y1650;
{
        TSCP  X1;

        X1 = xlibtypes_chk_2dxarcp( x1649 );
        return( scrt4_d_2dset_21_828269c5( X1, _TSCP( 16 ), y1650 ) );
}

DEFTSCP( xarc_xarc_2dheight_v );
DEFSTRING( t1729, "XARC-HEIGHT", 11 );

TSCP  xarc_xarc_2dheight( x1653 )
        TSCP  x1653;
{
        TSCP  X1;

        X1 = xlibtypes_chk_2dxarcp( x1653 );
        return( scrt4_c_2dshortunsigned_2dref( X1, _TSCP( 24 ) ) );
}

DEFTSCP( xarc_xarc_2dheight_21_v );
DEFSTRING( t1731, "XARC-HEIGHT!", 12 );

TSCP  xarc_xarc_2dheight_21( x1657, y1658 )
        TSCP  x1657, y1658;
{
        TSCP  X1;

        X1 = xlibtypes_chk_2dxarcp( x1657 );
        return( scrt4_d_2dset_21_828269c5( X1, _TSCP( 24 ), y1658 ) );
}

DEFTSCP( xarc_xarc_2dangle1_v );
DEFSTRING( t1733, "XARC-ANGLE1", 11 );

TSCP  xarc_xarc_2dangle1( x1661 )
        TSCP  x1661;
{
        TSCP  X1;

        X1 = xlibtypes_chk_2dxarcp( x1661 );
        return( scrt4_c_2dshortint_2dref( X1, _TSCP( 32 ) ) );
}

DEFTSCP( xarc_xarc_2dangle1_21_v );
DEFSTRING( t1735, "XARC-ANGLE1!", 12 );

TSCP  xarc_xarc_2dangle1_21( x1665, y1666 )
        TSCP  x1665, y1666;
{
        TSCP  X1;

        X1 = xlibtypes_chk_2dxarcp( x1665 );
        return( scrt4_c_2dshortint_2dset_21( X1, 
                                             _TSCP( 32 ), y1666 ) );
}

DEFTSCP( xarc_xarc_2dangle2_v );
DEFSTRING( t1737, "XARC-ANGLE2", 11 );

TSCP  xarc_xarc_2dangle2( x1669 )
        TSCP  x1669;
{
        TSCP  X1;

        X1 = xlibtypes_chk_2dxarcp( x1669 );
        return( scrt4_c_2dshortint_2dref( X1, _TSCP( 40 ) ) );
}

DEFTSCP( xarc_xarc_2dangle2_21_v );
DEFSTRING( t1739, "XARC-ANGLE2!", 12 );

TSCP  xarc_xarc_2dangle2_21( x1673, y1674 )
        TSCP  x1673, y1674;
{
        TSCP  X1;

        X1 = xlibtypes_chk_2dxarcp( x1673 );
        return( scrt4_c_2dshortint_2dset_21( X1, 
                                             _TSCP( 40 ), y1674 ) );
}

static void  init_modules( compiler_version )
        char *compiler_version;
{
        xlibtypes__init();
        scrt4__init();
        scrt6__init();
        scrt2__init();
        MAXDISPLAY( 0 );
}

void  xarc__init()
{
        static int  init = 0;
        if  (init)  return;
        init = 1;
        INITHEAP( 0, 0, 0, 0 );
        init_constants();
        init_modules( "(xarc SCHEME->C COMPILER 28sep90jfb)" );
        INITIALIZEVAR( U_TX( ADR( t1693 ) ), 
                       ADR( xarc_make_2dxarc_v ), 
                       MAKEPROCEDURE( 0, 
                                      0, 
                                      xarc_make_2dxarc, EMPTYLIST ) );
        INITIALIZEVAR( U_TX( ADR( t1717 ) ), 
                       ADR( xarc_xarc_2dx_v ), 
                       MAKEPROCEDURE( 1, 
                                      0, xarc_xarc_2dx, EMPTYLIST ) );
        INITIALIZEVAR( U_TX( ADR( t1719 ) ), 
                       ADR( xarc_xarc_2dx_21_v ), 
                       MAKEPROCEDURE( 2, 
                                      0, 
                                      xarc_xarc_2dx_21, EMPTYLIST ) );
        INITIALIZEVAR( U_TX( ADR( t1721 ) ), 
                       ADR( xarc_xarc_2dy_v ), 
                       MAKEPROCEDURE( 1, 
                                      0, xarc_xarc_2dy, EMPTYLIST ) );
        INITIALIZEVAR( U_TX( ADR( t1723 ) ), 
                       ADR( xarc_xarc_2dy_21_v ), 
                       MAKEPROCEDURE( 2, 
                                      0, 
                                      xarc_xarc_2dy_21, EMPTYLIST ) );
        INITIALIZEVAR( U_TX( ADR( t1725 ) ), 
                       ADR( xarc_xarc_2dwidth_v ), 
                       MAKEPROCEDURE( 1, 
                                      0, 
                                      xarc_xarc_2dwidth, EMPTYLIST ) );
        INITIALIZEVAR( U_TX( ADR( t1727 ) ), 
                       ADR( xarc_xarc_2dwidth_21_v ), 
                       MAKEPROCEDURE( 2, 
                                      0, 
                                      xarc_xarc_2dwidth_21, EMPTYLIST ) );
        INITIALIZEVAR( U_TX( ADR( t1729 ) ), 
                       ADR( xarc_xarc_2dheight_v ), 
                       MAKEPROCEDURE( 1, 
                                      0, 
                                      xarc_xarc_2dheight, EMPTYLIST ) );
        INITIALIZEVAR( U_TX( ADR( t1731 ) ), 
                       ADR( xarc_xarc_2dheight_21_v ), 
                       MAKEPROCEDURE( 2, 
                                      0, 
                                      xarc_xarc_2dheight_21, EMPTYLIST ) );
        INITIALIZEVAR( U_TX( ADR( t1733 ) ), 
                       ADR( xarc_xarc_2dangle1_v ), 
                       MAKEPROCEDURE( 1, 
                                      0, 
                                      xarc_xarc_2dangle1, EMPTYLIST ) );
        INITIALIZEVAR( U_TX( ADR( t1735 ) ), 
                       ADR( xarc_xarc_2dangle1_21_v ), 
                       MAKEPROCEDURE( 2, 
                                      0, 
                                      xarc_xarc_2dangle1_21, EMPTYLIST ) );
        INITIALIZEVAR( U_TX( ADR( t1737 ) ), 
                       ADR( xarc_xarc_2dangle2_v ), 
                       MAKEPROCEDURE( 1, 
                                      0, 
                                      xarc_xarc_2dangle2, EMPTYLIST ) );
        INITIALIZEVAR( U_TX( ADR( t1739 ) ), 
                       ADR( xarc_xarc_2dangle2_21_v ), 
                       MAKEPROCEDURE( 2, 
                                      0, 
                                      xarc_xarc_2dangle2_21, EMPTYLIST ) );
        return;
}

These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.