From 70de7f21d520653f0fec3fe037f898967edf7c2a Mon Sep 17 00:00:00 2001 From: "Peter B. Kessler" Date: Mon, 20 Oct 1980 02:33:08 -0800 Subject: [PATCH] guess that [] is intset if no other context information. SCCS-vsn: usr.bin/pascal/src/cset.c 1.2 SCCS-vsn: usr.bin/pascal/src/func.c 1.3 SCCS-vsn: usr.bin/pascal/src/pcfunc.c 1.3 SCCS-vsn: usr.bin/pascal/src/rval.c 1.4 --- usr/src/usr.bin/pascal/src/cset.c | 21 +++-- usr/src/usr.bin/pascal/src/func.c | 21 ++--- usr/src/usr.bin/pascal/src/pcfunc.c | 31 +++----- usr/src/usr.bin/pascal/src/rval.c | 118 +++++++++++++++------------- 4 files changed, 94 insertions(+), 97 deletions(-) diff --git a/usr/src/usr.bin/pascal/src/cset.c b/usr/src/usr.bin/pascal/src/cset.c index c14a389081..8b4349a8b0 100644 --- a/usr/src/usr.bin/pascal/src/cset.c +++ b/usr/src/usr.bin/pascal/src/cset.c @@ -1,6 +1,6 @@ /* Copyright (c) 1979 Regents of the University of California */ -static char sccsid[] = "@(#)cset.c 1.1 %G%"; +static char sccsid[] = "@(#)cset.c 1.2 %G%"; #include "whoami.h" #include "0.h" @@ -66,9 +66,21 @@ precset( r , settype , csetp ) e = r[2]; if (e == NIL) { /* - * tentative for [] + * tentative for [], return type of `intset' */ - csetp -> csettype = nl + TSET; + settype = lookup( intset ); + if ( settype == NIL ) { + panic( "empty set" ); + } + settype = settype -> type; + if ( settype == NIL ) { + return csetp -> comptime; + } + if ( isnta( settype , "t" ) ) { + error("Set default type \"intset\" is not a set"); + return csetp -> comptime; + } + csetp -> csettype = settype; return csetp -> comptime; } e = e[1]; @@ -298,9 +310,6 @@ postcset( r , csetp ) char labelname[ BUFSIZ ]; if ( csetp -> comptime ) { - if ( csetp -> csettype == nl + TSET ) { - return; - } setran( ( csetp -> csettype ) -> type ); limit = &tempset[ ( set.uprbp / BITSPERLONG ) + 1 ]; for ( lp = &tempset[0] ; lp < limit ; lp++ ) { diff --git a/usr/src/usr.bin/pascal/src/func.c b/usr/src/usr.bin/pascal/src/func.c index 4366e5635d..04c78c3350 100644 --- a/usr/src/usr.bin/pascal/src/func.c +++ b/usr/src/usr.bin/pascal/src/func.c @@ -1,6 +1,6 @@ /* Copyright (c) 1979 Regents of the University of California */ -static char sccsid[] = "@(#)func.c 1.2 %G%"; +static char sccsid[] = "@(#)func.c 1.3 %G%"; #include "whoami.h" #ifdef OBJ @@ -11,8 +11,6 @@ static char sccsid[] = "@(#)func.c 1.2 %G%"; #include "tree.h" #include "opcode.h" -bool cardempty = FALSE; - /* * Funccod generates code for * built in function calls and calls @@ -203,20 +201,11 @@ funccod(r) put1(op + (width(p1) >> 2)); return (nl+TCHAR); case O_CARD: - if ( p1 != nl + TSET ) { - if (isnta(p1, "t")) { - error("Argument to card must be a set, not %s", nameof(p1)); - return (NIL); - } - put2(O_CARD, width(p1)); - } else { - if ( !cardempty ) { - warning(); - error("Cardinality of the empty set is 0." ); - cardempty = TRUE; - } - put(1, O_CON1, 0); + if (isnta(p1, "t")) { + error("Argument to card must be a set, not %s", nameof(p1)); + return (NIL); } + put2(O_CARD, width(p1)); return (nl+T2INT); case O_EOLN: if (!text(p1)) { diff --git a/usr/src/usr.bin/pascal/src/pcfunc.c b/usr/src/usr.bin/pascal/src/pcfunc.c index 3f587326c7..e5f2dbddb1 100644 --- a/usr/src/usr.bin/pascal/src/pcfunc.c +++ b/usr/src/usr.bin/pascal/src/pcfunc.c @@ -1,6 +1,6 @@ /* Copyright (c) 1979 Regents of the University of California */ -static char sccsid[] = "@(#)pcfunc.c 1.2 %G%"; +static char sccsid[] = "@(#)pcfunc.c 1.3 %G%"; #include "whoami.h" #ifdef PC @@ -13,8 +13,6 @@ static char sccsid[] = "@(#)pcfunc.c 1.2 %G%"; #include "pc.h" #include "pcops.h" -bool cardempty = FALSE; - /* * Funccod generates code for * built in function calls and calls @@ -329,25 +327,16 @@ mathfunc: } return nl + TCHAR; case O_CARD: - if ( p1 != nl + TSET ) { - if (isnta(p1, "t")) { - error("Argument to card must be a set, not %s", nameof(p1)); - return (NIL); - } - putleaf( P2ICON , 0 , 0 - , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_CARD" ); - p1 = stkrval( (int *) argv[1] , NLNIL , LREQ ); - putleaf( P2ICON , lwidth( p1 ) , 0 , P2INT , 0 ); - putop( P2LISTOP , P2INT ); - putop( P2CALL , P2INT ); - } else { - if ( !cardempty ) { - warning(); - error("Cardinality of the empty set is 0." ); - cardempty = TRUE; - } - putleaf( P2ICON , 0 , 0 , P2INT , 0 ); + if (isnta(p1, "t")) { + error("Argument to card must be a set, not %s", nameof(p1)); + return (NIL); } + putleaf( P2ICON , 0 , 0 + , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_CARD" ); + p1 = stkrval( (int *) argv[1] , NLNIL , LREQ ); + putleaf( P2ICON , lwidth( p1 ) , 0 , P2INT , 0 ); + putop( P2LISTOP , P2INT ); + putop( P2CALL , P2INT ); return nl + T2INT; case O_EOLN: if (!text(p1)) { diff --git a/usr/src/usr.bin/pascal/src/rval.c b/usr/src/usr.bin/pascal/src/rval.c index bac37026eb..05e67eaa33 100644 --- a/usr/src/usr.bin/pascal/src/rval.c +++ b/usr/src/usr.bin/pascal/src/rval.c @@ -1,6 +1,6 @@ /* Copyright (c) 1979 Regents of the University of California */ -static char sccsid[] = "@(#)rval.c 1.3 %G%"; +static char sccsid[] = "@(#)rval.c 1.4 %G%"; #include "whoami.h" #include "0.h" @@ -13,7 +13,6 @@ static char sccsid[] = "@(#)rval.c 1.3 %G%"; #endif PC extern char *opnames[]; -bool inempty = FALSE; #ifdef PC char *relts[] = { @@ -487,23 +486,28 @@ cstrng: case T_SUB: # ifdef OBJ /* - * If the context hasn't told us - * the type and a constant set is - * present on the left we need to infer - * the type from the right if possible - * before generating left side code. + * If the context hasn't told us the type + * and a constant set is present + * we need to infer the type + * before generating code. */ - if (contype == NIL && (rt = r[2]) != NIL && rt[1] == SAWCON) { + if ( contype == NIL ) { codeoff(); - contype = rvalue(r[3], NIL , RREQ ); + contype = rvalue( r[3] , NIL , RREQ ); codeon(); - if (contype == NIL) - return (NIL); + if ( contype == lookup( intset ) -> type ) { + codeoff(); + contype = rvalue( r[2] , NIL , RREQ ); + codeon(); + } } - p = rvalue(r[2], contype , RREQ ); - p1 = rvalue(r[3], p , RREQ ); - if (p == NIL || p1 == NIL) - return (NIL); + if ( contype == NIL ) { + return NIL; + } + p = rvalue( r[2] , contype , RREQ ); + p1 = rvalue( r[3] , p , RREQ ); + if ( p == NIL || p1 == NIL ) + return NIL; if (isa(p, "id") && isa(p1, "id")) return (gen(NIL, r[0], width(p), width(p1))); if (isa(p, "t") && isa(p1, "t")) { @@ -555,17 +559,28 @@ cstrng: , ADDTYPE( ADDTYPE( P2PTR | P2STRTY , P2FTN ) , P2PTR ) , setop[ r[0] - T_MULT ] ); - /* - * allocate a temporary and use it - */ - sizes[ cbn ].om_off -= lwidth( p1 ); + if ( contype == NIL ) { + contype = p1; + if ( contype == lookup( intset ) -> type ) { + codeoff(); + contype = rvalue( r[2] , NIL , LREQ ); + codeon(); + } + } + if ( contype == NIL ) { + return NIL; + } + /* + * allocate a temporary and use it + */ + sizes[ cbn ].om_off -= lwidth( contype ); tempoff = sizes[ cbn ].om_off; putlbracket( ftnno , -tempoff ); if ( tempoff < sizes[ cbn ].om_max ) { sizes[ cbn ].om_max = tempoff; } putLV( 0 , cbn , tempoff , P2PTR|P2STRTY ); - p = rvalue( r[2] , p1 , LREQ ); + p = rvalue( r[2] , contype , LREQ ); if ( isa( p , "t" ) ) { putop( P2LISTOP , P2INT ); if ( p == NIL || p1 == NIL ) { @@ -651,7 +666,7 @@ cstrng: return (NIL); contype = p1; # ifdef OBJ - if (p1 == nl+TSET || p1->class == STR) { + if (p1->class == STR) { /* * For constant strings we want * the longest type so as to be @@ -664,8 +679,17 @@ cstrng: codeon(); if (p == NIL) return (NIL); - if (p1 == nl+TSET || width(p) > width(p1)) + if (width(p) > width(p1)) contype = p; + } else if ( isa( p1 , "t" ) ) { + if ( contype == lookup( intset ) -> type ) { + codeoff(); + contype = rvalue( r[2] , NIL , RREQ ); + codeon(); + if ( contype == NIL ) { + return NIL; + } + } } /* * Now we generate code for @@ -693,22 +717,28 @@ cstrng: * what type it is based on the type of the right. * (this matters for intsets). */ - if ( p1 == nl + TSET || c1 == TSTR ) { + if ( c1 == TSTR ) { codeoff(); p = rvalue( r[ 2 ] , NIL , LREQ ); codeon(); - if ( p1 == nl + TSET - || lwidth( p ) > lwidth( p1 ) ) { + if ( p == NIL ) { + return NIL; + } + if ( lwidth( p ) > lwidth( p1 ) ) { + contype = p; + } + } else if ( c1 == TSET ) { + if ( contype == lookup( intset ) -> type ) { + codeoff(); + p = rvalue( r[ 2 ] , NIL , LREQ ); + codeon(); + if ( p == NIL ) { + return NIL; + } contype = p; } } else { - codeoff(); - p = rvalue( r[ 2 ] , contype , LREQ ); - codeon(); contype = p; - } - if ( p == NIL ) { - return NIL; } /* * put out the width of the comparison. @@ -828,15 +858,6 @@ nonident: p1 = csetd.csettype; if (p1 == NIL) return NIL; - if (p1 == nl+TSET) { - if ( !inempty ) { - warning(); - error("... in [] makes little sense, since it is always false!"); - inempty = TRUE; - } - put(1, O_CON1, 0); - return (nl+T1BOOL); - } postcset( rt, &csetd); } else { p1 = stkrval(r[3], NIL , RREQ ); @@ -846,11 +867,9 @@ nonident: # ifdef PC if (rt != NIL && rt[0] == T_CSET) { if ( precset( rt , NIL , &csetd ) ) { - if ( csetd.csettype != nl + TSET ) { - putleaf( P2ICON , 0 , 0 - , ADDTYPE( P2FTN | P2INT , P2PTR ) - , "_IN" ); - } + putleaf( P2ICON , 0 , 0 + , ADDTYPE( P2FTN | P2INT , P2PTR ) + , "_IN" ); } else { putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) @@ -859,15 +878,6 @@ nonident: p1 = csetd.csettype; if (p1 == NIL) return NIL; - if ( p1 == nl + TSET ) { - if ( !inempty ) { - warning(); - error("... in [] makes little sense, since it is always false!"); - inempty = TRUE; - } - putleaf( P2ICON , 0 , 0 , P2INT , 0 ); - return (nl+T1BOOL); - } } else { putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) -- 2.20.1