<> <> <> <> <> <> <> DIRECTORY Ascii USING [ControlA, BS, ControlQ, ControlW, ControlX, CR, DEL, ESC, FF, SP], BodyDefs USING [maxRNameLength], BringOverCall USING [CedarBringOver], CedarInitOps USING [Seconds], CedarInitPrivate USING [DoLoading, ErrorCode, FatalError, ValidateMicrocode], CedarInitSequence USING [StartCedarCore, StartCedarUserInterface, StartCedarTools], CedarSnapshot USING [RollBack], CedarVersion USING [ bootFileDate, machineType, MachineType, major, minor, patch, uCodeCedar, uCodeDate, uCodeVersion, uCodeFloatingPoint], ConvertUnsafe USING[ToRope], DateAndTimeUnsafe USING [Notes, Parse], Directory USING [Error, GetProps, Lookup], File USING [Capability, GetSize], Format USING [Char, Date, Decimal, LongString, StringProc], Heap USING [systemMDSZone, systemZone], Inline USING [BITAND, LowHalf], IO USING[CreateProcsStream, CreateRefStreamProcs, GetChar, Handle, PutF, PutFR, PutRope, Signal, string], LongString USING [AppendString], PilotClient USING [], PilotSwitches USING [switches --.d, .l--], Process USING [Pause, SecondsToTicks, Ticks], ProcessorFace USING [PowerOff], Rope USING [Equal, Lower, ROPE, Text], RopeInline USING[InlineFlatten], Runtime USING [GetBuildTime, IsBound], Space USING [Create, Delete, Handle, Map, mds, Pointer], SpecialTerminal USING [ DisableCursorTracking, DisableTypescriptFile, EnableCursorTracking, EnableTypescriptFile, GetProc, InputTimeout, PutProc, SetInputTimeout, TerminalOn, tty, TurnOff, TurnOffInternal, TurnOn, TurnOnInternal], Storage USING [Free], STP USING [ Close, CompletionProcType, ConfirmProcType, Create, CredentialsErrors, Destroy, Enumerate, Error, FileErrors, FileInfo, GetFileInfo, Handle, Login, NoteFileProcType, Open, Retrieve], String USING [ AppendChar, AppendString, AppendSubString, EqualSubStrings, StringBoundsFault, SubStringDescriptor], System USING [ GetGreenwichMeanTime, GreenwichMeanTime, gmtEpoch, SecondsSinceEpoch], TemporaryBooting USING [BootFromVolume, defaultSwitches, Switch], TerminalMultiplex USING [ InputController, PermitDebuggerSwaps, PreventDebuggerSwaps, RegisterInputController], TTY USING [ CharsAvailable, GetChar, GetEditedString, GetID, Handle, LineOverflow, LongSubStringDescriptor, PutChar, PutCR, PutDate, PutDecimal, PutLine, PutLongString, PutString, PutLongSubString, PutSubString, SetEcho, Rubout, UserAbort], UserCredentials USING [ ChangeCredentialsState, GetCredentialsState, GetUserCredentials, Login, SetUserCredentials, State], UserCredentialsUnsafe USING [GetCredentialsState, GetUserCredentials, State], UserTerminal USING [ Coordinate, cursor, CursorArray, GetCursorPattern, screenHeight, screenWidth, SetBackground, SetCursorPattern, SetState], Volume USING [GetType, ID, systemID]; CedarInitMain: MONITOR IMPORTS BringOverCall, CedarInitPrivate, CedarInitSequence, CedarSnapshot, CedarVersion, ConvertUnsafe, DateAndTimeUnsafe, Directory, File, Format, Heap, Inline, IO, LongString, PilotSwitches, Process, ProcessorFace, Rope, RopeInline, Runtime, Space, SpecialTerminal, Storage, STP, String, System, TemporaryBooting, TerminalMultiplex, TTY, UserCredentials, UserCredentialsUnsafe, UserTerminal, Volume EXPORTS CedarInitOps, CedarVersion, PilotClient SHARES SpecialTerminal = BEGIN -- Global Variables (not exported) -- basicCedar: BOOLEAN = ~Runtime.IsBound[CedarInitSequence.StartCedarCore]; initTTY: TTY.Handle; -- copy of SpecialTerminal.tty, for convenience -- Exports to CedarVersion -- major: PUBLIC CARDINAL _ 4; minor: PUBLIC CARDINAL _ 5; patch: PUBLIC CARDINAL _ 0; bootFileDate: PUBLIC System.GreenwichMeanTime _ Runtime.GetBuildTime[]; -- Exports to CedarInitOps -- longDialogue: PUBLIC BOOLEAN _ PilotSwitches.switches.l = down; salvageLSD: PUBLIC BOOL _ FALSE; -- Eventually, CIFS should ask using the initial screen. Install: PUBLIC PROC RETURNS [worked: BOOLEAN] = {RETURN[DoInstallation[booting: FALSE]]}; EnsureUsableMicrocode: PUBLIC ENTRY PROC = { ucodeError: LONG STRING _ CedarInitPrivate.ValidateMicrocode[]; IF ucodeError = NIL THEN RETURN; [] _ SpecialTerminal.TurnOn[]; ReportUCodeError[ucodeError]; SpecialTerminal.TurnOff[]; }; sleeping: BOOLEAN _ FALSE; napOver: CONDITION _ [timeout: 0]; Sleep: PUBLIC PROC [ cursor: LONG POINTER TO UserTerminal.CursorArray _ NIL, powerOff: CedarInitOps.Seconds _ 0] = { NapNeeded: ENTRY PROC RETURNS [needed: BOOL] = INLINE { IF (needed _ ~sleeping) THEN sleeping _ TRUE ELSE WHILE sleeping DO WAIT napOver ENDLOOP; }; WakeUp: ENTRY PROC = {sleeping _ FALSE; BROADCAST napOver}; DoLogin: PROC RETURNS [wake: BOOL _ TRUE] = { state: UserCredentials.State = UserCredentials.GetCredentialsState[]; name, password: Rope.ROPE; [name, password] _ UserCredentials.GetUserCredentials[]; PrintGreeting[]; SpecialTerminal.SetInputTimeout[Process.SecondsToTicks[60]]; UserCredentials.Login[options: [confirmCredentialsOverwrite: TRUE, alwaysPrompt: TRUE] ! SpecialTerminal.InputTimeout => {wake _ FALSE; CONTINUE}]; IF wake THEN { IF state = nameHint AND --HACK-- (powerOff ~= CedarInitOps.Seconds.LAST) AND ~Rope.Equal[UserCredentials.GetUserCredentials[].name, name, FALSE] THEN { <> IF Confirm["You weren't previously logged in. To log you in, I will have to rollback.\NIs that what you want?"L ! SpecialTerminal.InputTimeout => CONTINUE] THEN { CedarSnapshot.RollBack[Volume.systemID]; IF Confirm["Rollback failed. Shall I try to boot the system volume instead?"L] THEN TemporaryBooting.BootFromVolume[Volume.systemID]; }; <> UserCredentials.SetUserCredentials[name, password]; [] _ UserCredentials.ChangeCredentialsState[state]; wake _ FALSE; }; } ELSE <> UserCredentials.SetUserCredentials[name, password]; SpecialTerminal.SetInputTimeout[0]; }; IF ~NapNeeded[] THEN RETURN; TerminalMultiplex.PreventDebuggerSwaps[]; SleepInternal[DoLogin, cursor, powerOff]; TerminalMultiplex.PermitDebuggerSwaps[]; WakeUp[]; }; -- Sleep stuff -- SleepInternal: PROC [ actionProc: PROC RETURNS [wake: BOOL], cursor: LONG POINTER TO UserTerminal.CursorArray _ NIL, powerOff: CedarInitOps.Seconds _ 0] = { oldCursor: UserTerminal.CursorArray; typeKey: UserTerminal.CursorArray _ [ 002000B, 074000B, 140000B, 012767B, 012525B, 053566B, 111113B, 163100B, 000000B, 000000B, 154000B, 053520B, 062520B, 053360B, 155440B, 000140B]; ticksPerSecond: Process.Ticks = Process.SecondsToTicks[1]; <> DisableGreeting[]; [] _ SpecialTerminal.TurnOn[]; EnableGreeting[]; oldCursor _ UserTerminal.GetCursorPattern[]; DO -- loops only if actionProc returns FALSE fellAsleep: LONG CARDINAL = System.SecondsSinceEpoch[System.GetGreenwichMeanTime[]]; <> nRandoms: CARDINAL = 20; RandIndex: TYPE = [0..nRandoms); randTable: ARRAY RandIndex OF CARDINAL _ [ 30200, 27432, 62096, 39855, 17884, 58726, 55595, 20904, 28164, 27447, 34709, 35231, 33770, 31508, 40689, 1411, 20373, 3422, 62938, 40035]; randIndex: RandIndex _ 16; Random: PROC RETURNS [r: CARDINAL] = { <> i: RandIndex; randIndex _ IF randIndex = LAST[RandIndex] THEN FIRST[RandIndex] ELSE SUCC[randIndex]; i _ (randIndex + 3) MOD nRandoms; r _ randTable[i] _ randTable[randIndex] + randTable[i]; }; [] _ UserTerminal.SetState[off]; [] _ UserTerminal.SetBackground[black]; IF cursor = NIL THEN cursor _ @typeKey; UserTerminal.SetCursorPattern[cursor^]; SpecialTerminal.DisableCursorTracking[]; DO xy: UserTerminal.Coordinate _ UserTerminal.cursor^; GetDelta: PROC RETURNS [INTEGER] = INLINE { r: CARDINAL = Random[]; RETURN[ SELECT TRUE FROM Inline.BITAND[r, 100000B] ~= 0 => 0, Inline.BITAND[r, 40000B] ~= 0 => 16, ENDCASE => -16]}; SELECT (xy.x _ xy.x + GetDelta[]) FROM < 0 => xy.x _ UserTerminal.screenWidth - 16; >= UserTerminal.screenWidth - 16 => xy.x _ 0; ENDCASE; SELECT (xy.y _ xy.y + GetDelta[]) FROM < 0 => xy.y _ UserTerminal.screenHeight - 16; >= UserTerminal.screenHeight - 16 => xy.y _ 0; ENDCASE; UserTerminal.cursor^ _ xy; IF initTTY.CharsAvailable[] > 0 THEN { [] _ initTTY.GetChar[]; -- discard first char, save type-ahead EXIT}; Process.Pause[((Random[] MOD 8) * ticksPerSecond) / 4]; IF powerOff ~= 0 AND fellAsleep + powerOff <= System.SecondsSinceEpoch[System.GetGreenwichMeanTime[]] THEN ProcessorFace.PowerOff[]; UserTerminal.SetCursorPattern[cursor^]; -- in case some running program messed it up. ENDLOOP; SpecialTerminal.EnableCursorTracking[]; UserTerminal.SetCursorPattern[oldCursor]; [] _ UserTerminal.SetBackground[white]; [] _ UserTerminal.SetState[on]; IF actionProc[] THEN EXIT; ENDLOOP; SpecialTerminal.TurnOff[]; }; -- I/O utilities -- GetCedarVersion: PROC RETURNS [v: LONG STRING, versionLength: CARDINAL] = { Append: Format.StringProc = {LongString.AppendString[v, s]}; v _ Heap.systemZone.NEW[StringBody[9+5+1+5+1+5+4+14]]; <<"ISLCedar nnnnn.mmmmm.ppppp of dd-mmm-yy hh:mm">> Format.LongString["ISLCedar "L, Append]; Format.Decimal[CedarVersion.major, Append]; Format.Char['., Append]; Format.Decimal[CedarVersion.minor, Append]; IF CedarVersion.patch ~= 0 THEN {Format.Char['., Append]; Format.Decimal[CedarVersion.patch, Append]}; versionLength _ v.length; Format.LongString[" of "L, Append]; Format.Date[LOOPHOLE[CedarVersion.bootFileDate], noSeconds, Append]; }; PromptForCredentials: PROC [name, password: STRING] = { <> defaultRegistry: STRING = ".pa"L; cancel: STRING = " XXX\N"L; DO initTTY.PutString["Name: "L]; [] _ GetInitializedString[name ! TTY.Rubout => {initTTY.PutString[cancel]; LOOP}]; FOR i: CARDINAL DECREASING IN [0..name.length) DO IF name[i] = '. THEN EXIT; REPEAT FINISHED => { initTTY.PutString[defaultRegistry]; String.AppendString[name, defaultRegistry]; }; ENDLOOP; initTTY.PutString[" password: "L]; [] _ initTTY.SetEcho[FALSE]; [] _ initTTY.GetID[password ! TTY.Rubout => {[] _ initTTY.SetEcho[TRUE]; initTTY.PutString[cancel]; LOOP}]; [] _ initTTY.SetEcho[TRUE]; EXIT ENDLOOP; initTTY.PutCR[]; }; GetInitializedString: PROC [str: STRING] RETURNS [c: CHARACTER] = { <> OPEN Ascii; firstTime: BOOLEAN _ TRUE; Check: PROC [c: CHARACTER] RETURNS [yes: BOOLEAN] = { IF firstTime THEN { SELECT c FROM ControlA, BS, ControlQ, ControlW, ControlX, CR, SP => NULL; ENDCASE => { THROUGH [0..str.length) DO initTTY.PutChar[BS] ENDLOOP; str.length _ 0}; firstTime _ FALSE}; RETURN[c = SP OR c = CR]}; initTTY.PutString[str]; c _ initTTY.GetEditedString[str, Check, FALSE ! TTY.LineOverflow => RESUME[str _ String.StringBoundsFault[str]] ]; }; Confirm: PROC [message: STRING _ NIL] RETURNS [BOOLEAN] = { IF message ~= NIL THEN initTTY.PutString[message]; DO SELECT initTTY.GetChar[] FROM 'y, 'Y, Ascii.SP, Ascii.CR, Ascii.ESC => {initTTY.PutLine[" Yes"L]; RETURN[TRUE]}; 'n, 'N, Ascii.DEL => {initTTY.PutLine[" No"L]; RETURN[FALSE]}; ENDCASE; ENDLOOP; }; ConfirmForBringOver: SAFE PROC[in, out: IO.Handle, data: REF ANY, msg: Rope.ROPE, dch: CHAR] RETURNS[CHAR] = CHECKED { ch: CHAR; bs: IO.Handle; out.PutRope[msg]; DO ENABLE IO.Signal => IF ec = Rubout THEN LOOP; out.PutF["? "]; bs _ IF in.backingStream = NIL THEN in ELSE in.backingStream; ch _ bs.GetChar[]; IF ch = '\n THEN ch _ dch; ch _ Rope.Lower[ch]; RETURN[ch]; ENDLOOP; }; -- Installation Driver -- DoInstallation: PROC [booting: BOOLEAN] RETURNS [worked: BOOLEAN _ FALSE] = { <.>> expectedVersion: STRING = "// September 15, 1983 11:00 am"L; expectedVersionSS: String.SubStringDescriptor _ [expectedVersion, 0, expectedVersion.length]; versionFile: STRING = "Cedar.version"L; TextFile: TYPE = DESCRIPTOR FOR PACKED ARRAY OF CHARACTER; GetLine: PROC [t: TextFile, offset: CARDINAL] RETURNS [ss: String.SubStringDescriptor] = { ss _ [base: LOOPHOLE[BASE[t], STRING] - SIZE[StringBody[0]], offset: offset, length: 0]; FOR i: CARDINAL IN [offset..LENGTH[t]) UNTIL t[i] = Ascii.CR DO REPEAT FINISHED => ss.length _ i - offset; ENDLOOP}; WithFileDo: PROC [file: STRING, proc: PROC [TextFile]] = { cap: File.Capability = Directory.Lookup[file]; space: Space.Handle _ Space.Create[size: Inline.LowHalf[File.GetSize[cap]-1], parent: Space.mds]; bytes: CARDINAL = Inline.LowHalf[Directory.GetProps[cap, file].byteLength]; Space.Map[space, [cap, 1]]; proc[DESCRIPTOR[Space.Pointer[space], bytes]]; Space.Delete[space]}; expectedCreation: System.GreenwichMeanTime; -- parsed contents of 'expectedVersion' ParseExpectedVersion: PROC = INLINE { temp: STRING _ Heap.systemMDSZone.NEW[StringBody[expectedVersion.length]]; notes: DateAndTimeUnsafe.Notes; ss: String.SubStringDescriptor; i: CARDINAL; FOR i IN [0..expectedVersion.length) DO IF expectedVersion[i] = Ascii.SP THEN EXIT; REPEAT FINISHED => ERROR; ENDLOOP; FOR i IN [i..expectedVersion.length) DO IF expectedVersion[i] ~= Ascii.SP THEN EXIT; REPEAT FINISHED => ERROR; ENDLOOP; ss _ [expectedVersion, i, expectedVersion.length - i]; String.AppendSubString[temp, @ss]; [expectedCreation, notes] _ DateAndTimeUnsafe.Parse[temp]; IF ~(notes IN [normal..zoneGuessed]) THEN ERROR; Heap.systemMDSZone.FREE[@temp]}; CheckInstalledSystemVersion: PROC RETURNS [ok: BOOLEAN _ FALSE] = { CheckVersionLine: PROC [text: TextFile] = { ss: String.SubStringDescriptor _ GetLine[text, 0]; -- throw away line 1 (compatibility) ss _ GetLine[text, ss.length+1]; ok _ String.EqualSubStrings[@ss, @expectedVersionSS]}; WithFileDo[versionFile, CheckVersionLine ! ANY => CONTINUE]}; PrintBootSwitches: PROC = { initTTY.PutString["Pilot boot switches:"L]; IF PilotSwitches.switches = TemporaryBooting.defaultSwitches THEN initTTY.PutString[" (default)"L] ELSE { switches: PACKED ARRAY TemporaryBooting.Switch OF BOOLEAN = LOOPHOLE[PilotSwitches.switches]; FOR sw: TemporaryBooting.Switch IN [zero..y] DO IF switches[sw] THEN { initTTY.PutChar[Ascii.SP]; initTTY.PutChar[(IF sw <= nine THEN '0 ELSE 'A-10)+LOOPHOLE[sw]]}; ENDLOOP; IF PilotSwitches.switches.z = down THEN initTTY.PutString[" Z"L]; }; initTTY.PutString["\N\N"L]; }; DoSTPOperation: PROC [server: STRING, proc: PROC [stp: STP.Handle]] = { stp: STP.Handle _ NIL; name: STRING _ [BodyDefs.maxRNameLength]; password: STRING _ [BodyDefs.maxRNameLength]; UserCredentialsUnsafe.GetUserCredentials[name, password]; DO BEGIN ENABLE STP.Error => { SELECT code FROM <> noNameLookupResponse => initTTY.PutString["can't find server"L]; <> noRouteToNetwork => initTTY.PutString["inaccessible"L]; connectionTimedOut => initTTY.PutString["not responding"L]; connectionRejected, connectionClosed => initTTY.PutString["busy"L]; ENDCASE => initTTY.PutString["(unexpected error -- see Levin)"L]; IF Confirm[", retry?"L] THEN RETRY ELSE EXIT}; herald: STRING; IF stp ~= NIL THEN [] _ STP.Destroy[stp ! STP.Error => CONTINUE]; stp _ STP.Create[]; initTTY.PutString["Opening connection to "L]; initTTY.PutString[server]; initTTY.PutString["..."L]; herald _ STP.Open[stp, server]; initTTY.PutLine["open"L]; initTTY.PutLine[herald]; Storage.Free[herald]; BEGIN ENABLE STP.Error => { SELECT code FROM IN STP.CredentialsErrors => { initTTY.PutString["unacceptable credentials ("L]; initTTY.PutString[error]; -- the server's message initTTY.PutLine[")"L]; PromptForCredentials[name, password]; RETRY}; connectionTimedOut => {initTTY.PutLine["(timeout)"L]; LOOP}; ENDCASE}; STP.Login[stp, name, password]; proc[stp]; END; END; STP.Close[stp ! STP.Error => CONTINUE]; EXIT ENDLOOP; IF stp ~= NIL THEN [] _ STP.Destroy[stp ! STP.Error => CONTINUE]; }; RetrieveDF: PROC [server, path: STRING] RETURNS [localName: STRING _ NIL] = { newestCreation: System.GreenwichMeanTime _ System.gmtEpoch; newestVersion: STRING _ Heap.systemMDSZone.NEW[StringBody[5]]; -- initial size remoteName: String.SubStringDescriptor _ [base: path, offset: 0, length: path.length-2]; creation: System.GreenwichMeanTime; RetrieveSpecificDF: PROC [stp: STP.Handle] = { CheckIfInteresting: STP.ConfirmProcType = { info: STP.FileInfo = STP.GetFileInfo[stp]; -- Note: storage for info^ is inside stp^ notes: DateAndTimeUnsafe.Notes; threshold: LONG CARDINAL = MAX[ System.SecondsSinceEpoch[expectedCreation], System.SecondsSinceEpoch[newestCreation]]; answer _ do; localStream _ NIL; [creation, notes] _ DateAndTimeUnsafe.Parse[info.create]; IF ~(notes IN [normal..zoneGuessed]) THEN RETURN; IF localName = NIL THEN { localName _ Heap.systemMDSZone.NEW[StringBody[info.body.length]]; String.AppendString[localName, info.body]}; IF System.SecondsSinceEpoch[creation] <= threshold THEN answer _ skip}; CheckIfProperFile: STP.CompletionProcType = { SELECT what FROM ok => { info: STP.FileInfo = STP.GetFileInfo[stp]; -- Note: storage for info^ is inside stp^ CheckIfNewer: PROC [text: TextFile] = { ss: String.SubStringDescriptor _ GetLine[text, 0]; IF String.EqualSubStrings[@ss, @expectedVersionSS] THEN { IF newestVersion.length < info.version.length THEN { Heap.systemMDSZone.FREE[@newestVersion]; newestVersion _ Heap.systemMDSZone.NEW[StringBody[info.version.length]]}; newestVersion.length _ 0; String.AppendString[newestVersion, info.version]; newestCreation _ creation}}; WithFileDo[localName, CheckIfNewer]}; error => NULL; -- probably file not found; handle after Retrieve is complete ENDCASE}; EnsureProperLocalFile: PROC RETURNS [ok: BOOLEAN _ TRUE] = { cap: File.Capability; IF localName = NIL OR newestCreation = System.gmtEpoch THEN GO TO notFound; cap _ Directory.Lookup[localName ! Directory.Error => GO TO notFound]; IF Directory.GetProps[cap, localName].createDate ~= newestCreation THEN { remoteFile: STRING _ Heap.systemMDSZone.NEW[StringBody[path.length-1+newestVersion.length]]; String.AppendString[remoteFile, path]; remoteFile.length _ remoteFile.length - 1; -- remove trailing * String.AppendString[remoteFile, newestVersion]; STP.Retrieve[stp, remoteFile]; Heap.systemMDSZone.FREE[@remoteFile]}; initTTY.PutChar['!]; initTTY.PutLine[newestVersion]; Heap.systemMDSZone.FREE[@newestVersion]; EXITS notFound => {initTTY.PutLine["not found!"L]; RETURN[FALSE]}}; -- Main body of RetrieveSpecificDF -- initTTY.PutString["Retrieving "]; initTTY.PutSubString[@remoteName]; initTTY.PutString["..."L]; STP.Retrieve[stp, path, CheckIfInteresting, CheckIfProperFile ! STP.Error => IF code IN STP.FileErrors THEN CONTINUE]; IF ~EnsureProperLocalFile[] AND localName ~= NIL THEN Heap.systemMDSZone.FREE[@localName]}; -- Main body of RetrieveDF -- DoSTPOperation[server, RetrieveSpecificDF]}; useWorkingDir: BOOL _ PilotSwitches.switches.d = down; GetPaths: PROC RETURNS[server, path, basicPath, fatPath: STRING] = { debuggerVolume: BOOL = Volume.GetType[Volume.systemID] ~= normal; regularServer: STRING = "Indigo"L; regularPathDir: STRING = "Top>"L; debuggingServer: STRING = "Indigo"L; debuggingPathDir: STRING = "Top>"L; fullFront: STRING = "Cedar"L; fullBack: STRING = ".df!*"L; basicFront: STRING = "BasicCedar"L; basicBack: STRING = ".df"L; fatBack: STRING = "Fat.df"L; client: STRING = "Client"L; debugger: STRING = "Debugger"L; serverLength, pathLength, basicPathLength, fatPathLength: CARDINAL; IF longDialogue THEN useWorkingDir _ Confirm["BringOver from working directories?"L]; serverLength _ IF useWorkingDir THEN debuggingServer.length ELSE regularServer.length; pathLength _ fullFront.length + fullBack.length + (IF useWorkingDir THEN debuggingPathDir.length ELSE regularPathDir.length) + (IF debuggerVolume THEN debugger.length ELSE client.length); basicPathLength _ basicFront.length + basicBack.length + (IF useWorkingDir THEN debuggingPathDir.length ELSE regularPathDir.length) + (IF debuggerVolume THEN debugger.length ELSE client.length); fatPathLength _ fullFront.length + fatBack.length + (IF useWorkingDir THEN debuggingPathDir.length ELSE regularPathDir.length) + (IF debuggerVolume THEN debugger.length ELSE client.length); server _ Heap.systemMDSZone.NEW[StringBody[serverLength]]; String.AppendString[server, IF useWorkingDir THEN debuggingServer ELSE regularServer]; path _ Heap.systemMDSZone.NEW[StringBody[pathLength]]; basicPath _ Heap.systemMDSZone.NEW[StringBody[basicPathLength]]; fatPath _ Heap.systemMDSZone.NEW[StringBody[fatPathLength]]; IF useWorkingDir THEN { String.AppendString[path, debuggingPathDir]; String.AppendString[basicPath, debuggingPathDir]; String.AppendString[fatPath, debuggingPathDir]; } ELSE { String.AppendString[path, regularPathDir]; String.AppendString[basicPath, regularPathDir]; String.AppendString[fatPath, regularPathDir]; }; String.AppendString[path, fullFront]; String.AppendString[basicPath, basicFront]; String.AppendString[fatPath, fullFront]; IF debuggerVolume THEN { String.AppendString[path, debugger]; String.AppendString[basicPath, debugger]; String.AppendString[fatPath, debugger]; } ELSE { String.AppendString[path, client]; String.AppendString[basicPath, client]; String.AppendString[fatPath, client]; }; String.AppendString[path, fullBack]; String.AppendString[basicPath, basicBack]; String.AppendString[fatPath, fatBack]; }; DoBringOver: PROC [dfFileName, server, basicCedarPath, fatCedarPath: STRING] = { switches: ARRAY CHAR['a .. 'z] OF BOOL _ ALL[FALSE]; listOfFiles: LIST OF Rope.Text; in, out: IO.Handle; parm: STRING _ Heap.systemMDSZone.NEW[StringBody[60]]; ExpandString: PROC [ps: POINTER TO STRING] = { ns: STRING _ Heap.systemMDSZone.NEW[StringBody[(ps^.maxlength*3)/2]]; String.AppendString[ns, ps^]; Heap.systemMDSZone.FREE[ps]; ps^ _ ns; }; {ENABLE String.StringBoundsFault => {ExpandString[@parm]; RESUME[parm]}; prefix: STRING = " /a"L; IF longDialogue AND Confirm["Do you want to force retrieval, even if create dates appear OK?"L] THEN { String.AppendString[parm, "/f"L]; switches['f] _ TRUE; }; IF ~((longDialogue OR useWorkingDir) AND Confirm["Do you want to confirm each file retrieval individually?"L]) THEN { String.AppendString[parm, prefix]; switches['a] _ TRUE; }; String.AppendChar[parm, Ascii.SP]; String.AppendString[parm, dfFileName]; listOfFiles _ LIST[ConvertUnsafe.ToRope[dfFileName]]; IF basicCedar THEN { String.AppendString[parm, " ["L]; String.AppendString[parm, server]; String.AppendChar[parm, ']]; String.AppendString[parm, basicCedarPath]; listOfFiles _ CONS[RopeInline.InlineFlatten[IO.PutFR["[%s]%s", IO.string[server], IO.string[basicCedarPath]]], listOfFiles]; }; IF publicMachine THEN { String.AppendString[parm, " ["L]; String.AppendString[parm, server]; String.AppendChar[parm, ']]; String.AppendString[parm, fatCedarPath]; listOfFiles _ CONS[RopeInline.InlineFlatten[IO.PutFR["[%s]%s", IO.string[server], IO.string[fatCedarPath]]], listOfFiles]; }; DO ENABLE TTY.Rubout => {initTTY.PutLine[" XXX"L]; CONTINUE}; IF ~publicMachine AND Confirm["Do you want to bring over a personal DF file?"L] THEN { userName: STRING _ [BodyDefs.maxRNameLength]; userDF: STRING _ Heap.systemMDSZone.NEW[StringBody[40]]; PersonalDFExists: PROC RETURNS [found: BOOLEAN _ FALSE] = { IF userDF[0] = '[ THEN { FOR i: CARDINAL IN [1..userDF.length) DO IF userDF[i] = '] THEN { ss: String.SubStringDescriptor _ [userDF, 1, i-1]; server: STRING _ Heap.systemMDSZone.NEW[StringBody[ss.length]]; path: STRING; CheckExtant: PROC [stp: STP.Handle] = { Exists: STP.NoteFileProcType = {found _ TRUE; RETURN[continue: no]}; STP.Enumerate[stp, path, Exists]}; String.AppendSubString[server, @ss]; ss.offset _ i+1; ss.length _ userDF.length - (ss.length+2); path _ Heap.systemMDSZone.NEW[StringBody[ss.length]]; String.AppendSubString[path, @ss]; DoSTPOperation[server, CheckExtant]; EXIT}; ENDLOOP}}; UserCredentialsUnsafe.GetUserCredentials[userName, NIL]; FOR i: CARDINAL DECREASING IN [0..userName.length) DO IF userName[i] = '. THEN {userName.length _ i; EXIT}; ENDLOOP; {ENABLE String.StringBoundsFault => {ExpandString[@userDF]; RESUME[userDF]}; String.AppendString[userDF, "[Ivy]<"L]; String.AppendString[userDF, userName]; String.AppendChar[userDF, '>]; String.AppendString[userDF, userName]; String.AppendString[userDF, ".df"L]; initTTY.PutString["Personal DF file name: "L]; [] _ GetInitializedString[userDF ! TTY.Rubout => Heap.systemMDSZone.FREE[@userDF]]; initTTY.PutCR[]; }; IF PersonalDFExists[] THEN { String.AppendChar[parm, Ascii.SP]; String.AppendString[parm, userDF]; listOfFiles _ CONS[ConvertUnsafe.ToRope[userDF], listOfFiles]; Heap.systemMDSZone.FREE[@userDF]} ELSE { initTTY.PutString[userDF]; initTTY.PutLine[" can't be found!"L]; LOOP}}; EXIT ENDLOOP; String.AppendChar[parm, Ascii.CR]; }; -- end scope of ENABLE in _ IO.CreateProcsStream[IO.CreateRefStreamProcs[getChar: MyGetChar, endOf: MyEndOf, userAbort: MyUserAbort], NIL]; out _ IO.CreateProcsStream[IO.CreateRefStreamProcs[putChar: MyPutChar], NIL]; BringOverCall.CedarBringOver[listOfFiles: listOfFiles, usingListOfRopes: NIL, switches: switches, useCIFS: FALSE, in: in, out: out, confirmData: NIL, Confirm: ConfirmForBringOver]; Heap.systemMDSZone.FREE[@parm]}; publicMachine: BOOL _ FALSE; DoInstallationInternal: ENTRY PROC RETURNS [timedOut: BOOL _ FALSE] = { ENABLE UNWIND => NULL; ucodeError: LONG STRING _ CedarInitPrivate.ValidateMicrocode[]; filesInstalled: BOOL = CheckInstalledSystemVersion[]; allIsWell: BOOL = ucodeError = NIL AND booting AND filesInstalled AND ~(longDialogue OR useWorkingDir); credentialsState: UserCredentialsUnsafe.State = UserCredentialsUnsafe.GetCredentialsState[]; SpecialTerminal.SetInputTimeout[Process.SecondsToTicks[IF booting THEN 60 ELSE 0]]; BEGIN ENABLE SpecialTerminal.InputTimeout => GO TO inputTimeout; IF ~allIsWell THEN { SpecialTerminal.EnableTypescriptFile[]; [] _ SpecialTerminal.TurnOn[]; PrintBootSwitches[]; SELECT TRUE FROM longDialogue => longDialogue _ Confirm["Long installation dialogue [Confirm]"L]; ~booting => longDialogue _ Confirm["Do you want the long installation dialogue?"L]; ENDCASE; IF ucodeError ~= NIL THEN ReportUCodeError[ucodeError]; IF longDialogue OR ~(filesInstalled OR useWorkingDir OR credentialsState ~= nameHint) THEN publicMachine _ Confirm["Shall I configure this disk for use as a public machine?"L]; }; UserCredentials.Login[ [confirmCredentialsOverwrite: longDialogue, prohibitDiskProtection: publicMachine]]; EXITS inputTimeout => { IF ~allIsWell THEN { SpecialTerminal.DisableTypescriptFile[]; SpecialTerminal.TurnOff[]; }; SpecialTerminal.SetInputTimeout[0]; RETURN[TRUE] }; END; -- ENABLE SpecialTerminal.SetInputTimeout[0]; IF booting THEN TerminalMultiplex.PermitDebuggerSwaps[]; -- swaps are initially disabled IF allIsWell THEN {worked _ TRUE; RETURN}; IF longDialogue THEN salvageLSD _ Confirm["Do you want to salvage the local system directory?"L]; ParseExpectedVersion[]; IF ~(worked _ ~longDialogue AND ~useWorkingDir AND filesInstalled) THEN DO dfFileName: STRING; server, path, basicCedarPath, fatCedarPath: STRING; CleanUp: PROC = { Heap.systemMDSZone.FREE[@server]; Heap.systemMDSZone.FREE[@path]; Heap.systemMDSZone.FREE[@basicCedarPath]; Heap.systemMDSZone.FREE[@fatCedarPath]; }; IF (longDialogue OR useWorkingDir) AND ~Confirm["Do you want the automatic BringOver?"L] THEN {worked _ TRUE; EXIT}; [server, path, basicCedarPath, fatCedarPath] _ GetPaths[]; IF (dfFileName _ RetrieveDF[server, path]) ~= NIL THEN { DoBringOver[dfFileName, server, basicCedarPath, fatCedarPath]; Heap.systemMDSZone.FREE[@dfFileName]; CleanUp[]; IF CheckInstalledSystemVersion[] THEN worked _ TRUE ELSE <> initTTY.PutLine["Installation failed...I give up."L]} ELSE { pathSS: String.SubStringDescriptor _ [base: path, offset: 0, length: path.length - 2]; IF ~useWorkingDir AND Confirm["Did you mean to specify the D switch at boot time?"L] THEN { initTTY.PutLine["(D switch now set.)"L]; useWorkingDir _ TRUE; CleanUp[]; LOOP }; initTTY.PutString["Sorry, I can't continue without a version of "L]; initTTY.PutChar['[]; initTTY.PutString[server]; initTTY.PutChar[']]; initTTY.PutSubString[@pathSS]; initTTY.PutString[" stamped with "L]; initTTY.PutDate[expectedCreation, dateTime]; initTTY.PutCR[]; CleanUp[]}; EXIT ENDLOOP; SpecialTerminal.DisableTypescriptFile[]; IF ~(booting AND ~worked) THEN SpecialTerminal.TurnOff[]; }; -- Main body of DoInstallation -- WHILE DoInstallationInternal[].timedOut DO WakeUp: PROC RETURNS [wake: BOOL] = {RETURN[TRUE]}; IF booting THEN SleepInternal[WakeUp] ELSE Sleep[]; ENDLOOP; }; MyGetChar: SAFE PROC[self: IO.Handle] RETURNS[CHAR] = TRUSTED { RETURN[TTY.GetChar[initTTY]]; }; MyEndOf: SAFE PROC[self: IO.Handle] RETURNS[BOOL] = CHECKED { RETURN[FALSE]; }; MyUserAbort: SAFE PROC[self: IO.Handle] RETURNS[BOOL] = TRUSTED { RETURN[TTY.UserAbort[]]; }; MyPutChar: SAFE PROC[self: IO.Handle, char: CHAR] = TRUSTED { TTY.PutChar[initTTY, char]; }; -- Terminal Handler -- doGreeting: BOOL _ TRUE; InitializeSpecialVirtualTerminal: PROC = { [] _ SpecialTerminal.TurnOn[]; TerminalMultiplex.RegisterInputController[SpecialTerminalController]; SpecialTerminal.TurnOff[]; }; SpecialTerminalController: TerminalMultiplex.InputController = { SELECT action FROM enable => IF ~SpecialTerminal.TerminalOn[] THEN { nameStripe: LONG STRING _ GetCedarVersion[].v; SpecialTerminal.TurnOnInternal[nameStripe]; Heap.systemZone.FREE[@nameStripe]; initTTY _ SpecialTerminal.tty; IF doGreeting THEN PrintGreeting[]; }; disable => IF SpecialTerminal.TerminalOn[] THEN SpecialTerminal.TurnOffInternal[]; ENDCASE}; EnableGreeting: PROC = {doGreeting _ TRUE}; DisableGreeting: PROC = {doGreeting _ FALSE}; PrintGreeting: PROC = { DMachines: TYPE = CedarVersion.MachineType[dolphin..dicentra]; machineNames: ARRAY DMachines OF STRING = [ "Dolphin"L, "Dorado"L, "Dandelion"L, "Dicentra"L]; PutNo: PROC [b: BOOLEAN] = INLINE {IF ~b THEN initTTY.PutString[" no"L]}; cedarVersion: LONG STRING _ GetCedarVersion[].v; initTTY.PutChar[Ascii.FF]; initTTY.PutLongString[cedarVersion]; Heap.systemZone.FREE[@cedarVersion]; initTTY.PutCR[]; initTTY.PutDate[System.GetGreenwichMeanTime[], full]; initTTY.PutCR[]; initTTY.PutString[machineNames[CedarVersion.machineType]]; initTTY.PutString[" microcode version "]; initTTY.PutDecimal[CedarVersion.uCodeVersion]; initTTY.PutString[" of "L]; initTTY.PutDate[LOOPHOLE[CedarVersion.uCodeDate], dateOnly]; initTTY.PutChar[',]; PutNo[CedarVersion.uCodeFloatingPoint]; initTTY.PutString[" floating point,"L]; PutNo[CedarVersion.uCodeCedar]; initTTY.PutString[" Cedar support"L]; initTTY.PutCR[]; initTTY.PutCR[]; }; -- Microcode checkout -- ReportUCodeError: INTERNAL PROC [error: LONG STRING] = { <> cedarVersion: TTY.LongSubStringDescriptor _ [NIL, 0, 0]; [cedarVersion.base, cedarVersion.length] _ GetCedarVersion[]; initTTY.PutLongSubString[@cedarVersion]; Heap.systemZone.FREE[@cedarVersion.base]; initTTY.PutString[" won't run on this machine: "L]; initTTY.PutLongString[error]; Heap.systemZone.FREE[@error]; initTTY.PutCR[]; IF ~longDialogue OR ~Confirm["Want to continue anyway?"L] THEN CedarInitPrivate.FatalError[unsuitableMachine]; }; -- ***************** -- -- *** Main Body *** -- -- ***************** -- Run: PUBLIC PROC = {NULL}; -- the start trap does it all. {ENABLE ANY => CedarInitPrivate.FatalError[implementationBug]; InitializeSpecialVirtualTerminal[]; IF ~DoInstallation[booting: TRUE] THEN CedarInitPrivate.FatalError[installationFailed]; }; <> IF basicCedar THEN CedarInitPrivate.DoLoading[] ELSE { START CedarInitSequence.StartCedarCore; START CedarInitSequence.StartCedarUserInterface; START CedarInitSequence.StartCedarTools; }; END. <> <> <<>> <> <> <<>> <> < -> <(Pre)ISL>>> <<>> <> < -> <(Pre)ISLCedar>>> <<>>