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

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

/* SCHEME->C */

#include <objects.h>

DEFSTRING( t1190, "(define-constant ~s ~s)~%", 25 );
DEFSTATICTSCP2( c1184, t1190 );
DEFSTRING( t1191, ".sch", 4 );
DEFSTATICTSCP2( c1159, t1191 );
DEFSTRING( t1192, "(define ~s ~s)~%", 16 );
DEFSTATICTSCP2( c1158, t1192 );
DEFSTRING( t1193, "(module ~a)~%~%", 15 );
DEFSTATICTSCP2( c1134, t1193 );
DEFSTRING( t1194, ".sc", 3 );
DEFSTATICTSCP2( c1132, t1194 );
DEFSTRING( t1195, "Undefined constant: ~s", 22 );
DEFSTATICTSCP2( c1122, t1195 );
DEFSTRING( t1196, "Argument not a PAIR: ~s", 23 );
DEFSTATICTSCP2( c1102, t1196 );
DEFSTRING( t1197, "SET-CDR!", 8 );
DEFSTATICTSCP( c1101 );
DEFSTRING( t1198, "Undefined function: ~s", 22 );
DEFSTATICTSCP2( c1066, t1198 );
DEFSTRING( t1199, "CONST-VALUE", 11 );
DEFSTATICTSCP( c1065 );
DEFSTRING( t1200, "CONST", 5 );
DEFSTATICTSCP( c1033 );
DEFSTRING( t1201, "Illegal syntax: ~s", 18 );
DEFSTATICTSCP2( c1030, t1201 );
DEFSTRING( t1202, "INPUT-CONST", 11 );
DEFSTATICTSCP( c1029 );

static void  init_constants()
{
        c1101 = STRINGTOSYMBOL( U_TX( ADR( t1197 ) ) );
        CONSTANTEXP( ADR( c1101 ) );
        c1065 = STRINGTOSYMBOL( U_TX( ADR( t1199 ) ) );
        CONSTANTEXP( ADR( c1065 ) );
        c1033 = STRINGTOSYMBOL( U_TX( ADR( t1200 ) ) );
        CONSTANTEXP( ADR( c1033 ) );
        c1029 = STRINGTOSYMBOL( U_TX( ADR( t1202 ) ) );
        CONSTANTEXP( ADR( c1029 ) );
}

DEFTSCP( const_input_2dconst_v );
DEFSTRING( t1203, "INPUT-CONST", 11 );
EXTERNTSCPP( scrt1_length );
EXTERNTSCP( scrt1_length_v );
EXTERNTSCPP( scrt2__3d_2dtwo );
EXTERNTSCP( scrt2__3d_2dtwo_v );
EXTERNTSCPP( scrt1__24__cdr_2derror );
EXTERNTSCP( scrt1__24__cdr_2derror_v );
EXTERNTSCPP( scrt1__24__car_2derror );
EXTERNTSCP( scrt1__24__car_2derror_v );
EXTERNTSCPP( scrt2_putprop );
EXTERNTSCP( scrt2_putprop_v );
EXTERNTSCPP( scrt6_error );
EXTERNTSCP( scrt6_error_v );

TSCP  const_input_2dconst( e1002 )
        TSCP  e1002;
{
        TSCP  X4, X3, X2, X1;

        PUSHSTACKTRACE( U_TX( ADR( t1203 ) ) );
        X2 = scrt1_length( e1002 );
        if  ( BITAND( BITOR( INT( X2 ), INT( _TSCP( 12 ) ) ), 
                      3 ) )  goto  L1206;
        X1 = BOOLEAN( EQ( UNSIGNED( X2 ), 
                          UNSIGNED( _TSCP( 12 ) ) ) );
        goto L1207;
L1206:
        X1 = scrt2__3d_2dtwo( X2, _TSCP( 12 ) );
L1207:
        if  ( FALSE( X1 ) )  goto  L1229;
        if  ( EQ( TSCPTAG( e1002 ), PAIRTAG ) )  goto  L1215;
        scrt1__24__cdr_2derror( e1002 );
L1215:
        X3 = PAIR_CDR( e1002 );
        if  ( EQ( TSCPTAG( X3 ), PAIRTAG ) )  goto  L1218;
        scrt1__24__car_2derror( X3 );
L1218:
        X2 = PAIR_CAR( X3 );
        if  ( NOT( AND( EQ( TSCPTAG( X2 ), EXTENDEDTAG ), 
                        EQ( TSCP_EXTENDEDTAG( X2 ), SYMBOLTAG ) ) )
            )  goto  L1229;
        X3 = PAIR_CDR( e1002 );
        if  ( EQ( TSCPTAG( X3 ), PAIRTAG ) )  goto  L1222;
        scrt1__24__car_2derror( X3 );
L1222:
        X2 = PAIR_CAR( X3 );
        X4 = PAIR_CDR( e1002 );
        if  ( EQ( TSCPTAG( X4 ), PAIRTAG ) )  goto  L1227;
        scrt1__24__cdr_2derror( X4 );
L1227:
        X3 = PAIR_CDR( X4 );
        scrt2_putprop( X2, c1033, X3 );
        POPSTACKTRACE( X2 );
L1229:
        POPSTACKTRACE( scrt6_error( c1029, 
                                    c1030, 
                                    CONS( e1002, EMPTYLIST ) ) );
}

DEFTSCP( const_const_2dvalue_v );
DEFSTRING( t1230, "CONST-VALUE", 11 );
EXTERNTSCPP( scrt2_getprop );
EXTERNTSCP( scrt2_getprop_v );
EXTERNTSCPP( scrt2_top_2dlevel_2dvalue );
EXTERNTSCP( scrt2_top_2dlevel_2dvalue_v );
EXTERNTSCPP( sc_apply_2dtwo );
EXTERNTSCP( sc_apply_2dtwo_v );
EXTERNTSCPP( const_const_2dvalue );
EXTERNTSCP( const_const_2dvalue_v );
EXTERNTSCPP( sc_cons );
EXTERNTSCP( sc_cons_v );

TSCP  const_const_2dvalue( c1056 )
        TSCP  c1056;
{
        TSCP  X9, 
              X8, X7, X6, X5, X4, X3, X2, X1;

        PUSHSTACKTRACE( U_TX( ADR( t1230 ) ) );
L1231:
        if  ( NOT( AND( EQ( TSCPTAG( c1056 ), EXTENDEDTAG ), 
                        EQ( TSCP_EXTENDEDTAG( c1056 ), SYMBOLTAG ) ) )
            )  goto  L1232;
        X1 = scrt2_getprop( c1056, c1033 );
        if  ( FALSE( X1 ) )  goto  L1235;
        if  ( EQ( TSCPTAG( X1 ), PAIRTAG ) )  goto  L1238;
        scrt1__24__car_2derror( X1 );
L1238:
        c1056 = PAIR_CAR( X1 );
        goto L1231;
L1235:
        POPSTACKTRACE( scrt6_error( c1065, 
                                    c1122, 
                                    CONS( c1056, EMPTYLIST ) ) );
L1232:
        if  ( NEQ( TSCPTAG( c1056 ), PAIRTAG ) )  goto  L1240;
        X2 = PAIR_CAR( c1056 );
        X1 = scrt2_top_2dlevel_2dvalue( X2 );
        if  ( NOT( AND( EQ( TSCPTAG( X1 ), EXTENDEDTAG ), 
                        EQ( TSCP_EXTENDEDTAG( X1 ), PROCEDURETAG ) ) )
            )  goto  L1244;
        X3 = PAIR_CDR( c1056 );
        X4 = X3;
        X5 = EMPTYLIST;
        X6 = EMPTYLIST;
L1249:
        if  ( NEQ( UNSIGNED( X4 ), UNSIGNED( EMPTYLIST ) ) )  goto  L1250;
        X2 = X5;
        goto L1257;
L1250:
        if  ( EQ( TSCPTAG( X4 ), PAIRTAG ) )  goto  L1253;
        scrt1__24__car_2derror( X4 );
L1253:
        X9 = PAIR_CAR( X4 );
        X8 = const_const_2dvalue( X9 );
        X7 = sc_cons( X8, EMPTYLIST );
        if  ( NEQ( UNSIGNED( X5 ), UNSIGNED( EMPTYLIST ) ) )  goto  L1256;
        X8 = PAIR_CDR( X4 );
        X6 = X7;
        X5 = X7;
        X4 = X8;
        goto L1249;
L1256:
        X8 = PAIR_CDR( X4 );
        if  ( EQ( TSCPTAG( X6 ), PAIRTAG ) )  goto  L1261;
        scrt6_error( c1101, c1102, CONS( X6, EMPTYLIST ) );
L1261:
        X6 = SETGEN( PAIR_CDR( X6 ), X7 );
        X4 = X8;
        goto L1249;
L1257:
        POPSTACKTRACE( sc_apply_2dtwo( X1, X2 ) );
L1244:
        POPSTACKTRACE( scrt6_error( c1065, 
                                    c1066, 
                                    CONS( PAIR_CAR( c1056 ), 
                                          EMPTYLIST ) ) );
L1240:
        POPSTACKTRACE( c1056 );
}

DEFTSCP( const_emit_2dconsts_v );
DEFSTRING( t1264, "EMIT-CONSTS", 11 );
EXTERNTSCPP( scrt5_dto_2dfile_6f7edfd9 );
EXTERNTSCP( scrt5_dto_2dfile_6f7edfd9_v );
EXTERNTSCPP( scrt3_string_2dappend );
EXTERNTSCP( scrt3_string_2dappend_v );
DEFSTRING( t1267, "const_l1133 [inside EMIT-CONSTS]", 32 );
EXTERNTSCPP( scrt6_format );
EXTERNTSCP( scrt6_format_v );
EXTERNTSCPP( scrt1_memq );
EXTERNTSCP( scrt1_memq_v );

TSCP  const_l1133( c1266 )
        TSCP  c1266;
{
        TSCP  X8, X7, X6, X5, X4, X3, X2, X1;

        PUSHSTACKTRACE( U_TX( ADR( t1267 ) ) );
        X1 = DISPLAY( 2 );
        DISPLAY( 2 ) = CLOSURE_VAR( c1266, 0 );
        X2 = DISPLAY( 0 );
        DISPLAY( 0 ) = CLOSURE_VAR( c1266, 1 );
        X3 = DISPLAY( 1 );
        DISPLAY( 1 ) = CLOSURE_VAR( c1266, 2 );
        X5 = CONS( DISPLAY( 2 ), EMPTYLIST );
        scrt6_format( TRUEVALUE, CONS( c1134, X5 ) );
        X5 = DISPLAY( 0 );
        X6 = X5;
L1271:
        if  ( NEQ( UNSIGNED( X6 ), UNSIGNED( EMPTYLIST ) ) )  goto  L1272;
        X4 = FALSEVALUE;
        goto L1273;
L1272:
        if  ( EQ( TSCPTAG( X6 ), PAIRTAG ) )  goto  L1276;
        scrt1__24__car_2derror( X6 );
L1276:
        X7 = PAIR_CAR( X6 );
        if  ( TRUE( scrt1_memq( X7, DISPLAY( 1 ) ) ) )  goto  L1279;
        X8 = CONS( const_const_2dvalue( X7 ), EMPTYLIST );
        X8 = CONS( X7, X8 );
        scrt6_format( TRUEVALUE, CONS( c1158, X8 ) );
L1279:
        X6 = PAIR_CDR( X6 );
        goto L1271;
L1273:
        DISPLAY( 2 ) = X1;
        DISPLAY( 0 ) = X2;
        DISPLAY( 1 ) = X3;
        POPSTACKTRACE( X4 );
}

DEFSTRING( t1283, "const_l1160 [inside EMIT-CONSTS]", 32 );

TSCP  const_l1160( c1282 )
        TSCP  c1282;
{
        TSCP  X7, X6, X5, X4, X3, X2, X1;

        PUSHSTACKTRACE( U_TX( ADR( t1283 ) ) );
        X1 = DISPLAY( 0 );
        DISPLAY( 0 ) = CLOSURE_VAR( c1282, 0 );
        X2 = DISPLAY( 1 );
        DISPLAY( 1 ) = CLOSURE_VAR( c1282, 1 );
        X4 = DISPLAY( 0 );
        X5 = X4;
L1287:
        if  ( NEQ( UNSIGNED( X5 ), UNSIGNED( EMPTYLIST ) ) )  goto  L1288;
        X3 = FALSEVALUE;
        goto L1289;
L1288:
        if  ( EQ( TSCPTAG( X5 ), PAIRTAG ) )  goto  L1292;
        scrt1__24__car_2derror( X5 );
L1292:
        X6 = PAIR_CAR( X5 );
        if  ( TRUE( scrt1_memq( X6, DISPLAY( 1 ) ) ) )  goto  L1295;
        X7 = CONS( const_const_2dvalue( X6 ), EMPTYLIST );
        X7 = CONS( X6, X7 );
        scrt6_format( TRUEVALUE, CONS( c1184, X7 ) );
L1295:
        X5 = PAIR_CDR( X5 );
        goto L1287;
L1289:
        DISPLAY( 0 ) = X1;
        DISPLAY( 1 ) = X2;
        POPSTACKTRACE( X3 );
}

TSCP  const_emit_2dconsts( c1129, d1130, c1131 )
        TSCP  c1129, d1130, c1131;
{
        TSCP  X2, X1;
        TSCP  SD0 = DISPLAY( 0 );
        TSCP  SD1 = DISPLAY( 1 );
        TSCP  SD2 = DISPLAY( 2 );
        TSCP  SDVAL;

        PUSHSTACKTRACE( U_TX( ADR( t1264 ) ) );
        DISPLAY( 0 ) = c1129;
        DISPLAY( 1 ) = d1130;
        DISPLAY( 2 ) = c1131;
        X2 = CONS( c1132, EMPTYLIST );
        X1 = scrt3_string_2dappend( CONS( DISPLAY( 2 ), X2 ) );
        X2 = MAKEPROCEDURE( 0, 
                            0, 
                            const_l1133, 
                            MAKECLOSURE( EMPTYLIST, 
                                         3, 
                                         DISPLAY( 2 ), 
                                         DISPLAY( 0 ), 
                                         DISPLAY( 1 ) ) );
        scrt5_dto_2dfile_6f7edfd9( X1, X2 );
        X2 = CONS( c1159, EMPTYLIST );
        X1 = scrt3_string_2dappend( CONS( DISPLAY( 2 ), X2 ) );
        X2 = MAKEPROCEDURE( 0, 
                            0, 
                            const_l1160, 
                            MAKECLOSURE( EMPTYLIST, 
                                         2, 
                                         DISPLAY( 0 ), 
                                         DISPLAY( 1 ) ) );
        SDVAL = scrt5_dto_2dfile_6f7edfd9( X1, X2 );
        DISPLAY( 0 ) = SD0;
        DISPLAY( 1 ) = SD1;
        DISPLAY( 2 ) = SD2;
        POPSTACKTRACE( SDVAL );
}

static void  init_modules( compiler_version )
        char *compiler_version;
{
        scrt3__init();
        scrt5__init();
        scrt6__init();
        scrt2__init();
        scrt1__init();
        MAXDISPLAY( 3 );
}

void  const__init()
{
        static int  init = 0;
        if  (init)  return;
        init = 1;
        INITHEAP( 0, 0, 0, 0 );
        init_constants();
        init_modules( "(const SCHEME->C COMPILER 28sep90jfb)" );
        INITIALIZEVAR( U_TX( ADR( t1203 ) ), 
                       ADR( const_input_2dconst_v ), 
                       MAKEPROCEDURE( 1, 
                                      0, 
                                      const_input_2dconst, EMPTYLIST ) );
        INITIALIZEVAR( U_TX( ADR( t1230 ) ), 
                       ADR( const_const_2dvalue_v ), 
                       MAKEPROCEDURE( 1, 
                                      0, 
                                      const_const_2dvalue, EMPTYLIST ) );
        INITIALIZEVAR( U_TX( ADR( t1264 ) ), 
                       ADR( const_emit_2dconsts_v ), 
                       MAKEPROCEDURE( 3, 
                                      0, 
                                      const_emit_2dconsts, EMPTYLIST ) );
        return;
}

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