//Compat.Bcpl -- Compatibility with old OS //Copyright Xerox Corporation 1979 get "AltoFileSys.d" get "streams.d" // outgoing procedure external [ InitializeCompatibility GetSysDir ] // statics declared elsewhere external [ dsp //Display stream for OS keys //Keyboard stream sysFont // Default system display font badStream sysZone sysDisk ] // Incoming procedures external [ // from Os -- dirs OpenFile; SetWorkingDir; CreateDiskStream DeleteFile // -- streams Puts; Gets; Resets Closes EofError ReadBlock WriteBlock PositionPtr FilePos FindFdEntry SetFilePos CleanupDiskStream ReadLeaderPage GetCompleteFa RealDiskDA VirtualDiskDA DeleteDiskPages PositionPage TruncateDiskStream // Display CreateDisplayStream ShowDisplayStream // -- misc Noop Usc SysErr DoubleAdd MoveBlock RetryCall SetBlock DefaultArgs ] // outgoing procs external [ OverWrite MissingSysProc Creates LookupEntry ReadFileStuff ReadVec WriteVec OldPositionPtr MoveStream FlushPage DeleteFileS OpenAFile GetAFile CreateAFile DeleteAFile CloseAFile Display GetChar BStore BMove AddObj DelObj Mem IncMem GetFixed; FreeFixed; FixedLeft RealDA; VirtualDA ] // error codes manifest [ ecBadOst=2001 ecCantOpenStream=2002 ecMissingProc=2005 ecNoSysDirStream=2006 ecNotSysDir=2007 ] static gotSysDir // string streams structure SS[ @ST addr word charPtr word // offset by SS.big big word // 0 for Bcpl string, 1 for big string ] manifest lSS=size SS/16 // old stream types manifest [ ostMin=0 ostDiskRo=0 ostDiskWo=1 ostDiskRw=2 ostDiskRoCh=3 ostDiskWoCh=4 ostDiskRwCh=5 ostString=6 ostBigString=7 ostKeys=9 ostDisplay=10 ostMax=10 ] // Routines for compatibility with the old Os let Creates(param, ost, errRtn; numargs na)=valof [ if na ls 3 then errRtn=SysErr let s=selecton ost into [ case ostString: CreateStringStream(param, 0) case ostBigString: CreateStringStream(param, 1) case ostKeys: keys case ostDisplay: valof [ if param eq 0 then resultis dsp let ww=param!3; if ww eq 0 then ww=38 let f=param!2; if f eq 0 then f=sysFont let ht=((f!-2)+1)&(-2) let len=param!1-param!0 let nl=len/(ww*ht+4) let s=CreateDisplayStream(nl, param!0, len, f, ww) ShowDisplayStream(s) resultis s ] case ostDiskRo to ostDiskRwCh: CreateDiskStream(param, KsTypeOfOst(ost), ItemSizeOfOst(ost), Noop, errRtn, sysZone, 0) default: SysErr(ost, ecBadOst) ] if s eq 0 then SysErr(param, ecCantOpenStream) s>>ST.error=errRtn resultis s ] and KsTypeOfOst(ost)=(table [ ksTypeReadOnly ksTypeWriteOnly ksTypeReadWrite ksTypeReadOnly ksTypeWriteOnly ksTypeReadWrite ])!ost and ItemSizeOfOst(ost)=(table [ 2; 2; 2; 1; 1; 1 ])!ost and LookupEntry(dir, name) = valof [ if dir ne badStream then SysErr(dir, ecNotSysDir) Resets(badStream) //get gotSysDir set up let p=FindFdEntry(gotSysDir, name) if p eq -1 then resultis false SetFilePos(gotSysDir, 0, 2*p) resultis true ] and ReadVec(s, addr, countMinus1)= valof [ if s eq badStream then s=gotSysDir resultis ReadBlock(s, addr, countMinus1+1)-1 ] and WriteVec(s, addr, countMinus1)=WriteBlock(s, addr, countMinus1+1) and OldPositionPtr(s, newPosPlus2)=PositionPtr(s, newPosPlus2-2) and MoveStream(s, deltaWords) be [ if s eq badStream then s=gotSysDir let v=vec 2; FilePos(s, v) let w=vec 2; w!0=(deltaWords ge 0 ? 0, -1); w!1=deltaWords DoubleAdd(v, w); DoubleAdd(v, w) SetFilePos(s, v) ] and FlushPage(s)=CleanupDiskStream(s) and DeleteFileS(s, pageNo, byteNo; numargs na) be [ let buf=vec 256 if byteNo eq 512 then [ pageNo=pageNo+1; byteNo=0 ] test na eq 1 % pageNo eq 0 ifso [ let cfa=vec lCFA; GetCompleteFa(s, cfa) DeleteDiskPages(sysDisk, buf, cfa>>CFA.fp.leaderVirtualDa, lv cfa>>CFA.fp, 0) ] ifnot [ PositionPage(s, pageNo); PositionPtr(s, byteNo) TruncateDiskStream(s) ] ] and GetAFile(name, ost, errRtn; numargs na)=valof [ DefaultArgs(lv na, 1, ostDiskRw, SysErr) resultis OpenAFile(name, ost, errRtn, verLatestCreate) ] and OpenAFile(name, ost, errRtn, version; numargs na)=valof [ DefaultArgs(lv na, 1, ostDiskRw, SysErr, verLatest) resultis OpenFile(name, KsTypeOfOst(ost), ItemSizeOfOst(ost), version, 0, errRtn) ] and CloseAFile(s) be Closes(s) and DeleteAFile(nam) be DeleteFile(nam) and ReadFileStuff(s, v) be ReadLeaderPage(s, v) and GetSysDir(s, datum) be [ unless gotSysDir then [ let s=OpenFile("SysDir.", ksTypeReadOnly) if s eq 0 then SysErr(s, ecNoSysDirStream) gotSysDir=s ] RetryCall(gotSysDir, datum) ] and RealDA(vda) = valof [ let a=nil RealDiskDA(sysDisk, vda, lv a) resultis a ] and VirtualDA(rda) = VirtualDiskDA(sysDisk, lv rda) and Display(c) be Puts(dsp, c) and GetChar() be Gets(keys) and BStore(dest, value, countMinus1) be SetBlock(dest, value, countMinus1+1) and BMove(source, dest, countMinus1) be MoveBlock(dest, source, countMinus1+1) and AddObj(type, ptr)=0 and DelObj(type, ptr)=0 and Mem(v) be [ v!0=0; v!1=0 ] and MissingSysProc() be SysErr(nil, ecMissingProc) // the SS structure declaration is global (streams.d), and should be // retrieved if this code is separated from the rest and CreateStringStream(str, big)=valof [ let StringGets(s)=valof [ let t=s>>SS.charPtr if t ge StrLn(s) then EofError(s) t=t+1 s>>SS.charPtr=t resultis s>>SS.addr>>STRING.char^t ] and StringPuts(s, c) be [ let t=s>>SS.charPtr if not s>>SS.big & t gr maxStringIndex then EofError(s) t=t+1; s>>SS.charPtr=t s>>SS.addr>>STRING.char^t=c let olength=StrLn(s) if t gr olength then [ let a=s>>SS.addr test s>>SS.big then a!0=t-1 or a>>STRING.length=t ] ] and ResetStringStream(s) be s>>SS.charPtr=s>>SS.big and EndofStringStream(s)=s>>SS.charPtr ge StrLn(s) and StrLn(s) = ((s>>SS.big ne 0)? s>>SS.addr!0+1, s>>SS.addr>>STRING.length) and StringClose(s) be (sysZone>>ZN.Free)(sysZone, s) let s=(sysZone>>ZN.Allocate)(sysZone, lSS) for i=0 to lSS-1 do s!i=SysErr s>>SS.gets=StringGets; s>>SS.puts=StringPuts s>>SS.reset=ResetStringStream; s>>SS.endof=EndofStringStream s>>SS.close=StringClose s>>SS.addr=str; s>>SS.big=big; s>>SS.charPtr=big resultis s ] //Following is called at finish time to reset things and InitializeCompatibility() be [ gotSysDir=0 [ // Addresses in ENTVEC manifest [ evKBOPEN=#1000 evKBINT=#1001 //#1002 -- some kind of signal to COMMAND evDINIT=#1005 evDPUT=#1006 evCHKRB=#1007 evGCRB=#1010 evFONT=#1011 evOUTLD=#1013 evINLD=#1014 evLINKF=#1015 evINITALTOIOUSES=#1016 evPARTY=#1020 evMYADD=#1021 ] external [ // sysFont CursorLink sysStatics CallSwat ] //For new OS, patch most of these to CallSwat SetBlock(#1000,CallSwat,#1021-#1000+1) rv evFONT=sysFont rv evLINKF=lv CursorLink rv evINITALTOIOUSES=sysStatics ] ]