/* Copyright (c) 1979 Regents of the University of California */
static char sccsid
[] = "@(#)pclval.c 1.1 8/27/80";
* and the rest of the file
* pclvalue computes the address
* of a qualified name and
* leaves it on the stack.
* for pc, it can be asked for either an lvalue or an rvalue.
* the semantics are the same, only the code is different.
* for putting out calls to check for nil and fnil,
* we have to traverse the list of qualifications twice:
* once to put out the calls and once to put out the address to be checked.
pclvalue( r
, modflag
, required
)
error("Variable required"); /* Pass mesgs down from pt of call ? */
firstp
= p
= lookup( r
[2] );
firstsymbol
= p
-> symbol
;
if ( ( modflag
& NOUSE
) && ! lptr( c
) ) {
* Only possibilities for p -> class here
* are the named classes, i.e. CONST, TYPE
* VAR, PROC, FUNC, REF, or a WITHPTR.
if ( p
-> class == WITHPTR
) {
* Construct the tree implied by
* this not only puts out the names of functions to call
* but also does all the semantic checking of the qualifications.
if ( ! nilfnil( p
, c
, modflag
, firstp
, r
[2] ) ) {
* Obtain the indirect word
* as the base of our lvalue
putRV( firstsymbol
, firstbn
, p
-> value
[ 0 ]
f
= 0; /* have an lv on stack */
f
= 1; /* no lv on stack yet */
error("%s %s found where variable required", classes
[p
-> class], p
-> symbol
);
* qualification on the name
if ( c
== NIL
&& ( modflag
& ASGN
) && p
-> value
[ NL_FORV
] ) {
error("Can't modify the for variable %s in the range of the loop", p
-> symbol
);
for ( ; c
!= NIL
; c
= c
[2] ) {
putLV( firstsymbol
, firstbn
, o
putleaf( P2ICON
, o
, 0 , P2INT
putop( P2PLUS
, P2PTR
| P2CHAR
);
* the appropriate function name is
* already out there from nilfnil.
if ( p
-> class == PTR
) {
* this is the indirection from
* the address of the pointer
* fnil doesn't want this.
* and does it itself for files
* since only it knows where the
* but i have to do this for
putop( P2UNARY P2MUL
, p2type( p
) );
putLV( firstsymbol
, firstbn
, o
putleaf( P2ICON
, o
, 0 , P2INT
putLV( firstsymbol
, firstbn
, o
, p2type( p
-> type
) );
putleaf( P2ICON
, o
, 0 , P2INT
, 0 );
if ( required
== RREQ
) {
putop( P2UNARY P2MUL
, p2type( p
-> type
) );
* this recursively follows done a list of qualifications
* and puts out the beginnings of calls to fnil for files
* or nil for pointers (if checking is on) on the way back.
* this returns true or false.
nilfnil( p
, c
, modflag
, firstp
, r2
)
char *r2
; /* no, not r2-d2 */
lastp
-> nl_flags
|= NUSED
;
if ( p
-> class != PTR
&& p
-> class != FILET
) {
error("^ allowed only on files and pointers, not on %ss", nameof(p
));
if ( p
-> class != ARRAY
) {
error("%s is a %s, not a function", r2
, classes
[firstp
-> class]);
error("Illegal function qualificiation");
error("Pascal uses [] for subscripting, not ()");
if ( p
-> class != ARRAY
) {
error("Subscripting allowed only on arrays, not on %ss", nameof(p
));
if ( p
-> class != RECORD
) {
error(". allowed only on records, not on %ss", nameof(p
));
p
= reclook( p
, co
[1] );
error("%s is not a field in this record", co
[1]);
if ( ( modflag
& NOUSE
) == 0 || lptr( c
[2] ) ) {
* recursive call, check the rest of the qualifications.
if ( ! nilfnil( p
, c
[2] , modflag
, firstp
, r2
) ) {
if ( p
-> class == PTR
) {
, ADDTYPE( P2FTN
| P2INT
, P2PTR
)
, ADDTYPE( P2FTN
| P2INT
, P2PTR
)
cerror("Error occurred on qualification of %s", r2
);