// PDPrint.bcpl -- main program
// derived from Press.bcpl 2/7/83
// errors 100
get "PDInternals.d"
get "PDFile.d"
// outgoing procedures
external
[
PDPrint
WritePageStructure
PDUserFinishProc
PDError
PDErrorV
PDTrap
Scream
GetTime
FSGet
FSGetX
FSPut
FSPutZ
DblShift
SwappedOut
]
// outgoing statics
external
[
//Files, disks
BitsFile //Files for all to use
ScratchFile
LeftOverFile1
LeftOverFile2
MeterFile
PDFile
RunFile
tridentUsed //Non-zero if Trident used (actually, # heads on disk)
tridentVec //Table of trident disk structures
//User's wishes
Directive //Says what to do
UserCopies //Number of copies to make
UserPageStart //First page to reprint
UserPageEnd //Last page to reprint
XOffset //User's specifications of how to perturb pages
YOffset
// PD File information
PDHerald
// Output device information & paper sizes
printerDevice //Code for which device to use
rosDevice //Code for which ROS is in printer
nPrinterColors //1, 3, or 4
useStandardQueue //Puffin/Pimlico use standard 3 or 4 color Q
ResolutionS // number of bits/inch in S
ResolutionB // number of bits/inch in B
PaperDimensionS //10* inches
PaperDimensionB
nScans //Number of scan lines on a page
nBitsPerScan //Number of bits per scan line on a page
// Printer controls
ScanMarginAdjust //Adjustments to add to user input
BitMarginAdjust
mirrorX //True if flip in x (TShirtMode)
invertMode //True if invert black/white
PaperSpeedInches
VersatecFF //Extra form-feeds (256*before+after)
SLOTScanLength //in bits, to give to 3100 interface
SLOTDouble
SLOTTimeOut
//Miscellaneous other stuff
PDWindow //Window open on PD file
FileName //Name of PD file
DPzero //Double precision zero
DoMeter //Gather statistics
DoFileMeter //True if gather stats on each file transfer
Debug //Debugging flag
Verbose //If true, squeal on every error
PDSavedUFP
PDVersion //Version number =a.b = a*256+b
UseRam //True if running on Alto II, else false
UseXM //Try to use extended memory
//Free storage stuff
PDZone //Zone to use for all free storage
PermanentBottom //Bottom of "permanent" free storage
OverlayTable //ovt!i = page of ith overlay
OverlayBottom //Place to put first word of overlay
OverlayTop //Place where last word of overlay is
OverlayReloc //Pointer to relocation table for overlay
]
static
[
BitsFile
ScratchFile
LeftOverFile1
LeftOverFile2
BandFile
MeterFile
PDFile
RunFile
tridentUsed
tridentVec
Directive
UserCopies
UserPageStart
UserPageEnd
XOffset
YOffset
PDHerald
printerDevice
rosDevice
nPrinterColors
useStandardQueue
ResolutionS
ResolutionB
PaperDimensionS
PaperDimensionB
nScans
nBitsPerScan
ScanMarginAdjust
BitMarginAdjust
invertMode
mirrorX
PaperSpeedInches
VersatecFF
SLOTScanLength
SLOTDouble
SLOTTimeOut
PDWindow
FileName
DPzero
DoMeter
DoFileMeter
Debug
Verbose
PDSavedUFP
PDVersion = 1 * 256 + 1;
UseXM
UseRam
PDZone
PermanentBottom
OverlayTable
OverlayBottom
OverlayTop
OverlayReloc
]
// incoming procedures
external
[
//Main procedures for the various passes.
PDInit
ConvertInit
Convert
ConvertClose
PrintInit
Print
PrintClose
SlotRam
PrintRam
//WINDOW,FILES
WindowInit
WindowClose
WindowGetPosition
WindowSetPosition
WindowReadBlock
WindowWriteBlock
WindowReadByte
WindowRead
WindowWrite
WindowFlush
FileStuff
FileWritePage
//METER
MeterBlock
MeterClose
//OS
MoveBlock
lvUserFinishProc
StartIO
SysErr
//PDML
DoubleAdd; DoubleSub; DoubleCop; MulDiv
Ugt
//ALLOC
InitializeZone
AddToZone
Allocate
Free
//MAKEPATTERNS
MakePatterns
//LOADRAM
LoadRam
SetBLV
//TFS
TFSSilentBoot //around all the time (tfsa)
]
// incoming statics
external
[
UserName
]
// internal statics
static
[
FSTrap //To flag storage coming and going.
nPages
Pages
]
// File-wide structure and manifest declarations.
manifest
[
hgOutPort=#177101
]
// Procedures
let PDPrint(layout, userParams, cfa) be
[
DPzero= table [ 0;0 ]
//First, call initialization routine. It will call PDPrint(0) when it is finished.
if layout ne 0 then PDInit(userParams, cfa)
//Here, the zone in use is still the "permanent" zone. So allocate what
// you need.
PDHerald=FSGetX(lPDHerald)
Pages=FSGetX(nPagesAtOnce*lPageG)
if (Directive&dirPDScan) ne 0 then
[
PDWindow=WindowInit(PDFile)
WindowReadBlock(PDWindow, PDHerald, lPDHerald)
if PDHerald>>PDH.password ne PDPasswd then PDError(100)
if PDHerald>>PDH.version ne 1 then PDError(101)
UserCopies=Max(UserCopies,PDHerald>>PDH.copies)
if PDHerald>>PDH.sResolution ne ResolutionS then PDError(102)
if PDHerald>>PDH.fResolution ne ResolutionB then PDError(103)
if PDHerald>>PDH.imageSSize ugr nScans then PDError(104)
if PDHerald>>PDH.imageFSize ugr nBitsPerScan then PDError(105)
]
//Now switch to a real zone that can allocate and free
FSInit()
if (Directive&dirPatterns) ne 0 then
[
Overlay(0)
MakePatterns()
]
//SCAN CONVERSION & PRINTING PASSES
// These are dovetailed to handle the finite capacity of the disk for buffering
// scan-converted pages. The basic idea is to scan-convert until the disk fills
// and then print.
let PrintInited=false //True if printer set up
let veryFirstPrinting=true
let ScanInited=false //True if scan-converter set up
let convertResult=-2 //So pre-made patterns work right
// ***** L O O P F I L L I N G D I S K *****
[DiskLoop //Loop filling up disk buffers
let BitPagePos = 1 //leave room for WritePageStructure
nPages=0
// ***** L O O P O N P A G E S (Scan Conversion) *****
if (Directive&dirPDScan) ne 0 then
[Convert
while nPages le nPagesAtOnce do
[PageLoop //Loop scan converting pages
unless ScanInited then
[
if PrintInited then PrintClose(false)
PrintInited=false
Overlay(1)
PassC: ConvertInit()
ScanInited=true
]
let p=Pages+nPages*lPageG
p>>PageG.BitPage=BitPagePos
// Returns -1 if not enough room in bits file, -2 if end of file, else number
// of bits file records used to record the scan-converted data
convertResult=Convert(p)
if convertResult eq -1 & nPages eq 0 then PDError(106)
if convertResult ls 0 then break //Done filling available disk file
BitPagePos=BitPagePos+convertResult
nPages=nPages+1
// Must not start a new "feed" page if there are not enough pages
// for each color
if p>>PageG.strip ne 0 &
nPagesAtOnce-nPages ls nPrinterColors then break
]PageLoop
WritePageStructure(Pages, nPages)
]Convert
// ***** L O O P O N P A G E S (Printing) *****
if (Directive&(dirPrint%dirDisplay)) ne 0 then
[Print
ReadPageStructure(Pages, lv nPages)
let oldPrinterDevice=printerDevice
if (Directive&dirDisplay) ne 0 then printerDevice=-1
let lastPage=Min(UserPageEnd,nPages)
for copy=1 to UserCopies do
for printPage=UserPageStart to lastPage do
[PageLoop
let p=Pages+(printPage-1)*lPageG
// Printing routine will decide whether to print blank pages (those
// with FirstBand le LastBand).
unless PrintInited then
[
if ScanInited then ConvertClose()
ScanInited=false
test printerDevice gr printerOrbitLast
then Overlay(2, lv SlotRam)
or Overlay(2, lv PrintRam)
PassP:
PrintInit(veryFirstPrinting, p,
lastPage-UserPageStart+1, UserCopies)
PrintInited=true
veryFirstPrinting=false
]
let stop=(printPage eq lastPage)&(copy eq UserCopies)
Print(p, stop, OverlayTop+1, PermanentBottom-1)
]PageLoop
printerDevice=oldPrinterDevice
]Print
]DiskLoop repeatuntil convertResult eq -2
if PrintInited then PrintClose(true)
//And finish statistics:
compileif MeterSw then [ MeterClose() ]
finish //!!!
]
and WritePageStructure(Pages, nPages) be
[
let b=WindowInit(BitsFile)
WindowWrite(b, nPages)
WindowWriteBlock(b, Pages, nPages*lPageG)
WindowClose(b)
]
and ReadPageStructure(Pages, lvnPages) be
[ let b=WindowInit(BitsFile)
@lvnPages=WindowRead(b)
WindowReadBlock(b, Pages, @lvnPages*lPageG)
WindowClose(b)
]
//Miscellaneous
and PDError(code, p1, p2, p3, p4) be
[
(table [ #77403; #1401 ])("PDPrint.Errors", lv code)
]
and PDErrorV(code, p1, p2, p3, p4) be
[
if Verbose then PDError(code, p1, p2, p3, p4)
]
and PDTrap() be PDError(107)
and Scream(String) be PDError(108)
and GetTime(ptr, ref; numargs n) = valof
[
let time=@#430
if n eq 1 then [ @ptr=time-@ptr ]
if n eq 2 then [ @ptr=@ptr+(time-ref) ]
resultis time
]
and DblShift(dblwordlv,amount) = valof
[
test amount ls 0 then //Left shift
[
amount=-amount
let temp=(dblwordlv!1) rshift (16-amount)
@dblwordlv=(@dblwordlv lshift amount)+temp
dblwordlv!1=(dblwordlv!1) lshift amount
]
or
[
let temp=@dblwordlv lshift (16-amount)
@dblwordlv=@dblwordlv rshift amount
dblwordlv!1=((dblwordlv!1) rshift amount)+temp
]
resultis dblwordlv!1 //low order 16 bits
]
and Max(a,b) = (a gr b)? a,b
and Min(a,b) = (a gr b)? b,a
//Free storage functions
//
// FSGet(size)
// Tries to get a block of size "size". Returns pointer or zero.
// FSGetX(size)
// Like FSGet, but complains if core unavailable.
// FSPut(ptr)
// Release block seized by FSGet or FSGetX
// FSPutZ(lvptr)
// Release block pointed to by @lvptr and zero pointer
//
and FSInit(permBot; numargs n) be
[
//Maximum size of an individual block is 32K. But we can give two blocks
// to FS package. They will never be merged.
if n eq 0 then permBot=PermanentBottom
let len=permBot-OverlayTop-1
let flen=len
if Ugt(flen, #77776) then flen=#77776
PDZone=InitializeZone(OverlayTop+1, flen, SysErr, (Debug? SysErr,0))
if len-flen gr 30 then
[
let b=OverlayTop+1+flen+10
AddToZone(PDZone, b, len-flen-10)
]
]
and FSGet(Size) = valof
[
let ptr=Allocate(PDZone, Size, -1)
if ptr ne 0 & ptr eq FSTrap then PDError(111)
resultis ptr
]
and FSGetX(Size) = valof
[
let p=FSGet(Size)
if p eq 0 then PDError(110)
resultis p
]
and FSPut(ptr) be
[
if ptr eq FSTrap then PDError(111)
Free(PDZone, ptr)
]
and FSPutZ(lvptr) be
[
FSPut(@lvptr)
@lvptr=0
]
and PDUserFinishProc() be
[
if printerDevice eq printerHg then @hgOutPort = 0
StartIO(#100000) // Silent boot because BLV set at init time.
@lvUserFinishProc=PDSavedUFP
]
and Overlay(i, lvInitRam; numargs n) be
[
let p=OverlayReloc
for i=1 to OverlayReloc!0 do
[
@(p!1)=SwappedOut
p=p+2
]
let pn=OverlayTable!i
PDZone=InitializeZone(PermanentBottom-2000,2000)
let R=WindowInit(RunFile)
let pos=vec 1
pos!0=0; pos!1=pn-1
DblShift(pos, -8)
WindowSetPosition(R, pos)
let dope=vec 16
WindowReadBlock(R, dope, 16)
let len=dope!4-16
WindowReadBlock(R, OverlayBottom, len)
OverlayReloc=OverlayBottom+dope!3-16
let nRel=OverlayReloc!0 *2
for p=1 to nRel by 2 do
[
@(OverlayReloc!p)=OverlayReloc!(p+1)+OverlayBottom
]
OverlayTop=OverlayBottom+len
//If there is an initialization routine, call it. Then move reloc table down over
// it so we can find them when doing the next overlay.
if n ne 1 then
[
let bot=@lvInitRam
if UseRam then
[
if tridentUsed then TFSSilentBoot()
LoadRam(bot, true)
SetBLV(#177776) //Prepare for silent boot on finish.
if tridentUsed then StartIO(#40)
]
MoveBlock(LoadRam, OverlayReloc, nRel+1)
OverlayReloc=LoadRam
OverlayTop=OverlayReloc+nRel+1
]
FSInit()
]
and SwappedOut() be PDError(120)