// FtpOSInit.bcpl -- Initialization for the version of Ftp inside the OS
// Copyright Xerox Corporation 1979, 1980, 1981, 1982
// Last modified October 1, 1982 9:59 PM by Boggs
get "Streams.d"
get "AltoDefs.d"
get "SysDefs.d"
external
[
// outgoing procedure
InitFtpOS
// incoming procedures
InitFtpPList; InitFtpUtil; InitPupLevel1
InitDisplay; InitSysFont; InitComCm; InitLog
MakeBar; MakeTitle; FTPShowDisplayStream
InitializeZone; Allocate; Free
Zero; MoveBlock; SetBlock
MyFrame; Enqueue; Unqueue; CallSwat; SysErr
CliGetString; Ws; InitializeContext; CallContextList
Junta; AfterJunta
// outgoing statics
stackSize; ftpDisk; ctxQ
ramFlag; debugFlag; logFlag; cliFlag; tfsFlag
userFlag; serverFlag; telnetFlag; errorFlag
// incoming statics
sysFont; fontHeight; lastShownStream; userDsp
sysZone; sysDisk; lvSysZone
fpSysFont; fpComCm
FtpRamImage; cliStream; cli
// ground out some undefs
killServer; overwriteServer; protectedServer
TelnetQuit; telnetSoc; telnetDsp; userDspLen
serverCtx; serverSoc; serverDsp
]
static
[
stackSize = 1200; ftpDisk; ctxQ
initDone = false
ramFlag = false; errorFlag = true; debugFlag = false
logFlag = false; cliFlag = false; tfsFlag = false
userFlag = true; serverFlag = false; telnetFlag = false
// ground out some undefs
killServer; overwriteServer; protectedServer
TelnetQuit; telnetSoc; telnetDsp
serverCtx; serverSoc; serverDsp
]
manifest
[
stackLimit = 335b
numPBIs = 12
userDspSLC = 200 //user window size
black = true
white = false
]
//-----------------------------------------------------------------------------------------
let InitFtpOS() be
//-----------------------------------------------------------------------------------------
[
// cursor
@mouseX, @mouseY = 260, 25
for i = 0 to 7 do cursorBitMap!i = 177400b
for i = 8 to 15 do cursorBitMap!i = 377b
// sysZone
let freeBegin = @stackLimit
let freeEnd = MyFrame() -200
@stackLimit = freeEnd
test freeEnd-freeBegin gr 0
ifso sysZone = InitializeZone(freeBegin, freeEnd-freeBegin, SysErr,
(debugFlag? SysErr, 0))
ifnot sysZone = InitializeZone(freeEnd-77777b, 77777b, SysErr,
(debugFlag? SysErr, 0))
@lvSysZone = sysZone
// contexts
ctxQ = Allocate(sysZone, 2); ctxQ!0 = 0
let initCtx = InitializeContext(Allocate(sysZone, 1500), 1500, InitCtx)
Enqueue(ctxQ, initCtx)
CallContextList(ctxQ!0) repeatuntil initDone
Unqueue(ctxQ, initCtx)
Free(sysZone, initCtx)
]
//-----------------------------------------------------------------------------------------
and InitCtx(ctx) be
//-----------------------------------------------------------------------------------------
[
// disk
ftpDisk = sysDisk
// Pup package
InitPupLevel1(sysZone, ctxQ, numPBIs)
// Ftp subsystem
InitSysFont()
InitDisplay()
InitComCm()
// user
MakeTitle(" FTP User")
userDspLen = 7500
userDsp = MakeBar(white, (userDspSLC/(2*fontHeight))*fontHeight)
FTPShowDisplayStream(userDsp)
InitLog()
FTPShowDisplayStream(MakeBar(black, 1))
// Ftp package
InitFtpUtil()
InitFtpPList()
initDone = true
// returning from a context does an implicit Block()
]