// Swat.bcpl - ALTO debugger by (in order of appearance):
// Allen Brown
// Jim Morris
// Bob Sproull
// Peter Deutsch
// David Boggs
// Copyright Xerox Corporation 1979, 1982
// Last modified March 22, 1982 6:23 PM by Boggs
get "Swat.decl"
get "SysDefs.d"
external
[
// outgoing procedures
AfterJunta; Ws; Wss
SwatAllocate; AllocatorWarning
// incoming procedures from Swat
BeforeJuntaInit; AfterJuntaInit
ResidentSwapIn; SwatCommand
VMCache; ResetSymCache; ReportFail
// incoming procedures from OS
AddToZone; Allocate
Puts; DefaultArgs
// incoming statics
sysZone; dsp
]
static savedAllocate
//----------------------------------------------------------------------------
let Swat(nil, upe, nil) be BeforeJuntaInit(upe)
//----------------------------------------------------------------------------
//----------------------------------------------------------------------------
and AfterJunta() be
//----------------------------------------------------------------------------
[
let endCode = AfterJuntaInit()
savedAllocate = sysZone!0; sysZone!0 = SwatAllocate
AddToZone(sysZone, BeforeJuntaInit, endCode-BeforeJuntaInit)
ResidentSwapIn()
SwatCommand()
]
//----------------------------------------------------------------------------
and SwatAllocate(zone, length, returnOnFail, even; numargs na) = valof
//----------------------------------------------------------------------------
// Special allocate which always starts at one end of the zone,
// and takes a chunk from the first block that is big enough.
// ***** Knows about the unpublished structure of a zone *****
[
structure Zone:
[
blank word 4
anchor:
[
blank word
pSbNext word
blank word
]
rover word
blank word 2
]
DefaultArgs(lv na, -2, false, false)
for i = 1 to 2 do
[
zone>>Zone.rover = zone>>Zone.anchor.pSbNext
let maxSize = nil
let sb = savedAllocate(zone, length, lv maxSize, even)
if sb ne 0 resultis sb
if returnOnFail then
[
if returnOnFail ne -1 then @returnOnFail = maxSize
resultis 0
]
AllocatorWarning()
]
ReportFail("Completely out of free storage!")
]
//----------------------------------------------------------------------------
and AllocatorWarning() be
//----------------------------------------------------------------------------
[
Ws("Free storage is really low - caution!*N")
ResetSymCache()
VMCache(vmFlushReset)
]
//----------------------------------------------------------------------------
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)
//----------------------------------------------------------------------------