// 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() ]