// BLDRUTIL.BCPL
// Taft, November 13, 1981 3:39 PM
// Swinehart, May 23, 1977 5:46 PM
// Copyright Xerox Corporation 1979, 1980, 1981
get "BLDR.DECL"
let PREAMOF(fileNum) = lv PREAMBLEVEC!(fileNum*lDV)
and BeginReport(errorFlag) be
[
if DEBUGSW & errorFlag then [ ESTREAM = dsp; return ]
ESTREAM = Zmem(lST)
ESTREAM>>ST.puts = TwoPuts
eStream = OpenFile(0,0,charItem,0,fpRemCm)
unless errorFlag do
[
let fL = FileLength(eStream); Resets(eStream)
if CODE then Free(sysZone, CODE)
eBuf = Zmem(fL+1)
for i = 1 to fL do eBuf!i = Gets(eStream)
eBuf!0 = fL
]
Resets(eStream)
Wss(eStream,"// ")
]
and EndReport() be
[
unless eStream do CallSwat("Fatal Error") // error and DEBUGSW
Puts(eStream,$*N)
if eBuf then for i = 1 to eBuf!0 do Puts(eStream,eBuf!i)
Closes(eStream)
unless eBuf finish // was error, don't continue
]
and TwoPuts(str,char) be
[
Puts(dsp,char)
Puts(eStream,char)
if char eq $*N then Wss(eStream,"// ")
]
and BADSWITCH(N) be
[ // illegal switch detected
BeginReport(true)
PutTemplate(ESTREAM,"*NBad switch $C in ",SW!N)
for I = 1 to NAME!0 do Puts(ESTREAM,NAME!I)
for I = 1 to SW!0 do [ Puts(ESTREAM,$/); Puts(ESTREAM,SW!I) ]
EndReport()
]
and ERROR(message, val; numargs na) be
[ // fatal error detected
BeginReport(true)
Wss(ESTREAM,"Fatal ERROR -- ")
test na<2 then Wss(ESTREAM,message) or PutTemplate(ESTREAM,message, val)
EndReport()
]
and OUTWARNING(sym) be
[
unless WARNINGSW then return
PutTemplate(LSTREAM,
"WARNING -- the static $S at $6UO is outside a static area*N",
lv (sym>>SYm.dictEntry)>>DIct.name,sym>>SYm.staticAddress)
WARNINGCOUNT = WARNINGCOUNT + 1
]
and COMMONERROR(sym, entry) be
[ //one common, one not
PutTemplate(LSTREAM,
"The COMMON name $S was not declared COMMON in $S, or vice versa*N",
lv (sym>>SYm.dictEntry)>>DIct.name, NameOfRfile(sym))
ERRORCOUNT = ERRORCOUNT + 1
]
and MULTDEFERROR(sym, entry, REGARDLESS; numargs na) = valof
[//SYM IS ALREADY DEFINED AS ENTRY
unless na eq 3 & REGARDLESS do
if DUPSW & (NameOfRfile(sym) eq NameOfRfile(entry)) resultis false
PutTemplate(LSTREAM,"The EXTERNAL name $S was also defined in $S*N",
lv (sym>>SYm.dictEntry)>>DIct.name, NameOfRfile(entry) )
ERRORCOUNT = ERRORCOUNT + 1
resultis true
]
and NameOfRfile(sym) = fileNameVec!(sym>>SYm.rFile>>RFile.fileNum)
and WARNING(MESSAGE) be
[ unless WARNINGSW return
WARNINGCOUNT = WARNINGCOUNT + 1
PutTemplate(TSTREAM,"WARNING -- $S*N", MESSAGE)
]
and CODEWARNING(MESSAGE) be
[ unless WARNINGSW return
WARNINGCOUNT = WARNINGCOUNT + 1
PutTemplate(TSTREAM,"WARNING -- $S$S*N", RFILENAME, MESSAGE)
]
and PRINTSYM(sym) be
[
let name = lv (sym>>SYm.dictEntry)>>DIct.name
let lName = name>>STRING.length
let type = sym>>SYm.type
PutTemplate(LSTREAM,"*T$S$S*T$6UO*T$6UO*T$S$S$S*N",
name,(lName<8?"*T",""), sym>>SYm.staticAddress, sym>>SYm.initialValue,
(selecton type into
[ case 0: "UNDEF";
case 1: "V ";
case 2: "P ";
case 3: "L ";
default: ""
] ),
sym>>SYm.local? " "," X",
(type>1 & sym>>SYm.relocatable? " R","") )
]
and BETWEEN(N, LOW, HIGH) = Usc(LOW,N) le 0 & Usc(N,HIGH) ls 0
// Memory allocated by Zmem is unfreeable!
and Zmem(n, val; numargs na) = valof
[
static [ zmemThreshold = 16; zmemWordsLeft = 0; zmemBlock = 0 ]
manifest [ zmemIncrement = 256 ]
// zmemThreshold should be equal to the square root of zmemIncrement
// to make the space lost due to breakage balance the space gained
// due to not requiring one word of overhead for each allocated block.
let res = 0
if n le zmemThreshold then
[
if n gr zmemWordsLeft then
[
zmemBlock = Allocate(sysZone, zmemIncrement, true)
if zmemBlock eq 0 then zmemThreshold = 0
zmemWordsLeft = zmemIncrement
]
if n le zmemWordsLeft then
[
res = zmemBlock
zmemBlock = zmemBlock+n
zmemWordsLeft = zmemWordsLeft-n
]
]
if res eq 0 then res = Allocate(sysZone, n)
SetBlock(res, (na<2? 0, val), n)
resultis res
]
and Openfile(fileNum, direction, itemType) = valof
[
let name = fileNameVec!fileNum
let pream = PREAMOF(fileNum)
if @pream eq -1 & (direction ne ksTypeReadOnly % DUPSW eq 0) then
ERROR("$S appears twice on output or without /R",name)
// *** impl. dependent: force re-use of previous stream structure, buffer blocks
sysZone>>ZOne.rover = sysZone>>ZOne.anchor.pSbNext // *******
let stream = OpenFile(name,direction,itemType,0,lv pream>>DV.fp)
CHKFILE(name, stream)
resultis stream
]
and CURBOPOS(STREAM, PAGEOFFSET ; numargs N) = valof
[ // word position, relative to pageoffset
if N ls 2 then PAGEOFFSET = 0
let v = vec 2
FilePos(STREAM, v)
resultis v!0 lshift 15 + v!1 rshift 1 - PAGEOFFSET lshift 8
]
and CURBOPAGE(STREAM) = valof
[
let v = vec 2
FilePos(STREAM, v)
resultis v!0 lshift 7 + v!1 rshift 9
]
and SETBOPOS(STREAM,POS, PAGEOFFSET ; numargs N) be
[
PositionPage(STREAM, (POS rshift 8) + (N eq 3? PAGEOFFSET,0) + 1)
PositionPtr(STREAM, (POS lshift 1) & #777)
]
and SETPOS(S,N) be
[ PositionPage(S, (N rshift 9) + 1)
PositionPtr(S, N & #777)
]
and CHKFILE(NAME,STREAM) be unless STREAM do
ERROR("Can't open the file named '$S'", NAME)
and CAPITALIZE(C) = $a le C & C le $z? (C-($a-$A)), C
and EQUALNAME(A, B) = valof
[
structure STRING:
[
length byte
char ↑ 1,255 byte
]
let L = A>>STRING.length
if A>>STRING.char↑L eq $. then L=L-1
let M = B>>STRING.length
if B>>STRING.char↑M eq $. then M=M-1
if L ne M resultis false
for I = 1 to L do if CAPITALIZE(A>>STRING.char↑I) ne
CAPITALIZE(B>>STRING.char↑I) resultis false
resultis true
]
and Wss(stream,string) be for i = 1 to string>>STRING.length do
Puts(stream,string>>STRING.char↑i)
and Ws(string) be Wss(dsp,string)
and BldrFinishProc() be
[
@#420 = 0
for i = 0 to 32000 loop
]
and IncreaseStorage() be
[
let newFree = BeforeJuntaInit
for i = 1 by 2 to @relPairList*2-1 do @(relPairList!i) = SwappedOut
AddToZone(sysZone,newFree,freeBegin-newFree)
freeBegin = newFree
]
and SwappedOut() be ERROR("Calling Swapped Out Procedure")
and DisplayInCursor(number) be
[
Zero(cursorBitMap, 16)
let font = table
[ // Strike-format font, densely packed, characters 6 high, 5 wide
30614B; 61474B; 167461B; 117000B;
45222B; 112441B; 512B; 57000B;
54202B; 22471B; 141062B; 57000B;
64214B; 14405B; 21111B; 157000B;
44220B; 117645B; 22110B; 57000B;
31736B; 60430B; 142063B; 117000B;
]
let bbt = vec lBBT+1; bbt = (bbt+1)&-2
MoveBlock(bbt, table [ 1; 0; cursorBitMap; 1; 0; 4; 5; 6; 0; 4; 0; 0 ], lBBT)
bbt>>BBT.sbca = font
for destOffset = 10 to 0 by -5 do
[
let digit = number rem 10; number = number/10
bbt>>BBT.dlx = destOffset
bbt>>BBT.slx = 5*digit
BitBlt(bbt)
]
]