// BCPLDOS.bcpl - BCPL DOS-specific functions // Copyright Xerox Corporation 1980 // Swinehart, 6 May 77, file lengths -> statics // InitBCPL calls MainBCPLDOS.;5 4-APR-75 07:56:19 EDIT BY SWINEHART // pull SWAltoc...ime BCPLDOS.;3 28-MAR-75 13:22:29 EDIT BY SWINEHART get "bcplx" get "bcpliox" external[ bufferio displaystream ReadchKLUDGE streamvec syscall WritechKLUDGE InitToRead openfile ] manifest [ zframemax = #335 zframenext = #336 zframefirst = #337 zreturn = #366 ] // system-dependent manifests, used by InitBCPL manifest [ STREAMsize = ((size STREAM + 15)/16) streamvecsize = 7 ] structure [ blank bit 15; ODDBIT bit 1 ] let InitBCPL(paramvec) be [ Version = (2 lshift 8) + 0 SWAlto = false // default -- compile NOVA code TTOstream = OpenOutput(0) TTIstream = OpenInput(0) Ostream = TTOstream; Istream = TTIstream; let v = vec streamvecsize streamvec = v let streamtables = vec (streamvecsize+1)*STREAMsize FreeMax = paramvec!#37-1 // Limits are Max's DictFreeLimit = FreeMax - (paramvec!1+1) TreeFreeLimit = FreeMax - (paramvec!2+1) CodeFreeLimit = FreeMax - (paramvec!3+1) FileNameLength = 20 GetFileMax = 12 for i = 0 to 7 do [ streamvec!i = streamtables streamtables = streamtables + STREAMsize + 1 ] // CALL THE COMPILER Main(paramvec) ] and syscall(call, ac) = valof [ let err = syscallproc(call, ac) if err eq -1 resultis 0 if err eq 0 do err = #15 resultis err ] and Position(stream) = valof [ if stream ls 0 then resultis -1 let channel = stream>>STREAM.channel unless 0 le channel & channel le 7 resultis -1 let v = #430 //DOS channel table in page one let t = v!channel //DOS descriptor for the channel let bytenum = t!#25 //word 25 is byte number in current block let bloknum = t!#24 //word 24 is current block number let dospos = ((bloknum * 255) lshift 1) + bytenum if stream>>STREAM.action eq writeact then resultis dospos + stream>>STREAM.count if dospos eq 0 then resultis 0 resultis dospos - (stream>>STREAM.max - stream>>STREAM.count) -1 ] and bufferio(stream, opr, count) = valof [ sysac!0 = (lv stream>>STREAM.bytebuffer) lshift 1 sysac!1 = count sysac!2 = stream>>STREAM.channel resultis syscall(opr, sysac) ] and Help(Message) be [ let v = vec 3 let m = vec 64 Unpackstring(Message, m) for i = 1 to m!0 do [ v!0 = m!i; syscall(syspchar, v) ] Unpackstring(" -- HELP*n", m) for i = 1 to m!0 do [ v!0 = m!i; syscall(syspchar, v) ] sysdebugproc() return ] and Readch(stream, lvc) be [Rch let numbytes = 1 ReadchKLUDGE: // THIS IS THE ENTRY POINT FROM READWORD !!UGH!!!! let v = vec 2 test stream eq -1 ifso // tty simultation for i = 1 to numbytes do[ syscall(sysgchar, sysac) v!i = sysac!0 & #377 ] ifnot [fileio // talking to a real file! for i = 1 to numbytes do [mainloop let count = stream>>STREAM.count if count gr stream>>STREAM.max then [ let err = bufferio(stream, sysrds, maxstreambytes) let num = sysac!1 stream>>STREAM.max = num -1 //displaystream(stream); WriteS("err=");WriteO(err);WW($*N) if err then unless err eq 6 do syscallerror(sysrds, sysac, stream) if num eq 0 then [ v!1, v!2 = #777, #777 break ] count = 0 ] v!i = stream>>STREAM.bytebuffer^count stream>>STREAM.count = count + 1 loop ]mainloop ]fileio // talking to a real file! //for i = 1 to numbytes do [ WW(v!i); WriteO(v!i); WW($*N) ] if numbytes eq 1 then [ @lvc = v!1; return ] v!2 <>STREAM.action ne writeact then [ WriteO(stream); Help("writing a read stream")] let v = vec 2 test numbytes eq 1 ifso v!1 = ch ifnot [ v!1 = ch << LEFTHALF; v!2 = ch<>STREAM.count if count gr maxbyteindex then [ if bufferio(stream, syswrs, maxstreambytes) then syscallerror(syswrs, sysac, stream) count = 0 ] stream>>STREAM.bytebuffer^count = v!i stream>>STREAM.count = count + 1 loop ]mainloop ]fileio ]Wch // note this code assumes the buffer begins and ends on // even word boundries. and Readword(stream, lvw) be [ if stream>>STREAM.action ne readact then [ WriteO(stream); Help("reading a write-stream")] let numbytes = 2 let c = stream>>STREAM.count if c<>STREAM.max) then goto ReadchKLUDGE @lvw = stream>>STREAM.wordbuffer^(c rshift 1) stream>>STREAM.count = c + 2 return let v = vec 25 // ALLOCATE ENOUGH STACK SPACE UGH,UGH!!! ] and Readaddr(stream, lva) be [ Readaddr = Readword Readword(stream, lva) ] and Writeword(stream, w) be [ if stream>>STREAM.action ne writeact then [ WriteO(stream); Help("writing a read stream")] let numbytes = 2 let c = stream>>STREAM.count if c<>STREAM.max) then goto WritechKLUDGE // goto is fast! UGH!!!!! stream>>STREAM.wordbuffer^(c rshift 1) = w stream>>STREAM.count = c + 2 return let v = vec 25 // ALLOCATE ENOUGH STACK SPACE UGH,UGH!!! ] and Writeaddr(stream, a) be [ Writeaddr = Writeword Writeword(stream, a) ] and WW(ch) be [ static [ newlinecount = 0 ] let newline = ch eq $*n test newline ifnot newlinecount = 0 ifso [ if newlinecount ge 2 return newlinecount = newlinecount + 1 ] if SWOneCase do if $a le ch & ch le $z do ch = ch + ($A-$a) test Ostream eq -1 then [ sysac!0 = ch; syscall(syspchar, sysac) if newline do [ sysac!0 = #12; syscall(syspchar, sysac) if SWWait do Wait() ] ] or [ Writech(Ostream, ch) if newline do [ static [ lastformfeed = 0 ] if Position(Ostream) gr lastformfeed+#20000 do [ lastformfeed = Position(Ostream); WW(#14) ] ] ] ] and Wait() be [ static [ waitcount = 20; waitdefault = 20 ] waitcount = waitcount - 1 if waitcount ne 0 return l:let v = vec 3 v!0 = #7; syscall(syspchar, v) v!0 = $:; syscall(syspchar, v) let n = -1 syscall(sysgchar, v) let ch = v!0 & #177 m:switchon ch into [ case #15: unless n eq -1 do waitdefault = n waitcount = waitdefault v!0 = #15; syscall(syspchar, v) return case #12: unless n ne -1 do n = 1 waitcount = n v!0 = #15; syscall(syspchar, v) return case #33: Help("PAUSE") goto l case $0 to $9: syscall(syspchar, v) n = ch - $0 [ syscall(sysgchar, v); ch = v!0 & #177 unless $0 le ch & ch le $9 break syscall(syspchar, v) n = n*10 + (ch - $0) ] repeat goto m default: v!0 = $?; syscall(syspchar, v) goto l ] ] and ReadSequential(stream,wd,ct) be [ sysac!0 = wd lshift 1 sysac!1 = ct lshift 1 sysac!2 = stream>>STREAM.channel let err = syscall(sysrds,sysac) unless err return syscallerror(sysrds,sysac) ] and WriteSequential(stream,wd,ct) be [ sysac!0 = wd lshift 1 sysac!1 = ct lshift 1 sysac!2 = stream>>STREAM.channel let err = syscall(syswrs,sysac) unless err return syscallerror(syswrs,sysac) ] and ReadWord(stream) = valof [ let w = nil ReadSequential(stream,(lv w),1) resultis w ] and WriteWord(stream,w) be WriteSequential(stream,(lv w), 1) and dospointer(bcplname, dosname) = valof [ Movestring(bcplname, dosname) let n = dosname!0 rshift 8 if (n & 1) eq 1 do dosname!(n/2+1) = 0 resultis (dosname lshift 1)+1 ] and OpenInput(name) = valof [ if name eq 0 resultis -1 if name!0 eq 0 resultis -1 resultis newstream(name, readact) ] and OpenOutput(name) = valof [ if name eq 0 resultis -1 if name!0 eq 0 resultis -1 let dosname = FileNameLength; Dvec(OpenOutput, lv dosname) sysac!0 = dospointer(name, dosname) let deleteerr = syscall(sysdelete, sysac) if deleteerr unless deleteerr eq #12 do [ Ostream = TTOstream WriteS("ERROR : CAN'T DELETE FILE *""); WriteS(name) WriteS("*"*n") finish ] let createerr = syscall(syscreate, sysac) if createerr do [ Ostream = TTOstream WriteS("ERROR : CAN'T CREATE FILE *""); WriteS(name) WriteS("*"*n") finish ] resultis newstream(name, writeact) ] and OpenTemp(ch, inputflag; numargs nargs) = valof [ if nargs eq 1 then inputflag = false let name = FileNameLength/2; Dvec(OpenTemp,lv name) Unpackstring("$$$.B0", filename) filename!(filename!0) = ch FixFileName(name, "", "") let channel = inputflag? OpenInput(name), OpenOutput(name) resultis channel ] and Reposition(stream, pos) be [ let channel = nil if stream ls 0 return flushbuffer(stream) if Position(stream) eq pos then return channel = stream>>STREAM.channel unless 0 le channel & channel le 7 then return let bloknum = (pos rshift 1) / 255 let bytenum = pos - ((bloknum * 255) lshift 1) let v = #430 let t = v!channel t!#25 = bytenum t!#24 = bloknum t!#17 = t!#17 % #4 //set "first write" bit in status word test stream>>STREAM.action eq writeact then stream>>STREAM.max = maxbyteindex or readbuffer(stream) ] and ResetStream(channel) be Reposition(channel, 0) and IsFile(name) = valof [ let dosname = FileNameLength; Dvec(IsFile,lv dosname) sysac!0 = dospointer(name, dosname) sysac!1 = sysac!0 let err = syscall(sysrename, sysac) resultis err ne #12 ] and InitToRead(stream) be [ if stream>>STREAM.action eq readact then return flushbuffer(stream) readbuffer(stream) ] and openfile(bcplname) = valof [ let dosname = FileNameLength; Dvec(openfile,lv dosname) if bcplname eq 0 resultis -1 if bcplname!0 eq 0 resultis -1 let channel = 7 let v = #430 //DOS channel table in page one for i = 0 to 7 do if (v!i & #100000) ne 0 do [ channel = i; break ] sysac!0 = dospointer(bcplname, dosname) sysac!1 = 0 sysac!2 = channel let err = syscall(sysopen, sysac) if err then channel = sysac!2 + #1000 let s = 0 for i = 0 to 7 do // there are seven channels possobile [ if streamvec!i ls 0 loop s = streamvec!i streamvec!i = s + #100000 break ] if s eq 0 then [ WriteS("can't open ") WriteS(bcplname) Error("--out of streams") ] s>>STREAM.channel = channel s>>STREAM.max = maxbyteindex resultis s ] and closechannel(stream) be [ if stream eq -1 return flushbuffer(stream) sysac!2 = stream>>STREAM.channel let err = syscall(sysclose, sysac) if err do syscallerror(sysclose, sysac, stream) returnstream(stream) ] and newstream(name, action) = valof [ let s = openfile(name) if s>>STREAM.channel gr #1000 do [ Ostream = TTOstream let m = s>>STREAM.channel eq #1012 ? "ERROR : NO FILE NAMED *"" , s>>STREAM.channel eq #1021 ? "ERROR : NO FREE CHANNEL FOR *"" , "ERROR : CAN'T OPEN FILE *"" WriteS(m); WriteS(name); WriteS("*"*n") finish ] s>>STREAM.action = action s>>STREAM.count = 0 test action eq readact ifso readbuffer(s) ifnot s>>STREAM.max = maxbyteindex resultis s ] and returnstream(stream) be [ for i = 0 to 7 do [ if (streamvec!i & #77777) eq stream then [ streamvec!i = stream return ] ] Error("can't return stream") ] and flushbuffer(stream) be [ if stream>>STREAM.action eq writeact then [ if (stream>>STREAM.count ne 0) then bufferio(stream, syswrs, stream>>STREAM.count ) ] stream>>STREAM.count = 0 stream>>STREAM.max = maxbyteindex ] and readbuffer(stream) be [ bufferio(stream, sysrds, maxstreambytes) stream>>STREAM.max = sysac!1 -1 stream>>STREAM.count = 0 stream>>STREAM.action = readact ] and displaystream(s) be [ WriteS("*NDisplay a stream...*N") for i = 0 to (offset STREAM.bytebuffer+15)/16 do WriteO(s!i) WriteS("*N") ] and Overlay(name, loc) be [ let s = openfile(name) //circumvent "OpenInput" because we don't // want io buffered for us let ch = s>>STREAM.channel let h = vec 15 sysac!0 = h lshift 1 sysac!1 = 32 sysac!2 = ch syscall(sysrds, sysac) sysac!0 = loc lshift 1 sysac!1 = h!1 lshift 1 sysac!2 = ch syscall(sysrds, sysac) let n = nil sysac!0 = lv n lshift 1 sysac!1 = 2 sysac!2 = ch syscall(sysrds, sysac) let p =vec 1 for i = 1 to n do [ sysac!0 = p lshift 1 sysac!1 = 4 sysac!2 = ch syscall(sysrds, sysac) @(p!0) = p!1 + loc ] closechannel(s) ] and ReadCOMCM() be [ //read the next name and switch list from COM.CM static [ cstream = #100000 ] if cstream eq #100000 do cstream = OpenInput("COM.CM") let i = 1 [ Readch(cstream, lv filename!i) if filename!i eq 0 break if i gr FileNameLength do Error("BAD FILE NAME") if filename!i eq #377 do [ CloseInput(cstream) filename!0 = -1 cstream = #100000 ///*DCS* so can re-read in LEX return ] i = i + 1 ] repeat filename!0 = i-1 let s = nil let i, j = 0, 0 for k = 1 to 4 do [ Readch(cstream, lv s) for l = 1 to 8 do [ if (s & #200) ne 0 do [ j = j + 1 sw!j = i + $A ] i = i + 1 s = s lshift 1 ] ] sw!0 = j ] and InitFree(max) be [ FreelistP = max rv zframemax = max ] and Newvec(n) = valof [ let v = FreelistP - n if v ls lv v do [ rv zframemax = rv zframemax + 1000 Error("OUT OF FREE STORAGE -- PROGRAM IS TOO BIG") ] FreelistP = v - 1 rv zframemax = v resultis v ] and Dvec(rout,lvN) be [ let rslt = (lv rout)-4 let FSO() be [ let v = vec 31000; v = v ] let newMax = rslt + @lvN + 1 if newMax > @zframemax then FSO() @zframenext = newMax @lvN = rslt //***!!! This will stop working if RETURN code is changed rslt = (@zreturn)+1 // bypass resetting zframenext rslt() // returns ]