This is scexpand.c in view mode; [Download] [Up]
/* SCHEME->C */
#include <objects.h>
DEFSTRING( t1205, "*EXPANDER*", 10 );
DEFSTATICTSCP( c1134 );
DEFSTRING( t1206, "Argument not a PAIR: ~s", 23 );
DEFSTATICTSCP2( c1119, t1206 );
DEFSTRING( t1207, "SET-CDR!", 8 );
DEFSTATICTSCP( c1118 );
static void init_constants()
{
c1134 = STRINGTOSYMBOL( U_TX( ADR( t1205 ) ) );
CONSTANTEXP( ADR( c1134 ) );
c1118 = STRINGTOSYMBOL( U_TX( ADR( t1207 ) ) );
CONSTANTEXP( ADR( c1118 ) );
}
DEFTSCP( scexpand_expand_v );
DEFSTRING( t1208, "EXPAND", 6 );
EXTERNTSCPP( scexpand_initial_2dexpander );
EXTERNTSCP( scexpand_initial_2dexpander_v );
TSCP scexpand_expand( x1040 )
TSCP x1040;
{
PUSHSTACKTRACE( U_TX( ADR( t1208 ) ) );
POPSTACKTRACE( scexpand_initial_2dexpander( x1040,
scexpand_initial_2dexpander_v ) );
}
DEFTSCP( scexpand_initial_2dexpander_v );
DEFSTRING( t1210, "INITIAL-EXPANDER", 16 );
EXTERNTSCPP( scexpand_xpander_2a_1344b3ce );
EXTERNTSCP( scexpand_xpander_2a_1344b3ce_v );
EXTERNTSCPP( scexpand_expander_3f );
EXTERNTSCP( scexpand_expander_3f_v );
EXTERNTSCPP( scexpand_expander );
EXTERNTSCP( scexpand_expander_v );
EXTERNTSCPP( scexpand_xpander_2a_c7c0f66b );
EXTERNTSCP( scexpand_xpander_2a_c7c0f66b_v );
DEFSTRING( t1221, "scexpand_l1064 [inside INITIAL-EXPANDER]", 40 );
TSCP scexpand_l1064( x1065, e1066, c1220 )
TSCP x1065, e1066, c1220;
{
PUSHSTACKTRACE( U_TX( ADR( t1221 ) ) );
POPSTACKTRACE( x1065 );
}
TSCP scexpand_initial_2dexpander( x1043, e1044 )
TSCP x1043, e1044;
{
TSCP X3, X2, X1;
PUSHSTACKTRACE( U_TX( ADR( t1210 ) ) );
if ( NOT( AND( EQ( TSCPTAG( x1043 ), EXTENDEDTAG ),
EQ( TSCP_EXTENDEDTAG( x1043 ), SYMBOLTAG ) ) )
) goto L1212;
X1 = scexpand_xpander_2a_1344b3ce_v;
goto L1215;
L1212:
if ( NEQ( TSCPTAG( x1043 ), PAIRTAG ) ) goto L1214;
X3 = PAIR_CAR( x1043 );
X2 = scexpand_expander_3f( X3 );
if ( NOT( AND( EQ( TSCPTAG( X2 ), EXTENDEDTAG ),
EQ( TSCP_EXTENDEDTAG( X2 ), PROCEDURETAG ) ) )
) goto L1216;
X2 = PAIR_CAR( x1043 );
X1 = scexpand_expander( X2 );
goto L1215;
L1216:
X1 = scexpand_xpander_2a_c7c0f66b_v;
goto L1215;
L1214:
X1 = MAKEPROCEDURE( 2, 0, scexpand_l1064, EMPTYLIST );
L1215:
X2 = X1;
X2 = UNKNOWNCALL( X2, 2 );
POPSTACKTRACE( VIA( PROCEDURE_CODE( X2 ) )( x1043,
e1044,
PROCEDURE_CLOSURE( X2 ) ) );
}
DEFTSCP( scexpand_expand_2donce_v );
DEFSTRING( t1224, "EXPAND-ONCE", 11 );
DEFSTRING( t1227, "scexpand_l1071 [inside EXPAND-ONCE]", 35 );
TSCP scexpand_l1071( x1072, e1073, c1226 )
TSCP x1072, e1073, c1226;
{
PUSHSTACKTRACE( U_TX( ADR( t1227 ) ) );
POPSTACKTRACE( x1072 );
}
TSCP scexpand_expand_2donce( x1070 )
TSCP x1070;
{
TSCP X1;
PUSHSTACKTRACE( U_TX( ADR( t1224 ) ) );
X1 = MAKEPROCEDURE( 2, 0, scexpand_l1071, EMPTYLIST );
POPSTACKTRACE( scexpand_initial_2dexpander( x1070, X1 ) );
}
DEFTSCP( scexpand_xpander_2a_1344b3ce_v );
DEFSTRING( t1229, "*IDENTIFIER-EXPANDER*", 21 );
TSCP scexpand_xpander_2a_1344b3ce( x1075, e1076 )
TSCP x1075, e1076;
{
TSCP X1;
PUSHSTACKTRACE( U_TX( ADR( t1229 ) ) );
X1 = scexpand_expander( x1075 );
if ( NEQ( TSCPTAG( X1 ), PAIRTAG ) ) goto L1232;
POPSTACKTRACE( PAIR_CAR( X1 ) );
L1232:
POPSTACKTRACE( x1075 );
}
DEFTSCP( scexpand_xpander_2a_c7c0f66b_v );
DEFSTRING( t1235, "*APPLICATION-EXPANDER*", 22 );
EXTERNTSCPP( sc_cons );
EXTERNTSCP( sc_cons_v );
EXTERNTSCPP( scrt1__24__car_2derror );
EXTERNTSCP( scrt1__24__car_2derror_v );
EXTERNTSCPP( scrt6_error );
EXTERNTSCP( scrt6_error_v );
TSCP scexpand_xpander_2a_c7c0f66b( x1086, e1087 )
TSCP x1086, e1087;
{
TSCP X7, X6, X5, X4, X3, X2, X1;
PUSHSTACKTRACE( U_TX( ADR( t1235 ) ) );
X1 = x1086;
X2 = EMPTYLIST;
X3 = EMPTYLIST;
L1238:
if ( EQ( UNSIGNED( X1 ), UNSIGNED( EMPTYLIST ) ) ) goto L1239;
if ( EQ( TSCPTAG( X1 ), PAIRTAG ) ) goto L1242;
scrt1__24__car_2derror( X1 );
L1242:
X7 = PAIR_CAR( X1 );
X6 = e1087;
X6 = UNKNOWNCALL( X6, 2 );
X5 = VIA( PROCEDURE_CODE( X6 ) )( X7,
e1087,
PROCEDURE_CLOSURE( X6 ) );
X4 = sc_cons( X5, EMPTYLIST );
if ( NEQ( UNSIGNED( X2 ), UNSIGNED( EMPTYLIST ) ) ) goto L1245;
X5 = PAIR_CDR( X1 );
X3 = X4;
X2 = X4;
X1 = X5;
goto L1238;
L1245:
X5 = PAIR_CDR( X1 );
if ( EQ( TSCPTAG( X3 ), PAIRTAG ) ) goto L1250;
scrt6_error( c1118, c1119, CONS( X3, EMPTYLIST ) );
L1250:
X3 = SETGEN( PAIR_CDR( X3 ), X4 );
X1 = X5;
goto L1238;
L1239:
POPSTACKTRACE( X2 );
}
DEFTSCP( scexpand_install_2dexpander_v );
DEFSTRING( t1252, "INSTALL-EXPANDER", 16 );
EXTERNTSCPP( scrt2_putprop );
EXTERNTSCP( scrt2_putprop_v );
TSCP scexpand_install_2dexpander( k1132, f1133 )
TSCP k1132, f1133;
{
PUSHSTACKTRACE( U_TX( ADR( t1252 ) ) );
scrt2_putprop( k1132, c1134, f1133 );
POPSTACKTRACE( k1132 );
}
DEFTSCP( scexpand_expander_3f_v );
DEFSTRING( t1254, "EXPANDER?", 9 );
EXTERNTSCPP( scrt2_getprop );
EXTERNTSCP( scrt2_getprop_v );
TSCP scexpand_expander_3f( x1136 )
TSCP x1136;
{
PUSHSTACKTRACE( U_TX( ADR( t1254 ) ) );
if ( NOT( AND( EQ( TSCPTAG( x1136 ), EXTENDEDTAG ),
EQ( TSCP_EXTENDEDTAG( x1136 ), SYMBOLTAG ) ) )
) goto L1256;
POPSTACKTRACE( scrt2_getprop( x1136, c1134 ) );
L1256:
POPSTACKTRACE( FALSEVALUE );
}
DEFTSCP( scexpand_expander_v );
DEFSTRING( t1258, "EXPANDER", 8 );
TSCP scexpand_expander( x1144 )
TSCP x1144;
{
PUSHSTACKTRACE( U_TX( ADR( t1258 ) ) );
POPSTACKTRACE( scrt2_getprop( x1144, c1134 ) );
}
DEFTSCP( scexpand_islist_v );
DEFSTRING( t1260, "ISLIST", 6 );
EXTERNTSCPP( scrt2__2b_2dtwo );
EXTERNTSCP( scrt2__2b_2dtwo_v );
EXTERNTSCPP( scrt2__3e_3d_2dtwo );
EXTERNTSCP( scrt2__3e_3d_2dtwo_v );
EXTERNTSCPP( scrt2__3c_3d_2dtwo );
EXTERNTSCP( scrt2__3c_3d_2dtwo_v );
TSCP scexpand_islist( l1146, m1147, m1148 )
TSCP l1146, m1147, m1148;
{
TSCP X4, X3, X2, X1;
PUSHSTACKTRACE( U_TX( ADR( t1260 ) ) );
X1 = _TSCP( 0 );
X2 = l1146;
L1263:
if ( NEQ( TSCPTAG( X2 ), PAIRTAG ) ) goto L1264;
if ( BITAND( BITOR( INT( X1 ), INT( _TSCP( 4 ) ) ),
3 ) ) goto L1266;
X3 = _TSCP( IPLUS( INT( X1 ), INT( _TSCP( 4 ) ) ) );
goto L1267;
L1266:
X3 = scrt2__2b_2dtwo( X1, _TSCP( 4 ) );
L1267:
X2 = PAIR_CDR( X2 );
X1 = X3;
goto L1263;
L1264:
if ( NEQ( UNSIGNED( X2 ), UNSIGNED( EMPTYLIST ) ) ) goto L1269;
if ( BITAND( BITOR( INT( X1 ), INT( m1147 ) ),
3 ) ) goto L1271;
X3 = BOOLEAN( GTE( INT( X1 ), INT( m1147 ) ) );
goto L1272;
L1271:
X3 = scrt2__3e_3d_2dtwo( X1, m1147 );
L1272:
if ( FALSE( X3 ) ) goto L1274;
if ( EQ( UNSIGNED( m1148 ), UNSIGNED( EMPTYLIST ) ) ) goto L1276;
if ( EQ( TSCPTAG( m1148 ), PAIRTAG ) ) goto L1279;
scrt1__24__car_2derror( m1148 );
L1279:
X4 = PAIR_CAR( m1148 );
if ( BITAND( BITOR( INT( X1 ), INT( X4 ) ),
3 ) ) goto L1282;
POPSTACKTRACE( BOOLEAN( LTE( INT( X1 ), INT( X4 ) ) ) );
L1282:
POPSTACKTRACE( scrt2__3c_3d_2dtwo( X1, X4 ) );
L1276:
POPSTACKTRACE( TRUEVALUE );
L1274:
POPSTACKTRACE( X3 );
L1269:
POPSTACKTRACE( FALSEVALUE );
}
static void init_modules( compiler_version )
char *compiler_version;
{
scrt2__init();
scrt6__init();
scrt1__init();
MAXDISPLAY( 0 );
}
void scexpand__init()
{
static int init = 0;
if (init) return;
init = 1;
INITHEAP( 0, 0, 0, 0 );
init_constants();
init_modules( "(scexpand SCHEME->C COMPILER 28sep90jfb)" );
INITIALIZEVAR( U_TX( ADR( t1208 ) ),
ADR( scexpand_expand_v ),
MAKEPROCEDURE( 1,
0,
scexpand_expand, EMPTYLIST ) );
INITIALIZEVAR( U_TX( ADR( t1210 ) ),
ADR( scexpand_initial_2dexpander_v ),
MAKEPROCEDURE( 2,
0,
scexpand_initial_2dexpander,
EMPTYLIST ) );
INITIALIZEVAR( U_TX( ADR( t1224 ) ),
ADR( scexpand_expand_2donce_v ),
MAKEPROCEDURE( 1,
0,
scexpand_expand_2donce,
EMPTYLIST ) );
INITIALIZEVAR( U_TX( ADR( t1229 ) ),
ADR( scexpand_xpander_2a_1344b3ce_v ),
MAKEPROCEDURE( 2,
0,
scexpand_xpander_2a_1344b3ce,
EMPTYLIST ) );
INITIALIZEVAR( U_TX( ADR( t1235 ) ),
ADR( scexpand_xpander_2a_c7c0f66b_v ),
MAKEPROCEDURE( 2,
0,
scexpand_xpander_2a_c7c0f66b,
EMPTYLIST ) );
INITIALIZEVAR( U_TX( ADR( t1252 ) ),
ADR( scexpand_install_2dexpander_v ),
MAKEPROCEDURE( 2,
0,
scexpand_install_2dexpander,
EMPTYLIST ) );
INITIALIZEVAR( U_TX( ADR( t1254 ) ),
ADR( scexpand_expander_3f_v ),
MAKEPROCEDURE( 1,
0,
scexpand_expander_3f, EMPTYLIST ) );
INITIALIZEVAR( U_TX( ADR( t1258 ) ),
ADR( scexpand_expander_v ),
MAKEPROCEDURE( 1,
0,
scexpand_expander, EMPTYLIST ) );
INITIALIZEVAR( U_TX( ADR( t1260 ) ),
ADR( scexpand_islist_v ),
MAKEPROCEDURE( 2,
1,
scexpand_islist, EMPTYLIST ) );
return;
}
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.