-- TexOut.mesa
-- Mesa 6 version
-- Last changed by Doug Wyatt, September 23, 1980 4:54 PM

-- Press output routines for TEX

DIRECTORY
TexDefs,
TexDispDefs USING [InitDisp,CloseDisp,DisplayPage,unitScaling],
TexErrorDefs,
TexFontDefs USING [FontHdr,CharWd,CharHt,CharDp],
TexGlueDefs,
TexIODefs,
TexMemDefs,
TexNodeDefs,
TexOutputDefs,
TexStringDefs USING [AppendString],
TexSynDefs USING [AppendOutputFileName],
TfmDefs,
AltoDefs USING [CharsPerPage],
InlineDefs USING [LowHalf, LongCOPY],
OsStaticDefs,
SegmentDefs,
StreamDefs,
TimeDefs;

TexOut: PROGRAM
IMPORTS TexDispDefs,TexErrorDefs,TexFontDefs,TexGlueDefs,TexIODefs,
TexMemDefs,TexStringDefs,TexSynDefs,
InlineDefs,SegmentDefs,StreamDefs,TimeDefs
EXPORTS TexOutputDefs =
BEGIN OPEN TexDefs, TexNodeDefs, TexGlueDefs;

display: BOOLEAN=TRUE;

Confusion: SIGNAL = TexErrorDefs.Confusion;

needToInit: BOOLEAN←TRUE;
displayPages: BOOLEAN←FALSE;

micasPerInch: Dimn=2540;
leftMargin: Dimn=micasPerInch; -- one inch
topMargin: Dimn=micasPerInch; -- also one inch
pageHeight: Dimn=11*micasPerInch; -- 11 inches
pageWidth: Dimn=17*(micasPerInch/2); -- 8.5 inches

-- Press Entity list commands
ELShowCharactersShort: BYTE = 0B;
ELFont: BYTE = 160B;
ELSetX: BYTE = 356B;
ELSetY: BYTE = 357B;
ELShowCharacters: BYTE = 360B;
ELShowRectangle: BYTE = 376B;
ELNop: BYTE = 377B;

pagePartType: CARDINAL = 0;
fontPartType: CARDINAL = 1;
PartEntry: TYPE = MACHINE DEPENDENT RECORD
[
partType: CARDINAL,
recStart: CARDINAL, -- starting record number
recLength: CARDINAL, -- length of part in records
pad: CARDINAL -- entity list padding in words, if partType=pagePartType
];
FontEntry: TYPE = MACHINE DEPENDENT RECORD -- Press font directory entry
[
length: CARDINAL, -- length of entry in words
fontset: BYTE, -- set for this entry
fontnum: BYTE, -- number within set for this entry
m: BYTE, -- first character defined by this entry
n: BYTE, -- last character defined by this entry
fam: ARRAY [0..10) OF WORD, -- bcpl string for name
face: TfmDefs.FaceCode, -- Press face encoding
source: BYTE, -- where to start reading characters
size: CARDINAL, -- size of the font in points
rotation: CARDINAL -- in minutes of arc
];

ozone: TexMemDefs.ZonePtr←NIL;

ByteArray: TYPE = LONG DESCRIPTOR FOR PACKED ARRAY OF BYTE;
ListState: TYPE = RECORD
[
array: ByteArray, -- byte array
count: CARDINAL, -- current number of bytes in list
seg: SegmentDefs.DataSegmentHandle
];
ListStatePtr: TYPE = POINTER TO ListState;

fontsPerSet: CARDINAL = 16; -- Press format restriction

EntityState: TYPE = RECORD
[
dlist: ListStatePtr, -- descriptor for DL
elist: ListStatePtr, -- descriptor for EL
pending: CARDINAL, -- number of pending characters in DL
cx,cy: Dimn, -- current x,y position
cf: [0..fontsPerSet) -- current font
];

dlPages: CARDINAL=30; -- dl buffer has this many pages
elPages: CARDINAL=20; -- el buffer has this many pages

numEntities: CARDINAL=(nFonts+fontsPerSet-1)/fontsPerSet;
EntityIndex: TYPE = [0..numEntities);
eState: ARRAY EntityIndex OF EntityState;
en: EntityIndex; -- current entity number

PressBufferFull: PUBLIC ERROR = CODE;

PutByte: PROCEDURE[list: ListStatePtr, b: BYTE] =
BEGIN OPEN list;
i: CARDINAL=count;
IF i<LENGTH[array] THEN { array[i]←b; count←i+1 }
ELSE ERROR PressBufferFull;
END;

AllocList: PROCEDURE[pages: CARDINAL] RETURNS[ListStatePtr] =
BEGIN OPEN SegmentDefs;
list: ListStatePtr=TexMemDefs.Alloc[ozone,SIZE[ListState]];
seg: DataSegmentHandle=NewDataSegment[base: DefaultXMBase, pages: pages];
base: LONG POINTER=LongSegmentAddress[seg];
list↑←[array: DESCRIPTOR[base,512*pages], count: 0, seg: seg];
RETURN[list];
END;

FreeList: PROCEDURE[list: ListStatePtr] =
BEGIN OPEN SegmentDefs;
DeleteDataSegment[list.seg];
-- closing ozone will free the ListState record
END;

fontsUsed: ARRAY Font OF BOOLEAN;

nullStream: StreamDefs.StreamHandle = NIL;
outStream: StreamDefs.StreamHandle;

PartRec: TYPE = RECORD
[
link: PartRecPtr,
entry: PartEntry
];
PartRecPtr: TYPE = POINTER TO PartRec;

partlist: PartRecPtr←NIL;
lastpart: PartRecPtr←NIL;
nparts: CARDINAL←0; -- current number of parts in partlist

fileName: STRING ← [51];

InitOut: PUBLIC PROCEDURE =
BEGIN
f: Font;
ozone←TexMemDefs.CreateZone[1,1];
IF display THEN displayPages←TRUE;
outStream←nullStream;
needToInit←FALSE;
-- initialize part directory
nparts←0; partlist←lastpart←NIL;
-- initialize font vector
FOR f IN Font DO fontsUsed[f]←FALSE; ENDLOOP;
IF display THEN TexDispDefs.InitDisp;
END;

CloseOut: PUBLIC PROCEDURE [copies: CARDINAL] =
BEGIN -- called just before TEX stops
startrec, partrec: CARDINAL;
IF needToInit THEN ERROR Confusion;

IF outStream=nullStream THEN
BEGIN OPEN TexIODefs; UseDisplay; Ps["No output file."]; END
ELSE
BEGIN
-- write the directories
[startrec,partrec]←WriteFontDirectory[];
WritePartDirectory[];
WriteDocDirectory[partrec, copies];

-- finish the output
outStream.destroy[outStream]; outStream←nullStream;
END;

-- deallocate
IF display THEN TexDispDefs.CloseDisp;
needToInit←TRUE; -- for next time
END;

WriteList: PROCEDURE[list: ListStatePtr] =
BEGIN OPEN SegmentDefs,list;
bufseg: DataSegmentHandle←NewDataSegment[pages: 1];
buf: POINTER←DataSegmentAddress[bufseg];
lpage: LONG POINTER←BASE[array];
rem: CARDINAL←count;
WHILE rem>0 DO
nwords: CARDINAL←MIN[256,rem/2];
InlineDefs.LongCOPY[from: lpage, nwords: nwords, to: buf];
[]←StreamDefs.WriteBlock[outStream,buf,nwords];
rem←rem-2*nwords; lpage←lpage+256;
IF rem=1 THEN SIGNAL Confusion;
ENDLOOP;
DeleteDataSegment[bufseg];
END;

WriteFontDirectory: PROCEDURE RETURNS[startrec,nextrec: CARDINAL] =
BEGIN
f: Font;
[]←SkipToNextRecord[];
startrec←CurrentRecord[];
FOR f IN Font DO
IF fontsUsed[f] THEN WriteFontEntry[f];
ENDLOOP;
Wout[0]; -- to mark end of font directory
[]←SkipToNextRecord[];
nextrec←CurrentRecord[];
AddPart[[fontPartType,startrec,nextrec-startrec,0]];
END;

WriteFontEntry: PROCEDURE[f: Font] =
BEGIN -- only include fonts that were actually used
fp: POINTER TO TfmDefs.FontHeader ← TexFontDefs.FontHdr[f];
fe: FontEntry;
size: LONG CARDINAL;
fe.length←SIZE[FontEntry];
[fe.fontset,fe.fontnum]←FontSet[f];
fe.m←0; fe.n←127;
fe.fam←LOOPHOLE[fp.name];
fe.face←fp.face;
fe.source←0;
size←fp.micasize;
fe.size←InlineDefs.LowHalf[(size*36+635)/1270]; -- 36pts=1270micas
fe.rotation←0;
[]←StreamDefs.WriteBlock[outStream,@fe,SIZE[FontEntry]];
END;

WritePartDirectory: PROCEDURE =
BEGIN
p: PartRecPtr;
UNTIL (p←partlist)=NIL
DO
partlist←p.link;
[]←StreamDefs.WriteBlock[outStream,@p.entry,SIZE[PartEntry]];
TexMemDefs.FreeMem[p,SIZE[PartRec]];
ENDLOOP;
[]←SkipToNextRecord[];
lastpart←NIL;
END;

WriteDocDirectory: PROCEDURE [partrec, copies: CARDINAL] =
BEGIN
pt: TimeDefs.PackedTime ← TimeDefs.CurrentDayTime[];
createtime: STRING ← [39];
WoutBcplString: PROCEDURE[s: STRING, words: CARDINAL] =
BEGIN
i: CARDINAL;
bytes: CARDINAL ← words*2;
len: CARDINAL ← IF s.length+1 > bytes THEN bytes-1 ELSE s.length;
Bout[len];
FOR i IN [0..len) DO Bout[s[i]]; ENDLOOP; -- does len Bout’s
THROUGH (len..bytes) DO Bout[0]; ENDLOOP; -- does bytes-len-1 Bout’s
END;
currec: CARDINAL ← CurrentRecord[];
username: POINTER;
usernamewords: CARDINAL;
Wout[27183]; -- Press password
Wout[currec+1]; -- total number of records in file including this one
Wout[nparts]; -- number of parts
Wout[partrec]; -- start of part directory
Wout[currec-partrec]; -- number of records in part directory
Wout[177777B]; -- back-pointer to obsolete document directory
Wout[LOOPHOLE[pt,WordPair].h];
Wout[LOOPHOLE[pt,WordPair].l]; -- packed time
Wout[1]; Wout[copies]; -- first and last copy to print
THROUGH [10..177B] DO Wout[177777B]; ENDLOOP; --unused
-- file name
WoutBcplString[fileName,26];
-- creator’s name
username ← OsStaticDefs.OsStatics.UserName;
usernamewords ← MIN[16,(LOOPHOLE[LOOPHOLE[username↑,BytePair].l,CARDINAL]+1)/2];
[]←StreamDefs.WriteBlock[outStream,username,usernamewords];
THROUGH [usernamewords..16) DO Wout[0]; ENDLOOP;
-- creation date
createtime.length←0;
TimeDefs.AppendFullDayTime[createtime, TimeDefs.UnpackDT[pt]];
WoutBcplString[createtime,20];
-- skip to end of record
[]←SkipToNextRecord[];
END;

StartPage: PROCEDURE =
BEGIN
i: EntityIndex;
TexMemDefs.OpenZone[ozone];
FOR i IN EntityIndex
DO OPEN eState[i];
elist←AllocList[elPages];
dlist←AllocList[dlPages];
pending←0; cx←cy←0; cf←0;
ENDLOOP;
en←0;
END;

EndPage: PROCEDURE =
BEGIN
i: EntityIndex;
FOR i IN EntityIndex
DO OPEN eState[i];
FreeList[elist];
FreeList[dlist];
ENDLOOP;
[]←TexMemDefs.CloseZone[ozone];
END;


-- A note on machine and implementation dependencies:
-- This module makes a number of assumptions about how Alto/Mesa
-- arranges bits.
-- a CARDINAL(=WORD) is 16 bits
--a LONG INTEGER is two words, low-order word first
-- bytes are packed left to right in a PACKED ARRAY OF BYTE
-- e.g., data and entity lists
--

BYTE: TYPE = [0..377B]; -- 8 bits
WORD: TYPE = CARDINAL; -- 16 bits
BytePair: TYPE = MACHINE DEPENDENT RECORD[l,r: BYTE]; -- left,right
WordPair: TYPE = MACHINE DEPENDENT RECORD[l,h: WORD]; -- low,high

ELByte: PROCEDURE[b: UNSPECIFIED] = --INLINE--
BEGIN
list: ListStatePtr ← eState[en].elist;
PutByte[list,b];
END;

ELWord: PROCEDURE[w: UNSPECIFIED] =
BEGIN
ELByte[LOOPHOLE[w,BytePair].l];
ELByte[LOOPHOLE[w,BytePair].r];
END;

ELDWord: PROCEDURE[d: LONG UNSPECIFIED] =
BEGIN
ELWord[LOOPHOLE[d,WordPair].h];
ELWord[LOOPHOLE[d,WordPair].l];
END;

DLByte: PROCEDURE[b: UNSPECIFIED, bump: BOOLEAN ← FALSE] =
BEGIN OPEN eState[en];
list: ListStatePtr ← dlist;
PutByte[list,b];
IF bump THEN pending←pending+1;
END;

DLWord: PROCEDURE[w: UNSPECIFIED] =
BEGIN
DLByte[LOOPHOLE[w,BytePair].l];
DLByte[LOOPHOLE[w,BytePair].r];
END;

AddPart: PROCEDURE[part: PartEntry] =
BEGIN
p: PartRecPtr←TexMemDefs.AllocMem[SIZE[PartRec]];
p↑←[link: NIL, entry: part];
IF lastpart=NIL THEN partlist←p ELSE lastpart.link←p;
lastpart←p;
nparts←nparts+1;
END;

PutChar: PROCEDURE[c: Char] = INLINE
BEGIN
DLByte[c, TRUE];
END;

Flush: PROCEDURE =
BEGIN OPEN eState[en];
n: CARDINAL←pending;
IF n=0 THEN RETURN;
WHILE n > 255
DO ELByte[ELShowCharacters]; ELByte[255]; n ← n-255 ENDLOOP;
IF n<=32 THEN ELByte[ELShowCharactersShort+n-1]
ELSE BEGIN ELByte[ELShowCharacters]; ELByte[n] END;
pending←0;
END;

SetX: PROCEDURE[x: Dimn] =
BEGIN OPEN eState[en];
Flush; ELByte[ELSetX]; ELWord[cx←x];
END;

SetY: PROCEDURE[y: Dimn] =
BEGIN OPEN eState[en];
yy: Dimn←pageHeight-y; -- invert y direction
-- note the assumption that ShowCharacters does not change y
IF yy#cy THEN
BEGIN Flush; ELByte[ELSetY]; ELWord[cy←yy] END;
END;

PutRectangle: PROCEDURE[x,y,h,w: Dimn] =
-- x,y specify the upper left corner
-- h,w specify height and width
BEGIN OPEN eState[en];
en←1; -- all rectangles go into entity 1
Flush;
SetX[x]; SetY[y+h]; -- lower left corner
ELByte[ELShowRectangle]; ELWord[w]; ELWord[h];
END;

FontSet: PROCEDURE[f: Font] RETURNS[set,font: CARDINAL] =
-- this procedure maps from a TEX Font number to
-- the corresponding Press font set / font number
BEGIN
set←f/16; font←f MOD 16;
END;

SetFont: PROCEDURE[f: Font] =
BEGIN OPEN eState[en]; -- note: this changes if en changes
s,t: CARDINAL;
[set: s, font: t]←FontSet[f];
en←s; -- switch entities if necessary
-- now change fonts if necessary
IF cf#t THEN BEGIN Flush; ELByte[ELFont+(cf←t)] END;
fontsUsed[f]←TRUE;
END;


etypeTEX: CARDINAL=125; -- arbitrary entity type code for TEX

ETrailer: PROCEDURE[n: EntityIndex, beginbyte,bytelength: LONG INTEGER] =
BEGIN OPEN eState[en];
en←n; -- set current entity number
Flush; -- don’t forget to flush out pending characters!
IF elist.count=0 THEN RETURN; -- empty entity
IF (elist.count MOD 2)#0 THEN ELByte[ELNop]; -- pad to word boundary
ELByte[etypeTEX]; -- entity type
ELByte[en]; -- font set
ELDWord[beginbyte]; -- beginning of DL region
ELDWord[bytelength]; -- length of DL region
ELWord[0]; ELWord[0]; -- origin (Xe,Ye)
ELWord[0]; ELWord[0]; -- bottom left corner of bounding box
ELWord[pageWidth]; ELWord[pageHeight]; -- dimensions of bounding box
ELWord[elist.count/2+1]; -- entity length in WORDS [including this number]
-- Assertion: the entity now contains an even number of bytes
END;

VlistOut: PROCEDURE[p: BoxNodePtr, x,y: Dimn] =
-- x,y give top,left corner for placing box
BEGIN
qq, qptr: NodePtr;

qq←p.head;
WHILE qq#NIL
-- qptr is used so that q is not invalidated if qq changes
DO
qptr←qq;
WITH q:qptr SELECT FROM
char =>
BEGIN OPEN q;
y←y+TexFontDefs.CharHt[c];
SetFont[c.font]; -- DO THIS FIRST! (may switch entity lists)
SetX[x]; SetY[y]; PutChar[c.char];
y←y+TexFontDefs.CharDp[c];
END;
glue => y←y+TexGlueDefs.FixGlue[q.g, p.glueset];
space, kern => y←y+q.s; -- for kerning
rule =>
BEGIN
h: Dimn←q.height+q.depth;
w: Dimn←IF q.width<0 THEN p.width ELSE q.width;
PutRectangle[x,y,h,w];
y←y+h;
END;
box => SELECT q.dir FROM
vlist =>
BEGIN
VlistOut[@q,x+q.shiftamt,y];
y←y+q.height+q.depth;
END;
hlist =>
BEGIN
y←y+q.height; -- baseline
HlistOut[@q,x+q.shiftamt,y];
y←y+q.depth;
END;
ENDCASE => ERROR;
leader =>
BEGIN
s: Dimn; -- space to be filled with leaders
yend: Dimn; -- final y value
gptr: NodePtr←q.link; -- pointer to node following leader Node
IF gptr=NIL THEN
BEGIN SIGNAL Confusion; GOTO Exit END;
WITH g:gptr SELECT FROM -- should be glue node
glue =>
BEGIN
s←TexGlueDefs.FixGlue[g.g, p.glueset];
qq←gptr;
END;
ENDCASE => BEGIN SIGNAL Confusion; GOTO Exit END;
yend←y+s;
WITH b:q.p SELECT FROM -- should be rule or box
box =>
BEGIN
hh: Dimn←b.height+b.depth; -- box height
t: INTEGER; -- quotient
IF hh<=0 THEN GOTO Exit;
t←y/hh;
y←hh*(t+1); -- the smallest suitable multiple of hh
SELECT b.dir FROM
hlist => WHILE y+hh<=yend
DO HlistOut[@b,x,y+b.height]; y←y+hh ENDLOOP;
vlist => WHILE y+hh<=yend
DO VlistOut[@b,x,y]; y←y+hh ENDLOOP;
ENDCASE => ERROR;
END;
rule => PutRectangle[x,y,s,b.width]; -- variable vertical rule
-- note: ignores height and depth of rule
ENDCASE => BEGIN SIGNAL Confusion; GOTO Exit END;
y←yend;
EXITS Exit => NULL END;
ENDCASE => NULL; -- ignore all other types of nodes
qq←qq.link; -- NOT q.link; qq may have been changed!
ENDLOOP;
END;

HlistOut: PROCEDURE[p: BoxNodePtr, x,y: Dimn] =
-- x,y are left,baseline for box
BEGIN
qq, qptr: NodePtr;

qq←p.head;
WHILE qq#NIL
-- qptr is used so that q is not invalidated if qq changes
DO
qptr←qq;
WITH q:qptr SELECT FROM
char =>
BEGIN
SetFont[q.c.font]; -- do this first. might switch entites
SetX[x]; SetY[y]; PutChar[q.c.char];
x←x+TexFontDefs.CharWd[q.c];
END;
string =>
BEGIN
f: Font;
c: Char;
i: CARDINAL;
SetFont[f←q.font]; -- do this first. might switch entites
SetX[x]; SetY[y];
FOR i IN[0..q.length)
DO
PutChar[c←q.text[i]];
x←x+TexFontDefs.CharWd[[f,c]];
ENDLOOP;
END;
glue => x←x+TexGlueDefs.FixGlue[q.g, p.glueset];
space, kern => x←x+q.s;
rule =>
BEGIN
h: Dimn←IF q.height<0 THEN p.height ELSE q.height;
d: Dimn←IF q.depth<0 THEN p.depth ELSE q.depth;
w: Dimn←q.width;
PutRectangle[x,y-h,h+d,w];
x←x+w;
END;
box => SELECT q.dir FROM
vlist =>
BEGIN
VlistOut[@q,x,y-q.height+q.shiftamt];
x←x+q.width;
END;
hlist =>
BEGIN
HlistOut[@q,x,y+q.shiftamt];
x←x+q.width;
END;
ENDCASE => ERROR;
leader =>
BEGIN
s: Dimn; -- space to be filled with leaders
xend: Dimn; -- final x value
gptr: NodePtr←q.link; -- pointer to node following leader Node
IF gptr=NIL THEN
BEGIN SIGNAL Confusion; GOTO Exit END;
WITH g:q.link SELECT FROM -- should be glue node
glue =>
BEGIN
s←TexGlueDefs.FixGlue[g.g, p.glueset];
qq←gptr;
END;
ENDCASE => BEGIN SIGNAL Confusion; GOTO Exit END;
xend←x+s;
WITH b:q.p SELECT FROM -- should be rule or box
box =>
BEGIN
ww: Dimn←b.width; -- box width
t: INTEGER; -- quotient
IF ww<=0 THEN GOTO Exit;
t←x/ww;
x←ww*(t+1); -- the smallest suitable multiple of ww
SELECT b.dir FROM
hlist => WHILE x+ww<=xend
DO HlistOut[@b,x,y]; x←x+ww ENDLOOP;
vlist => WHILE x+ww<=xend
DO VlistOut[@b,x,y-b.height]; x←x+ww ENDLOOP;
ENDCASE => ERROR;
END;
rule => PutRectangle[x,y-b.height,b.height+b.depth,s]; -- variable horizontal rule
-- note: ignores width of rule
ENDCASE => BEGIN SIGNAL Confusion; GOTO Exit END;
x←xend;
EXITS Exit => NULL END;
ENDCASE => NULL; -- ignore all other types of nodes
qq←qq.link; -- NOT q.link; qq may have been changed!
ENDLOOP;
END;

SkipToNextRecord: PROCEDURE RETURNS[i: CARDINAL] =
BEGIN -- result is number of bytes skipped
index: StreamDefs.StreamIndex;
-- make sure output file is open
index←StreamDefs.GetIndex[outStream];
i←AltoDefs.CharsPerPage-StreamDefs.NormalizeIndex[index].byte;
IF i=AltoDefs.CharsPerPage THEN i←0 -- no skip needed
ELSE StreamDefs.SetIndex[outStream,StreamDefs.ModifyIndex[index,i]];
IF (StreamDefs.GetIndex[outStream].byte MOD AltoDefs.CharsPerPage)#0 THEN ERROR;
END;

CurrentRecord: PROCEDURE RETURNS[CARDINAL] =
BEGIN -- first record of file is numbered 0
RETURN [StreamDefs.NormalizeIndex[StreamDefs.GetIndex[outStream]].page]
END;

-- the main output procedure, produces one page
ShipOut: PUBLIC PROCEDURE[p: BoxNodePtr] =
BEGIN
e: EntityIndex;
padding: CARDINAL;
startrec: CARDINAL;
n: CARDINAL;
lastcount: LONG CARDINAL;

IF needToInit THEN BEGIN SIGNAL Confusion; RETURN END;

IF outStream=nullStream THEN
BEGIN
-- get the output file name and open the output stream
TexSynDefs.AppendOutputFileName[fileName,"TexOut"];
TexStringDefs.AppendString[fileName,".Press"];
outStream←StreamDefs.NewByteStream[name: fileName,
access: StreamDefs.Write+StreamDefs.Append];
END;

IF display AND displayPages THEN -- display it
BEGIN OPEN TexDispDefs;
DisplayPage[p, leftMargin/2, topMargin/2, unitScaling];
END;

-- position stream at start of record
[]←SkipToNextRecord[];
startrec←CurrentRecord[];

StartPage;
VlistOut[p, leftMargin, topMargin]; -- make data and entity lists

-- write data lists
FOR e IN EntityIndex
DO OPEN eState[en];
en←e;
IF (dlist.count MOD 2)#0 THEN DLByte[0]; -- pad to word boundary
WriteList[dlist]; -- flush the buffer
ENDLOOP;
-- construct entity trailers
lastcount←0;
FOR e IN EntityIndex
DO
n←eState[e].dlist.count;
ETrailer[e, lastcount, n];
lastcount←lastcount+n;
ENDLOOP;
Wout[0]; -- zero word to mark beginning of entity lists
-- write entity lists
FOR e IN EntityIndex
DO OPEN eState[en];
en←e; WriteList[elist]; -- ETrailer padded to word
ENDLOOP;
-- pad record
padding←SkipToNextRecord[]/2; -- in words

-- create part entry and fill it in
AddPart[[pagePartType,startrec,CurrentRecord[]-startrec,padding]];

EndPage;
END;

Bout: PROCEDURE[b: UNSPECIFIED] =
BEGIN
outStream.put[outStream, b];
END;

Wout: PROCEDURE[w: UNSPECIFIED] =
BEGIN -- stream should be positioned at a word boundary
[]←StreamDefs.WriteBlock[outStream,@w,1];
END;

END.