// 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) ] ]