// BSAE2.bcpl - BCPL Compiler -- SAE part 2 - More Declaration handling
// Copyright Xerox Corporation 1980
// Last modified on Sun 29 Oct 72 0350.42 by jec.
// last modified by Butterfield, February 12, 1979 10:53 AM
// - DeclExt, if not SWNoExtExts (/-E), allow EXTERNAL & EXTERNAL - 2/12/79
// DeclareLet
// *DeclNames
// *DeclValues
// DeclLocal
// DeclStatic
// DeclExt
// DeclStruct
// CellWithName
// NewName
// StructWithName
// NewStructName
// CheckDistinct
// OutputStatic
// * local to this file.
get "bsaex"
let DeclareLet(x) be
[ let DE, DS = DvecE, DvecS
let Def = H2!x
while H1!Def eq LINE do [ Curline = H2!Def; Def = H3!Def ]
DeclNames(Def)
CheckDistinct(DS, DvecS)
DvecE = DvecS
Decllabels(H3!x)
DeclValues(Def)
Declvars(H3!x)
DvecE, DvecS = DE, DS
]
and DeclNames(Def) be
[ if Def eq 0 return
while H1!Def eq LINE do [ Curline = H2!Def; Def = H3!Def; if Def eq 0 return ]
switchon H1!Def into
[ case AND:
DeclNames(H2!Def)
DeclNames(H3!Def)
return
case VALDEF:
DeclLocal(H2!Def)
return
case RTDEF:
case FNDEF:
[ H5!Def = Nextentry()
H2!(H2!Def) = H5!Def
let d = DeclStatic(H2!Def, ENTRY)
H6!Def = d!1
return
]
default: SAEreport(-3)
return
]
]
and DeclValues(Def) be
[ if Def eq 0 return
while H1!Def eq LINE do [ Curline = H2!Def; Def = H3!Def; if Def eq 0 return ]
switchon H1!Def into
[ case AND:
DeclValues(H2!Def)
DeclValues(H3!Def)
return
case VALDEF:
Lookat (H3+Def)
return
case RTDEF:
case FNDEF:
[ let DE, DS = DvecE, DvecS
and DP = DvecP
DvecP = DvecS
DeclLocal(H3!Def)
if H7!Def ne 0 do DeclLocal(H7!Def)
CheckDistinct(DS, DvecS)
DvecE = DvecS
test H1!Def eq RTDEF
then [ Decllabels(H4!Def)
Declvars(H4!Def)
]
or [ Lookat(H4+Def)
]
DvecE, DvecS = DE, DS
DvecP = DP
return
]
default:
return
]
]
and DeclLocal(x) be
[ if x eq 0 return
if (H1!x & TypeMask) eq LOCAL do
[ NewName(x)
return
]
if H1!x eq COMMA do
[ DeclLocal(H2!x)
DeclLocal(H3!x)
return
]
if H1!x eq NIL return
SAEreport(-4)
]
and DeclStatic(x, valtype) = valof
[ let xname = x!0 & NameMask
let xtype = x!0 & TypeMask
let xvalue = x!1
let d = CellWithName(xname)
let dtype = d!0 & TypeMask
test d ne 0
ifnot [ NewName(x)
d = x
]
ifso switchon dtype into
[ case LOCAL:
case CONSTANT:
case LABEL:
case ZLABEL:
NewName(x)
d = x
endcase
case EXTLABEL:
case ZEXTLABEL:
if d!1 ne 0 do SAEreport(2, xname)
test dtype eq ZEXTLABEL % xtype eq ZLABEL
then d!0 = (d!0 & NameMask) + ZINTLABEL
or d!0 = (d!0 & NameMask) + INTLABEL
endcase
case INTLABEL:
case ZINTLABEL:
SAEreport(1, xname)
resultis d
default: SAEreport(-9)
]
d!1 = Nextstatic()
OutputStatic(d, xvalue, valtype)
resultis d
]
and DeclExt(x) be
[ let xname = x!0 & NameMask
let xtype = x!0 & TypeMask
let d = CellWithName(xname)
let dtype = d!0 & TypeMask
test d ne 0
ifnot [ NewName(x)
return
]
ifso switchon dtype into
[ case LOCAL:
case CONSTANT:
NewName(x)
return
case EXTLABEL:
case ZEXTLABEL:
if SWNoExtExts then SAEreport(3, xname)
return
case INTLABEL:
case ZINTLABEL:
SAEreport(4, xname)
return
case LABEL:
case ZLABEL:
SAEreport(5, xname)
return
default: SAEreport(-8)
]
]
and DeclStruct(lvx, defnode, newstruct) be
[ let x = rv lvx
if x eq 0 return
let y, z = nil, nil
if (H1!x & NameBit) ne 0 do
[ Curname = H1!x
unless defnode eq 0 do
[ NewStructName(x, defnode); DvecE = DvecS ]
]
test (H1!x & NameBit) ne 0 % H1!x eq BLANK
then DeclStruct(lv H2!x, 0, newstruct)
or switchon H1!x into
[ case UPLUMP:
DeclStruct(lv H2!x, defnode, newstruct)
if newstruct do
[ H3!x = H3!x eq 0 ? 0, EvalConst(H3+x)
H4!x = EvalConst(H4+x)
]
endcase
case FIELDLIST: case OVERLAYLIST:
for i = 1 to H2!x do
DeclStruct(lv (H2+i)!x, defnode, newstruct)
endcase
case RV:
unless newstruct do SAEreport(-21)
y = StructWithName(H2!x)
test y eq 0
then [ SAEreport(11, H2!x); rv lvx = 0 ]
or [ z = H2!y
switchon H1!z into
[ case BIT: case BYTE: case WORD:
case UPLUMP: case FIELDLIST: case OVERLAYLIST:
endcase
default:
SAEreport(-23)
]
DeclStruct(lv H2!y, (defnode eq 0 ? 0, H2!y), false)
rv lvx = H2!y
endcase
]
case BIT: case BYTE: case WORD:
if newstruct do
H2!x = H2!x eq 0 ? 1, EvalConst(H2+x)
endcase
default:
SAEreport(-22)
]
]
and NewName(namenode) be
[ if DvecS + DvecN ge DvecT do [ SAEreport(6, namenode!0); return ]
DVec!DvecS = (namenode!0 & NameMask) + NameBit
DVec!(DvecS+1) = namenode
DvecS = DvecS + DvecN
]
and CellWithName(n) = valof
[ n = (n & NameMask) + NameBit
DvecLoc = DvecE - DvecN
while DvecLoc gr 0 do
[ if DVec!DvecLoc eq n resultis DVec!(DvecLoc+1)
DvecLoc = DvecLoc - DvecN
]
resultis 0
]
and NewStructName(namenode, defnode) be
[ if DvecS + DvecN ge DvecT do [ SAEreport(6, namenode!0); return ]
DVec!DvecS = namenode
DVec!(DvecS+1) = defnode
DvecS = DvecS + DvecN
]
and StructWithName(n) = valof
[ n = (n & NameMask) + NameBit
DvecLoc = DvecE - DvecN
while DvecLoc gr 0 do
[ let namenode = DVec!DvecLoc
if (namenode & NameBit) eq 0 do
if namenode!0 eq n resultis namenode
DvecLoc = DvecLoc - DvecN
]
resultis 0
]
and CheckDistinct(DE, DS) be
[ for q = DE step DvecN to DS - DvecN do
[ let n = DVec!q
test (n & NameBit) ne 0
then for p = q + DvecN step DvecN to DS - DvecN do
if DVec!p eq n do SAEreport(7, n)
or for p = q + DvecN step DvecN to DS - DvecN do
[ let namenode = DVec!p
if (namenode & NameBit) eq 0 do
if H1!namenode eq H1!n do SAEreport(13, H1!n)
]
]
]
and OutputStatic(d, val, valtype) be
[ let op = selecton d!0 & TypeMask into
[ case EXTLABEL: EXT
case ZEXTLABEL: ZEXT
case INTLABEL: INT
case ZINTLABEL: ZINT
case LABEL: LOC
case ZLABEL: ZLOC
default: 0
]
Writech(OcodeStream, op)
Writeaddr(OcodeStream, d!0 & NameMask)
switchon d!0 & TypeMask into
[ case EXTLABEL:
case ZEXTLABEL:
return
case INTLABEL:
case ZINTLABEL:
case LABEL:
case ZLABEL:
Writech(OcodeStream, valtype)
[ Writeword(OcodeStream, val)
]
return
default:
SAEreport(-2)
]
]