// M E R G E D E L E T E O U T P U T (PREPRESS)
//
// Does output for MergeDelete

//Modified by Lyle Ramshaw, PARC on December 27, 1980 10:09 PM:
// changed storage allocation in the Verify case so that there
// doesn’t have to be enough free core for an entire character.

//Modified by Lyle Ramshaw, PARC on December 20, 1980 8:39 PM:
// Added more typeout

//Modified by Lyle Ramshaw, PARC on September 28, 1980 8:41 PM:
// Added code to implement Verified Mode: perform compacting and checking
// inside at the character level in blocks of AlignedChars, OrbitChars,
// and MultiChars.

//Written by Lyle Ramshaw, PARC on May 20, 1980 12:48 PM

get "Ix.dfs"
get "AltoFileSys.D"//for STRING stuff
get "Streams.d"
get "MergeLists.d"

// outgoing procedures
external
[
MergeDeleteOutput
]

// incoming procedures
external
[
PrePressWindowInit

//WINDOW
WindowSetPosition
WindowGetPosition
WindowReadBlock
WindowWriteBlock
WindowRead
WindowWrite
WindowCopy
WindowEnd
WindowClose
WindowFlush
WindowLength

//UTIL
FSGetX
FSPut

ReadIX
WriteIX
CompareIX
PrintIX
ReadIXTempFile
WriteIXTempFile
TypeChar
CheckParams
Scream
IllFormat
IllCommand
DblShift
GetPosRelative

//SCAN
StrEq
StrCop
TypeForm

//Float
DPSB

//OS
OpenFile
DoubleAdd
Min
Max
Zero
SetBlock
MoveBlock
ReadCalendar
Usc

//Filops
FillIX
]

// incoming statics
external
[
@verifyFlag//from MergeDelete
]

// internal statics
//static
//[
//]

// Procedures

let MergeDeleteOutput(outNameList, outDataList, wOld, wNew,
careful, oldName) be
[
let DPZero= table [ 0;0 ]

//Compute length of IX portions of the output file
let nameWords=0
let p=outNameList
while p do
[
nameWords=nameWords+p>>NNode.ix.Length
p=@p
]
let dataWords=0
p=outDataList
while p do
[
dataWords=dataWords+(lv p>>DNode.ix)>>IXH.Length
p=@p
]
let ixWords=nameWords+dataWords+IXLEnd
let breakPos=vec 1
breakPos!0=0; breakPos!1=ixWords

test careful ifso
[
//write new file in canonical order on PrePress.Scratch, then copy
//it back to wOld
let wTemp=PrePressWindowInit(0)
WindowSetPosition(wTemp, breakPos)
let p=outDataList
while p do
[
//write the data segment described by this node
let x=lv p>>DNode.ix
switchon x>>IXH.Type into
[
case IXTypeMultiChars:
[
let oldInFile,newInFile=nil,nil
let hardWay=false
switchon p>>DNode.file into
[
case 0: oldInFile=wOld;newInFile=wOld;endcase
case 1: oldInFile=wNew;newInFile=wNew;endcase
case 2: oldInFile=wOld;newInFile=wNew
hardWay=true;endcase
]
let newReset=vec 1
MoveBlock(newReset,lv x>>IXM.segs↑1.sa,2)
WindowSetPosition(newInFile,newReset)
WindowGetPosition(wTemp,lv x>>IXM.segs↑1.sa)
MoveCharSegment(newInFile,wTemp,true,
x, lv x>>IXM.segs↑1.len)
for i=2 to x>>IXM.numSegs do
[
WindowSetPosition(oldInFile,lv x>>IXM.segs↑i.sa)
WindowGetPosition(wTemp,lv x>>IXM.segs↑i.sa)
test hardWay then
[
//In this block, we want to get the raster-
//dependent stuff from newInFile, the widths from
//the oldInFile; compiled in sizes!!
compileif CharWidthsize ne 8 then [ foo=nil]
let v1,v2=vec CharWidthsize,vec CharWidthsize
WindowSetPosition(newInFile,newReset)
for j=x>>IXM.bc to x>>IXM.ec do
[
WindowReadBlock(newInFile,v1,CharWidthsize)
WindowReadBlock(oldInFile,v2,CharWidthsize)
WindowWriteBlock(wTemp,v2,4)//widths
WindowWriteBlock(wTemp,v1+4,4) //raster stuff
]
]
or WindowCopy(oldInFile,wTemp,lv x>>IXM.segs↑i.len)
]
endcase
] //end of MultiChars
case IXTypeOrbitChars:
[
let ifile=((p>>DNode.file eq 0)?wOld,wNew)
WindowSetPosition(ifile,lv x>>IX.sa)
WindowGetPosition(wTemp,lv x>>IX.sa)
MoveCharSegment(ifile,wTemp,true,
x, lv x>>IX.len)
endcase
]
case IXTypeChars:
[
let ifile=((p>>DNode.file eq 0)?wOld,wNew)
WindowSetPosition(ifile,lv x>>IX.sa)
WindowGetPosition(wTemp,lv x>>IX.sa)
MoveCharSegment(ifile,wTemp,false,
x, lv x>>IX.len)
endcase
]
default:
[
let ifile=((p>>DNode.file eq 0)?wOld,wNew)
WindowSetPosition(ifile,lv x>>IX.sa)
WindowGetPosition(wTemp,lv x>>IX.sa)
WindowCopy(ifile,wTemp,lv x>>IX.len)
]
] //end of switchon
p=@p
TypeForm(".")
]
//remember total length of output file
let tl=vec 1; WindowGetPosition(wTemp,tl)

//write the new headers, all new file pointers having been set up
WindowSetPosition(wTemp, DPZero)
p=outNameList
while p do
[
WriteIX(wTemp, -1, lv p>>NNode.ix)
p=@p
]
p=outDataList
while p do
[
WriteIX(wTemp, -1, lv p>>DNode.ix)
p=@p
]
WriteIX(wTemp, IXTypeEnd)

//and copy back to oldFile
WindowFlush(wTemp)
TypeForm(0,"Valid output now available in PrePress.Scratch.",0)
WindowSetPosition(wTemp,DPZero)
WindowSetPosition(wOld,DPZero)
WindowCopy(wTemp, wOld, tl)
WindowClose(wOld, -1)
TypeForm("Valid output now available in Dictionary file.",0)
] //end of output-writing code, careful case


ifnot //careful
[
//live dangerously: having computed length of IX portion of output, move
//data blocks out of the way if necessary to make room for IX’es, add
//new data blocks at the end, then write the new IX’es.
//First, figure out max of current wOld length and ixWords
let endPos=vec 1
WindowLength(wOld, endPos)
if DPUsc(breakPos, endPos) eq 1 then
MoveBlock(endPos, breakPos, 2)
WindowSetPosition(wOld, endPos)
//next, loop through the outDataList, copying all data blocks to after
//endPos except for those that happen to be safely after breakPos.
//We need a second stream for read access to the dictionary file
let wRead=PrePressWindowInit(oldName, 0)
p=outDataList
while p do
[
let x=lv p>>DNode.ix
switchon x>>IXH.Type into
[
case IXTypeMultiChars:
[
let oldInFile,newInFile=nil,nil
let hardWay=false
switchon p>>DNode.file into
[
case 0: oldInFile=wRead;newInFile=wRead;endcase
case 1: oldInFile=wNew;newInFile=wNew;endcase
case 2: oldInFile=wRead;newInFile=wNew
hardWay=true;endcase
]
let newReset=vec 1
MoveBlock(newReset,lv x>>IXM.segs↑1.sa,2)
if p>>DNode.file ne 0 %
DPUsc(newReset,breakPos) ls 0 then
[
//copy first segment to a safe place
WindowSetPosition(newInFile,newReset)
WindowGetPosition(wOld,lv x>>IXM.segs↑1.sa)
WindowCopy(newInFile,wOld,lv x>>IXM.segs↑1.len)
TypeForm(".")
]
for i=2 to x>>IXM.numSegs do
[
let thisSegPos=vec 1
MoveBlock(thisSegPos,lv x>>IXM.segs↑i.sa,2)
if p>>DNode.file ne 0 %
DPUsc(thisSegPos,breakPos) ls 0 then
[
//copy this segment to a safe place
WindowSetPosition(oldInFile,thisSegPos)
WindowGetPosition(wOld,lv x>>IXM.segs↑i.sa)
test hardWay then
[
//In this block, we want to get the raster-
//dependent stuff from newInFile, the widths from
//the oldInFile; compiled in sizes!!
compileif CharWidthsize ne 8 then [ foo=nil]
let v1,v2=vec CharWidthsize,vec CharWidthsize
WindowSetPosition(newInFile,newReset)
for j=x>>IXM.bc to x>>IXM.ec do
[
WindowReadBlock(newInFile,v1,CharWidthsize)
WindowReadBlock(oldInFile,v2,CharWidthsize)
WindowWriteBlock(wOld,v2,4)//widths
WindowWriteBlock(wOld,v1+4,4) //raster stuff
]
]
or WindowCopy(oldInFile,wOld,lv x>>IXM.segs↑i.len)
]
]
endcase
] //end of MultiChars
default:
[
if p>>DNode.file ne 0 %
DPUsc(lv x>>IX.sa,breakPos) ls 0 then
[
//must copy this guy at the end
let ifile=((p>>DNode.file eq 0)?wRead,wNew)
WindowSetPosition(ifile, lv x>>IX.sa)
WindowGetPosition(wOld, lv x>>IX.sa)
WindowCopy(ifile,wOld,lv x>>IX.len)
TypeForm(".")
]
] //end of default
] //end of switchon
p=@p
]
WindowClose(wRead)
//remember total length of output file
let tl=vec 1; WindowGetPosition(wOld,tl)

TypeForm(0,"Entering critical section: dictionary temporarily invalid...",0)
//write the new headers, all new file pointers having been set up
WindowSetPosition(wOld, DPZero)
p=outNameList
while p do
[
WriteIX(wOld, -1, lv p>>NNode.ix)
p=@p
]
p=outDataList
while p do
[
WriteIX(wOld, -1, lv p>>DNode.ix)
p=@p
]
WriteIX(wOld, IXTypeEnd)
WindowClose(wOld,tl)
TypeForm("Exiting critical section: dictionary OK once again.",0)
] //end of output-writing code, risky case
] //of MergeDeleteOutput

and MoveCharSegment(inFile,outFile,orbitFlag,ix,lvlen) be
[
test verifyFlag
ifnot WindowCopy(inFile,outFile,lvlen)
ifso
[
//Copy the character segment, but reorder the raster blocks if necessary
//to get them in charcode order, and also check that the width information
//in the CharWidth blocks agrees with the raster blocks.
let outStart,outBase,outEnd=vec 1,vec 1,vec 1
let inBase=vec 1
let nc=ix>>IX.ec - ix>>IX.bc + 1
let CW=FSGetX(CharWidthsize*nc)
let CP=FSGetX(2*nc)
WindowGetPosition(outFile,outStart)
WindowReadBlock(inFile,CW,CharWidthsize*nc)
WindowWriteBlock(outFile,CW,CharWidthsize*nc)
WindowGetPosition(inFile,inBase)
WindowGetPosition(outFile,outBase)
WindowReadBlock(inFile,CP,2*nc)
WindowWriteBlock(outFile,CP,2*nc) //These pointers aren’t correct, but
// we will rewrite them later.
for c=0 to nc-1 do
[
//process one character
let w,h=nil,nil
let thiscw=CW+CharWidthsize*c
w=thiscw>>CharWidth.W
h=thiscw>>CharWidth.H
if h eq -1 then
[
//sanitize missing character
Zero(thiscw,CharWidthsize)
thiscw>>CharWidth.H=-1
(CP+2*c)!0=-1; (CP+2*c)!1=-1;
loop
]
let rasterpos=vec 1
MoveBlock(rasterpos,inBase,2)
DoubleAdd(rasterpos,CP+2*c)
if h eq 0 % w eq 0 then
[
//empty raster: just write the canonical empty
//raster block, ignoring the input file.
thiscw>>CharWidth.H=0
thiscw>>CharWidth.W=0
thiscw>>CharWidth.YB=0
thiscw>>CharWidth.XL=0
GetPosRelative(outFile,outBase,CP+2*c)
test orbitFlag
ifso WindowWriteBlock(outFile,table [ 0;-1 ] ,2)
ifnot WindowWriteBlock(outFile,table [ 0 ],1)
loop
]
test orbitFlag
ifso [
let totalbits=vec 1
DPMult(h,w,totalbits)
DoubleAdd(totalbits, table [ 0;15 ] )
DblShift(totalbits, 4) //divide by 16
if totalbits!0 ne 0 then
[
Scream("Ridiculously large character in Orbit format")
finish
]
let sizeNeeded=((totalbits!1)+3)&(-2)
//2 word header and must be even length
WindowSetPosition(inFile,rasterpos)
let rasterHead=vec 2
WindowReadBlock(inFile,rasterHead,2)
if rasterHead!0 ne -h then
[
TypeForm(0,"In font: ")
PrintIX(ix); TypeForm("Char ",8,ix>>IX.bc+c, " ")
Scream(" Height in CharWidth does not agree with height in raster block!")
]
if rasterHead!1 ne w-1 then
[
TypeForm(0,"In font: ")
PrintIX(ix); TypeForm("Char ",8,ix>>IX.bc+c, " ")
Scream(" Width in CharWidth does not agree with width in raster block!")
]
GetPosRelative(outFile,outBase,CP+2*c)
WindowSetPosition(inFile,rasterpos)
let DPsizeNeeded=vec 1
DPsizeNeeded!0=0; DPsizeNeeded!1=sizeNeeded
WindowCopy(inFile,outFile,DPsizeNeeded)
]
ifnot
[
let hwords=(h+15)/16
let sizeNeeded=(hwords*w)+1 // +1 is for header
WindowSetPosition(inFile,rasterpos)
let hdr=WindowRead(inFile)
if hdr<<FHEAD.hw ne hwords then
[
TypeForm(0,"In font: ")
PrintIX(ix); TypeForm("Char ",8,ix>>IX.bc+c, " ")
Scream(" Height in CharWidth does not agree with height in raster block!")
]
if hdr<<FHEAD.ns ne w then
[
TypeForm(0,"In font: ")
PrintIX(ix); TypeForm("Char ",8,ix>>IX.bc+c, " ")
Scream(" Width in CharWidth does not agree with width in raster block!")
]
GetPosRelative(outFile,outBase,CP+2*c)
WindowSetPosition(inFile,rasterpos)
let DPsizeNeeded=vec 1
DPsizeNeeded!0=0; DPsizeNeeded!1=sizeNeeded
WindowCopy(inFile,outFile,DPsizeNeeded)
]
]
//Now copy the updated CP table to the outFile
WindowGetPosition(outFile,outEnd)
WindowSetPosition(outFile,outBase)
WindowWriteBlock(outFile,CP,nc*2)
WindowSetPosition(outFile,outEnd)
//and reset the length of segment
MoveBlock(lvlen,outEnd,2)
DPSB(lvlen,outStart)
FSPut(CP);
FSPut(CW);
]
]

and DPMult(a,b,lvres) be
[
//set two word block pointed to by lvres to the product of the
//sixteen bit unsigned integers in a and b. Technique is to
//split up into bytes:
let ahigh, alow, bhigh, blow = nil,nil,nil,nil
ahigh=a rshift 8
bhigh=b rshift 8
alow=a & #377
blow=b & #377
lvres!0=0; lvres!1=ahigh*bhigh
DblShift(lvres,-8) //shift it left 8 bits
let temp=vec 1
temp!0=0; temp!1=ahigh*blow
DoubleAdd(lvres,temp)
temp!1=alow*bhigh
DoubleAdd(lvres,temp)
DblShift(lvres,-8)
temp!1=alow*blow
DoubleAdd(lvres,temp)
]

and DPUsc(a,b) = valof
[
let r=Usc(a!0,b!0)
if r then resultis r
resultis Usc(a!1, b!1)
]