Home » Archimedes archive » Zipped Apps » BCPL » BCPL/armlib/b/iolib
BCPL/armlib/b/iolib
This website contains an archive of files for the Acorn Electron, BBC Micro, Acorn Archimedes, Commodore 16 and Commodore 64 computers, which Dominic Ford has rescued from his private collection of floppy disks and cassettes.
Some of these files were originally commercial releases in the 1980s and 1990s, but they are now widely available online. I assume that copyright over them is no longer being asserted. If you own the copyright and would like files to be removed, please contact me.
| Tape/disk: | Home » Archimedes archive » Zipped Apps » BCPL |
| Filename: | BCPL/armlib/b/iolib |
| Read OK: | ✔ |
| File size: | 4E76 bytes |
| Load address: | 0000 |
| Exec address: | 0000 |
File contents
// BCPLIB
// BCPL part of the BCPL library for ARM
// Adapted from the run-time library for the NS16032
SECTION "BCPLIOLib"
GET "LibHdr"
STATIC {
dummy = #x4e524556;
version = 1*256+11;
storechain = 0;
lastRandom = #x54321987;
originalVDUState = 0 }
GET "b.iohdr"
GLOBAL {
ReadOffset: 59;
SetOffset: 60;
LibraryInitIO: 111;
LibraryTerminateIO: 143 };
LET FindStream(direction, name) = VALOF {
result2 := 0
TEST CompString(name, "VDU:")=0 THEN
RESULTIS vduStream
ELSE TEST CompString(name, "RS423:")=0 |
CompString(name, "RS232:")=0 THEN
RESULTIS MakeSerialStream(direction, name)
ELSE TEST CompString(name, "PRINTER:")=0 THEN
RESULTIS MakePrinterStream(direction, name)
ELSE TEST name%0=0 |
CompString(name, "NULL:")=0 THEN
RESULTIS MakeNewStream(name,
s.is.null.bits,
direction,
NullReader, // RdCh()
Nothing) // WrCh()
ELSE TEST name%(name%0)=':' THEN
RESULTIS 0
ELSE
RESULTIS MakefileStream(direction, name) }
AND MakeSerialStream(direction, name) = VALOF {
LET stream = ?
LET SerialSelect(serial, direction) BE
IF direction=s.is.input.bit THEN
OSByte(2, 1) // Central input stream is the serial line
AND SerialWrite(ch, channel, binary) BE {
WHILE OSByte(#x80, 253, 255)<2 DO LOOP;
IF OSByte(#x8A, 2, ch) // Put ch in RS423 buffer
IF ch='*N' & ~binary THEN OSByte(#x8A, 2, '*C') }
stream := MakeNewStream(name,
s.is.serial.bits,
direction,
OSRdCh, // RdCh()
SerialWrite) // WrCh()
stream!s.selecter := SerialSelect
RESULTIS stream }
AND MakePrinterStream(direction, name) = VALOF {
LET stream = ?
LET PrinterOn(ch, printer) BE {
OSByte(3, #b00010000, 0) // Turn on vdu to handle the VDU 2
OSWrCh(2) // Claim the printer
PrinterSelect(printer, s.is.output.bit)
PrinterWrCh(ch)
cos!s.writer := PrinterWrCh }
AND PrinterWrCh(ch, channel, binary) BE {
IF ch='*n' & ~binary THEN OSWrCh('*c');
OSWrCh(ch) }
AND PrinterEnd(printer) BE {
OSByte(3, #b00010000, 0) // Turn on vdu to handle the VDU 3
OSWrCh(3) // Stop sending to the printer
OSByte(3, #b00000100, 0) // VDU only from now on
EndStream(printer) }
AND PrinterSelect(printer, direction) BE
IF direction=s.is.output.bit THEN {
// Do the necessary OSByte()s to turn off things on central
// output stream except for the currently selected printer !
OSByte(3, #b00011010, 0) }
IF direction~=s.op.output THEN RESULTIS 0
stream := MakeNewStream(name,
s.is.printer.bits,
direction,
ErrorRd, // RdCh()
PrinterOn) // WrCh()
stream!s.selecter := PrinterSelect
stream!s.endwriter := PrinterEnd
RESULTIS stream }
AND MakeFileStream(direction, name) = VALOF {
LET stream = ?
LET channel = ?
LET FileEndReadWrite(stream) BE {
/* called when EndRead or EndWrite done of a disk file */
IF (stream!s.flags & s.has.channel.bit)~=0 THEN {
OSFind(s.op.close, stream!s.channel);
IF result2 < 0 THEN
NastyErrorHandler(stream, e.nasty.error)
}
stream!s.flags := stream!s.flags & ~s.has.channel.bit
EndStream(stream) }
channel := OSFind(direction, name)
IF channel=0 THEN {
result2 := channel // Save error number
RESULTIS 0 };
stream := MakeNewStream(name,
s.is.file.bits,
direction,
OSBGet, // RdCh()
OSBPut) // WrCh()
stream!s.channel := channel
stream!s.flags := stream!s.flags | s.has.channel.bit
stream!s.endreader := FileEndReadWrite
stream!s.endwriter := FileEndReadWrite
RESULTIS stream }
AND MakeNewStream(name, type, direction, rd, wr) = VALOF {
MANIFEST { s.name.max.size.m.1 = s.name.max.size-1 };
LET stream = GetVec(s.stream.size)
AND hcdr(channel) BE {
/* called when UnRdCh() done on the current stream */
LET NextRdCh(channel) = VALOF {
/* called on next RdCh() after a UnRdCh() */
cis!s.reader := cis!s.real.reader
RESULTIS cis!s.last.char }
cis!s.reader := NextRdCh }
IF stream=0 THEN
Fault("No room for streams", e.no.work.space)
stream!s.magic := s.is.a.stream
stream!s.stream.chain := streamchain
streamchain := stream
stream!s.flags := type | (direction~=s.op.output -> s.is.input.bit,
direction~=s.op.input -> s.is.output.bit, 0)
FOR i = 0 TO s.name.max.size.m.1 DO
(@(stream!s.name))%i := i>name%0 -> ' ', name%i
IF name%0>=s.name.max.size THEN
(@(stream!s.name))%0 := s.name.max.size-1
stream!s.channel := -1
stream!s.error.handler := NastyErrorHandler
stream!s.selecter := Nothing
stream!s.reader := direction~=s.op.output -> rd, ErrorRd
stream!s.writer := direction~=s.op.input -> wr, ErrorWr
stream!s.unreader := direction~=s.op.output -> hcdr, ErrorRd
stream!s.last.char := EndStreamCh
stream!s.real.reader := stream!s.reader
stream!s.error.count := 0
stream!s.last.error := 0
stream!s.endreader := EndStream
stream!s.endwriter := EndStream
stream!s.buffer.size := 0
stream!s.buffer.address := 0
stream!s.buffer.count := 0
stream!s.buffer.pointer := 0
RESULTIS stream }
AND ErrorRd() BE
/* called when trying do read from a write only stream */
Fault("Read not permitted on stream *"%S*"",
e.must.not.read, @(cis!s.name))
AND ErrorWr() BE
/* called when trying to write to a read only stream */
Fault("Write not permitted on stream *"%S*"",
e.must.not.write, @(cos!s.name))
AND EndStream(stream) BE {
/* called when EndRead() or EndWrite() done on this stream */
LET ss = -s.stream.chain+@streamChain;
LET s = streamChain;
WHILE s~=0 DO {
IF s=stream THEN {
s.stream.chain!ss := s.stream.chain!stream; BREAK };
ss := s; s := s.stream.chain!s };
TEST stream=cis
THEN cis := errorstream
ELSE cos := errorstream;
FreeVec(stream) }
AND NastyErrorHandler(stream, error) BE {
/* default routine to handle HOST errors, just blows him away... */
LET message = VEC 256/BytesPerWord
stream!s.error.count := stream!s.error.count+1
stream!s.last.error := error
tkrerr(message, 256)
Fault("Fatal I/O error %x8 %s on %s stream *"%s*"",
e.nasty.error,
error,
message,
(stream!s.flags & s.is.input.bit)~=0 -> "input", "output",
@(stream!s.name))
TEST (stream!s.flags & s.is.input.bit)~=0
THEN stream!s.reader := NullReader
ELSE stream!s.writer := Nothing }
AND NullReader() = EndStreamCh
AND MakePermanentStreams() BE {
/* to make the VDU: and error streams */
LET NotMuch(stream) BE {
/* called when EndRead() or EndWrite() done to the console stream */
stream!s.reader := stream!s.real.reader;
stream!s.error.count := 0;
stream!s.last.error := 0 }
AND VduReader() = VALOF {
LET ch = ?;
LET old.cos = Output();
WHILE linebuff%2=0 DO { // line buffer is empty, so fill it
LET paramblock = VEC 1;
SelectOutput(vdustream);
paramblock!0 := (linebuff << 2)+3;
paramblock%4 := linebuff%0;
paramblock%5 := 32;
paramblock%6 := 126;
linebuff%2 := OSWord(0, paramblock)+1; // Read a line
linebuff%1 := 0;
IF result2 THEN {
linebuff%2 := 0;
cis!s.last.char := '*E';
selectoutput(old.cos);
RESULTIS '*E' } };
ch := linebuff%(linebuff%1+3);
linebuff%1 := linebuff%1+1;
linebuff%2 := linebuff%2-1;
IF ch='*C' THEN ch := '*N';
cis!s.last.char := ch;
SelectOutput(old.cos);
RESULTIS ch }
AND VduWriter(ch, handle, binary) BE {
IF ~binary THEN {
IF ch='*N' THEN OSWrCh('*C');
IF ch<'*S' & (ch~='*P' & ch~='*N' & ch~='*C') THEN {
OSWrCh('^'); ch := ch+#x60 } };
OSWrCh(ch) }
AND VduAgain(stream, direction) BE {
/* called when the vdu stream is (re)selected. Makes vdu work again */
TEST direction=s.is.output.bit THEN
OSByte(3, #b00000100, 0)
ELSE {
LET s = streamchain
WHILE s~=0 DO {
IF (s!s.flags & s.ended.bit)=0 &
(s!s.flags & s.stream.type.bits)=s.is.serial.bits THEN {
OSByte(2, 2) // Enable Keyboard, leave RS423 enabled
RETURN };
s := s!s.stream.chain };
OSByte(2, 0) } // Enable Keyboard, Disable RS423
};
vdustream := MakeNewStream("VDU:",
s.is.vdu.bits,
s.op.update,
VduReader,
VduWriter)
vdustream!s.endreader := NotMuch
vdustream!s.endwriter := NotMuch
vdustream!s.selecter := VduAgain
errorstream := MakeNewStream("No selected stream",
0, // s.is.nothing.at.all.bits !!
s.op.update,
ErrorRd,
ErrorWr)
errorstream!s.endreader := Nothing // Make it permanent
errorstream!s.endwriter := Nothing }
/*************************************************************
* *
* The user interface routines *
* *
*************************************************************/
AND LibraryInitIO() BE {
/* to initialise the I/O system */
IF linebuff~=0 THEN FreeVec(linebuff)
linebuff := GetVec(63) // for use by RdCh
linebuff%0 := 63*4+1 // max. no. of bytes
linebuff%1 := 0 // pointer to next char
linebuff%2 := 0 // number of bytes in buffer
originalVDUState := OSByte(3, 0, 0);
OSByte(3, originalVDUState, 0);
LibraryTerminateIO();
MakePermanentStreams()
cis := vdustream
cos := vdustream }
AND LibraryTerminateIO() BE {
WHILE streamchain~=0 DO {
LET stream = streamchain;
streamchain := streamchain!s.stream.chain;
TEST stream!s.magic=s.is.a.stream THEN
[stream!s.endwriter](stream)
ELSE
streamchain := 0 }; // It was corrupt, GIVE UP!!
OSByte(3, originalVDUState, 0) }
AND SelectInput(new.stream) BE {
/* to change the current input stream */
LET old.stream = cis
IF new.stream=0 THEN
new.stream := errorstream // The manual says delay the error message
IF new.stream!s.magic~=s.is.a.stream DO
Fault("Bad input stream", e.bad.input.stream)
IF (new.stream!s.flags & s.ended.bit)~=0 THEN
Fault("Stream *"%S*" has been ended", e.has.been.ended,
@(new.stream!s.name))
(new.stream!s.selecter)(new.stream, s.is.input.bit)
cis := new.stream }
AND SelectOutput(new.stream) BE {
/* to change the current output stream */
LET old.stream = cos
IF new.stream=0 THEN
new.stream := errorstream // The manual says delay the error message
IF new.stream!s.magic~=s.is.a.stream DO
Fault("Bad output stream", e.bad.output.stream)
IF (new.stream!s.flags & s.ended.bit)~=0 THEN
Fault("Stream *"%S*" has been ended", e.has.been.ended,
@(new.stream!s.name))
(new.stream!s.selecter)(new.stream, s.is.output.bit)
cos := new.stream }
AND FindInput(name) = FindStream(s.op.input, name)
AND FindOutput(name) = FindStream(s.op.output, name)
AND RdCh() = VALOF {
/* to read an ASCII character from the current input stream */
LET ch = (cis!s.reader)(cis!s.channel)
IF 0<=ch<EndStreamCh THEN {
cis!s.last.char := ch // The grotty UnRdCh() needs this
RESULTIS ch }
IF ch=EndStreamCh THEN {
cis!s.last.char := ch
cis!s.reader := NullReader
RESULTIS EndStreamCh };
(cis!s.error.handler)(cis, ch)
cis!s.last.char := ch
RESULTIS ch }
AND RdBin() = RdCh()
AND WrCh(ch) BE {
/* to write an character to the current output stream */
LET error.code = (cos!s.writer)(ch, cos!s.channel, FALSE)
IF error.code<0 THEN (cos!s.error.handler)(cos, error.code) }
AND WrBin(byte) BE {
/* to write an character to the current output stream */
LET error.code = (cos!s.writer)(byte, cos!s.channel, TRUE)
IF error.code<0 THEN (cos!s.error.handler)(cos, error.code) }
AND EndRead() = VALOF { (cis!s.endreader)(cis); RESULTIS TRUE }
AND EndWrite() = VALOF { (cos!s.endwriter)(cos); RESULTIS TRUE }
AND UnRdCh() BE {
/* a very silly way to do putback()
* UnRdCh() makes the next charcter read by RdCh() the same as the last one.
*/
(cis!s.unreader)(cis) }
AND ReadOffset(stream, vector) BE {
CheckFile(stream, "Read.Offset");
OSArgs(0, stream!s.channel, 0);
vector!0 := result2 }
AND SetOffset(stream, vector) BE {
CheckFile(stream, "Set.Offset");
OSArgs(1, stream!s.channel, vector!0) }
AND Extent(stream) = VALOF {
CheckFile(stream, "Extent");
OSArgs(2, stream!s.channel, 0);
RESULTIS result2 }
AND CheckFile(stream, caller) BE {
LET flags = stream!s.flags;
IF (flags&s.has.channel.bit)=0 | (flags&s.is.file.bits)=0
THEN Fault("Stream for %s should be a file", 709, caller) }
AND MaxVec() = VALOF {
LET biggest, p = 0, ?
GetVec(maxint/BytesPerWord) // Compact free memory
p := blockList;
WHILE !p~=0 DO {
LET q=!p;
TEST q>=0
THEN // block is free
IF q>biggest THEN biggest := q
ELSE q := -q;
p := p+q };
RESULTIS biggest-2 }
AND time() = VALOF {
LET v = VEC 4;
OSWord(3, v);
RESULTIS v!0 }
AND Date() = VALOF {
LET ex = VEC 1;
LET v = TABLE 0, 0, 0;
ExplodeCurrentTime(ex);
IF ex%0=0 THEN RESULTIS "<unset>";
v!2 := 0;
Plant(v, 0, 9, ex%2);
v%3 := '-'
{ LET m = (ex%1)-1;
FOR i = 1 TO 3 DO
v%(i+3) := "JanFebMarAprMayJunJulAugSepOctNovDec"%(3*m+i) };
Plant(v, 7, '-', ex%0);
RESULTIS v }
AND TimeOfDay() = VALOF {
LET ex = VEC 1;
LET v = TABLE 0, 0, 0;
ExplodeCurrentTime(ex);
IF ex%0=0 THEN RESULTIS "<unset>";
v!2 := 0;
Plant(v, 0, 8, ex%3);
Plant(v, 3, ':', ex%4);
Plant(v, 6, ':', ex%5);
RESULTIS v }
AND Plant(v, b, c, n) BE {
v%b := c
v%(b+1) := '0' + (n/10)
v%(b+2) := '0' + (n REM 10) }
AND ExplodeCurrentTime(ex) BE {
LET v1 = VEC 4;
BinaryTime(v1);
ExplodeBinaryTime(v1, ex) }
AND BinaryTime(v) BE
TEST (hostProcessor>>24)=6 THEN {
// Is this an Arthur? If so, get the time from its CMOS clock
v%0 := 3;
OSWord(14, v) }
ELSE {
// Read system timer in the BBC. There is of course scope here for
// reading the CMOS clock in a master
OSWord(1, v) }
AND ExplodeBinaryTime(v, res) BE {
LET s2 = v!0;
LET years, months, days, hours, mins, secs, ticks, leap =
?, ?, ?, ?, ?, ?, ?, ?
ticks := (s2>>8) | ((v%4)<<24) // High order 32 bits
days := ticks / 33750
ticks := ((ticks REM 33750)<<8) | (s2&255)
hours := ticks / 360000; ticks := ticks - 360000*hours
mins := ticks / 6000; ticks := ticks - 6000*mins
secs := ticks / 100; // ticks := ticks - 100*secs
// Times are kept starting from January 1st 1900 as day zero. 1904 was
// the first leap year after that.
years := 1 + (4 * (days-365)) / 1461 // (365.25)
days := days - 365*years - (years-1)/4
leap := ((years REM 4)=0) & (years>0) // 1900 was not a leap year
IF (years<83) | (years>99) THEN {
res%0 := 0; RETURN } // unset
months := 0
{ LET monlen = months!table 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31
IF leap & (months=1) THEN monlen := 29
IF monlen>days THEN BREAK
days := days-monlen
months := months+1 } REPEAT
res%2 := days+1; res%1 := months+1; res%0 := years;
res%3 := hours; res%4 := mins; res%5 := secs }
AND Random(n) = VALOF {
IF n=0 THEN n := lastRandom;
lastRandom := 2147001325 * n + 715136305;
RESULTIS lastRandom }
AND Nothing(much.at.all) BE {
much.at.all := much.at.all }
AND Fault(message, code, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) BE {
LET realFault = Fault;
Fault := Nothing;
SelectOutput(vdustream);
OSByte(#xDA, 0, -1); // Abort any VDU parameters still needed
WriteF("*NError %N: ", code);
WriteF(message, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10);
WriteS("*N");
TEST (Abort>>24)~=#xAE THEN Abort(0) ELSE Stop(256);
Fault := realFault }
AND UnpackString(s, v) BE
FOR i = s%0 TO 0 BY -1 DO v!i := s%i
AND PackString(v, s) = VALOF {
LET n = v!0 & 255;
LET size = n/BytesPerWord;
FOR i = 0 TO n DO s%i := v!i;
FOR i = n+1 TO (size+1)*BytesPerWord-1 DO s%i := 0;
RESULTIS size }
AND Input() = cis
AND Output() = cos
AND ReadN() = VALOF {
LET sum, ch, neg = 0, 0, FALSE
l: ch := RdCh();
IF ~('0'<=ch<='9') THEN SWITCHON ch INTO {
DEFAULT: UnRdCh();
result2 := -1;
RESULTIS 0
CASE '*S':
CASE '*T':
CASE '*N': GOTO l
CASE '-': neg := TRUE
CASE '+': ch := RdCh() }
WHILE '0'<=ch<='9' DO {
sum := 10*sum+ch-'0';
ch := RdCh() };
IF neg THEN sum := -sum;
UnRdCh();
result2 := 0;
RESULTIS sum }
AND NewLine() BE WrCh('*N')
AND NewPage() BE WrCh('*P')
AND WriteD(n, d) BE {
LET t = VEC 10
AND i, k = 0, n;
IF n<0 THEN d, k := d-1, -n;
t!i, k, i := k REM 10, k/10, i+1 REPEATUNTIL k=0;
FOR j = i+1 TO d DO WrCh('*S');
IF n<0 THEN WrCh('-');
FOR j = i-1 TO 0 BY -1 DO WrCh(t!j+'0') }
AND WriteN(n) BE WriteD(n, 0)
AND WriteHex(n, d) BE {
IF d>1 DO WriteHex(n>>4, d-1);
WrCh((n&15)!TABLE
'0','1','2','3','4','5','6','7',
'8','9','A','B','C','D','E','F') }
AND WriteOct(n, d) BE {
IF d>1 DO WriteOct(n>>3, d-1);
WrCh((n&7)+'0') }
AND WriteS(s) BE
FOR i = 1 TO s%0 DO WrCh(s%i)
AND WriteT(s, n) BE {
WriteS(s);
FOR i = 1 TO n-s%0 DO WrCh('*S') }
AND WriteU(n, d) BE {
LET m = (n>>1)/5;
IF m~=0 THEN {
WriteD(m, d-1)
d := 1 };
WriteD(n-m*10, d) }
AND WriteF(format, a, b, c, d, e, f, g, h, i, j, k) BE {
LET t = @a
FOR p = 1 TO format%0 DO {
LET k = format%p
TEST k='%' THEN {
LET f, arg, n = 0, t!0, 0
p := p+1
SWITCHON CapitalCh(format%p) INTO {
DEFAULT: WrCh(format%p); ENDCASE
CASE 'S': f := WriteS; GOTO l
CASE 'T': f := WriteT; GOTO m
CASE 'C': f := WrCh; GOTO l
CASE 'O': f := WriteOct; GOTO m
CASE 'X': f := WriteHex; GOTO m
CASE 'I': f := WriteD; GOTO m
CASE 'N': f := WriteN; GOTO l
CASE 'U': f := WriteU; GOTO m
CASE 'F': f := WrFlNum; GOTO l
m: p := p+1
n := format%p
n := '0'<=n<='9' -> n-'0',
n-'A'+10
l: f(arg, n)
CASE '$':
t := t+StackFrameDirection } }
ELSE
WrCh(k) } }
AND WrFlNum(a) BE {
LET v = VEC 2;
LET m = VEC 3;
LET k, e = 0, 0;
LET se, sm = 0, 0;
LET exp, lastDigit = 0, 0;
/* Get a packed decimal version of the floating point value: format
s e3 . e2 e1 . e0 m18.m17 m16.
m15 m14.m13 m12.m11 m10. m9 m8 .
m7 m6 . m5 m4 . m3 m2 . m1 m0 .
With s bit 3 = sign of mantissa, s bit 2 = sign of exponent
*/
ConvertSToP(a, v);
{ LET s = v%3;
se := s@
sm := s€ };
/* A single precision IEEE number has at most 7 digits of precision
(23 bit mantissa), so we can throw away m7..m0 */
FOR i = 1 TO 0 BY -1 DO {
LET w = v!i;
FOR j = 0 TO 7 DO {
m%k := w&15; w := w>>4; k := k+1 } };
/* I just truncate here, where really I should round */
k := 12-8;
WHILE k<(18-8) & m%k=0 DO k := k+1;
e := (22-8);
WHILE e>(19-8) & m%e=0 DO e := e-1;
exp := 0;
FOR i = e TO 19-8 BY -1 DO exp := exp*10+m%i;
IF se THEN exp := -exp;
/* Prettify the output a bit, not printing exxx if it won't cause us
to print any more digits to avoid it (other than a single leading or
trailing zero) */
TEST -1<=exp<=6 THEN
lastDigit := 18-8-exp
ELSE
lastDigit := 18-8;
IF sm~=0 THEN WrCh('-');
IF exp=-1 THEN WrCh('0');
FOR i = 18-8 TO lastDigit BY -1 DO WrCh(m%i+'0');
WrCh('.');
TEST k>=lastDigit THEN
WrCh('0')
ELSE FOR i = lastDigit-1 TO k BY -1 DO WrCh(m%i+'0');
UNLESS -1<=exp<=6 THEN {
WrCh('e');
IF se~=0 THEN WrCh('-');
FOR i = e TO 19-8 BY -1 DO WrCh(m%i+'0') } }
AND CapitalCh(ch) = 'a'<=ch<='z' -> ch+'A'-'a', ch
AND CompCh(ch1, ch2) = CapitalCh(ch1)-CapitalCh(ch2)
AND CompString(s1, s2) = VALOF {
LET lens1, lens2 = s1%0, s2%0
LET smaller = lens1<lens2 -> s1, s2
FOR i = 1 TO smaller%0 DO {
LET res = CompCh(s1%i, s2%i)
IF res~=0 THEN RESULTIS res }
IF lens1=lens2 THEN RESULTIS 0
RESULTIS smaller=s1 -> -1, 1 }
00000000 2f 2f 20 42 43 50 4c 49 42 0a 2f 2f 20 42 43 50 |// BCPLIB.// BCP|
00000010 4c 20 70 61 72 74 20 6f 66 20 74 68 65 20 42 43 |L part of the BC|
00000020 50 4c 20 6c 69 62 72 61 72 79 20 66 6f 72 20 41 |PL library for A|
00000030 52 4d 0a 2f 2f 20 41 64 61 70 74 65 64 20 66 72 |RM.// Adapted fr|
00000040 6f 6d 20 74 68 65 20 72 75 6e 2d 74 69 6d 65 20 |om the run-time |
00000050 6c 69 62 72 61 72 79 20 66 6f 72 20 74 68 65 20 |library for the |
00000060 4e 53 31 36 30 33 32 0a 0a 53 45 43 54 49 4f 4e |NS16032..SECTION|
00000070 20 22 42 43 50 4c 49 4f 4c 69 62 22 0a 0a 47 45 | "BCPLIOLib"..GE|
00000080 54 20 22 4c 69 62 48 64 72 22 0a 0a 53 54 41 54 |T "LibHdr"..STAT|
00000090 49 43 20 7b 0a 20 20 20 64 75 6d 6d 79 20 3d 20 |IC {. dummy = |
000000a0 23 78 34 65 35 32 34 35 35 36 3b 0a 20 20 20 76 |#x4e524556;. v|
000000b0 65 72 73 69 6f 6e 20 3d 20 31 2a 32 35 36 2b 31 |ersion = 1*256+1|
000000c0 31 3b 0a 20 20 20 73 74 6f 72 65 63 68 61 69 6e |1;. storechain|
000000d0 20 3d 20 30 3b 0a 20 20 20 6c 61 73 74 52 61 6e | = 0;. lastRan|
000000e0 64 6f 6d 20 3d 20 23 78 35 34 33 32 31 39 38 37 |dom = #x54321987|
000000f0 3b 0a 20 20 20 6f 72 69 67 69 6e 61 6c 56 44 55 |;. originalVDU|
00000100 53 74 61 74 65 20 3d 20 30 20 7d 0a 0a 47 45 54 |State = 0 }..GET|
00000110 20 22 62 2e 69 6f 68 64 72 22 0a 0a 47 4c 4f 42 | "b.iohdr"..GLOB|
00000120 41 4c 20 7b 0a 20 20 20 52 65 61 64 4f 66 66 73 |AL {. ReadOffs|
00000130 65 74 3a 20 35 39 3b 0a 20 20 20 53 65 74 4f 66 |et: 59;. SetOf|
00000140 66 73 65 74 3a 20 36 30 3b 0a 20 20 20 4c 69 62 |fset: 60;. Lib|
00000150 72 61 72 79 49 6e 69 74 49 4f 3a 20 31 31 31 3b |raryInitIO: 111;|
00000160 0a 20 20 20 4c 69 62 72 61 72 79 54 65 72 6d 69 |. LibraryTermi|
00000170 6e 61 74 65 49 4f 3a 20 31 34 33 20 7d 3b 0a 0a |nateIO: 143 };..|
00000180 4c 45 54 20 46 69 6e 64 53 74 72 65 61 6d 28 64 |LET FindStream(d|
00000190 69 72 65 63 74 69 6f 6e 2c 20 6e 61 6d 65 29 20 |irection, name) |
000001a0 3d 20 56 41 4c 4f 46 20 7b 0a 20 20 20 72 65 73 |= VALOF {. res|
000001b0 75 6c 74 32 20 3a 3d 20 30 0a 20 20 20 54 45 53 |ult2 := 0. TES|
000001c0 54 20 43 6f 6d 70 53 74 72 69 6e 67 28 6e 61 6d |T CompString(nam|
000001d0 65 2c 20 22 56 44 55 3a 22 29 3d 30 20 54 48 45 |e, "VDU:")=0 THE|
000001e0 4e 0a 20 20 20 20 20 20 52 45 53 55 4c 54 49 53 |N. RESULTIS|
000001f0 20 76 64 75 53 74 72 65 61 6d 0a 20 20 20 45 4c | vduStream. EL|
00000200 53 45 20 54 45 53 54 20 43 6f 6d 70 53 74 72 69 |SE TEST CompStri|
00000210 6e 67 28 6e 61 6d 65 2c 20 22 52 53 34 32 33 3a |ng(name, "RS423:|
00000220 22 29 3d 30 20 7c 0a 09 20 20 20 20 20 43 6f 6d |")=0 |.. Com|
00000230 70 53 74 72 69 6e 67 28 6e 61 6d 65 2c 20 22 52 |pString(name, "R|
00000240 53 32 33 32 3a 22 29 3d 30 20 54 48 45 4e 0a 20 |S232:")=0 THEN. |
00000250 20 20 20 20 20 52 45 53 55 4c 54 49 53 20 4d 61 | RESULTIS Ma|
00000260 6b 65 53 65 72 69 61 6c 53 74 72 65 61 6d 28 64 |keSerialStream(d|
00000270 69 72 65 63 74 69 6f 6e 2c 20 6e 61 6d 65 29 0a |irection, name).|
00000280 20 20 20 45 4c 53 45 20 54 45 53 54 20 43 6f 6d | ELSE TEST Com|
00000290 70 53 74 72 69 6e 67 28 6e 61 6d 65 2c 20 22 50 |pString(name, "P|
000002a0 52 49 4e 54 45 52 3a 22 29 3d 30 20 54 48 45 4e |RINTER:")=0 THEN|
000002b0 0a 20 20 20 20 20 20 52 45 53 55 4c 54 49 53 20 |. RESULTIS |
000002c0 4d 61 6b 65 50 72 69 6e 74 65 72 53 74 72 65 61 |MakePrinterStrea|
000002d0 6d 28 64 69 72 65 63 74 69 6f 6e 2c 20 6e 61 6d |m(direction, nam|
000002e0 65 29 0a 20 20 20 45 4c 53 45 20 54 45 53 54 20 |e). ELSE TEST |
000002f0 6e 61 6d 65 25 30 3d 30 20 7c 0a 09 20 20 20 20 |name%0=0 |.. |
00000300 20 43 6f 6d 70 53 74 72 69 6e 67 28 6e 61 6d 65 | CompString(name|
00000310 2c 20 22 4e 55 4c 4c 3a 22 29 3d 30 20 54 48 45 |, "NULL:")=0 THE|
00000320 4e 0a 20 20 20 20 20 20 52 45 53 55 4c 54 49 53 |N. RESULTIS|
00000330 20 4d 61 6b 65 4e 65 77 53 74 72 65 61 6d 28 6e | MakeNewStream(n|
00000340 61 6d 65 2c 0a 09 09 09 20 20 20 20 20 73 2e 69 |ame,.... s.i|
00000350 73 2e 6e 75 6c 6c 2e 62 69 74 73 2c 0a 09 09 09 |s.null.bits,....|
00000360 20 20 20 20 20 64 69 72 65 63 74 69 6f 6e 2c 0a | direction,.|
00000370 09 09 09 20 20 20 20 20 4e 75 6c 6c 52 65 61 64 |... NullRead|
00000380 65 72 2c 20 20 2f 2f 20 52 64 43 68 28 29 0a 09 |er, // RdCh()..|
00000390 09 09 20 20 20 20 20 4e 6f 74 68 69 6e 67 29 09 |.. Nothing).|
000003a0 20 20 20 2f 2f 20 57 72 43 68 28 29 0a 20 20 20 | // WrCh(). |
000003b0 45 4c 53 45 20 54 45 53 54 20 6e 61 6d 65 25 28 |ELSE TEST name%(|
000003c0 6e 61 6d 65 25 30 29 3d 27 3a 27 20 54 48 45 4e |name%0)=':' THEN|
000003d0 0a 20 20 20 20 20 20 52 45 53 55 4c 54 49 53 20 |. RESULTIS |
000003e0 30 0a 20 20 20 45 4c 53 45 0a 20 20 20 20 20 20 |0. ELSE. |
000003f0 52 45 53 55 4c 54 49 53 20 4d 61 6b 65 66 69 6c |RESULTIS Makefil|
00000400 65 53 74 72 65 61 6d 28 64 69 72 65 63 74 69 6f |eStream(directio|
00000410 6e 2c 20 6e 61 6d 65 29 20 7d 0a 0a 41 4e 44 20 |n, name) }..AND |
00000420 4d 61 6b 65 53 65 72 69 61 6c 53 74 72 65 61 6d |MakeSerialStream|
00000430 28 64 69 72 65 63 74 69 6f 6e 2c 20 6e 61 6d 65 |(direction, name|
00000440 29 20 3d 20 56 41 4c 4f 46 20 7b 0a 20 20 20 4c |) = VALOF {. L|
00000450 45 54 20 73 74 72 65 61 6d 20 3d 20 3f 0a 0a 20 |ET stream = ?.. |
00000460 20 20 4c 45 54 20 53 65 72 69 61 6c 53 65 6c 65 | LET SerialSele|
00000470 63 74 28 73 65 72 69 61 6c 2c 20 64 69 72 65 63 |ct(serial, direc|
00000480 74 69 6f 6e 29 20 42 45 0a 20 20 20 20 20 20 49 |tion) BE. I|
00000490 46 20 64 69 72 65 63 74 69 6f 6e 3d 73 2e 69 73 |F direction=s.is|
000004a0 2e 69 6e 70 75 74 2e 62 69 74 20 54 48 45 4e 0a |.input.bit THEN.|
000004b0 09 20 4f 53 42 79 74 65 28 32 2c 20 31 29 20 2f |. OSByte(2, 1) /|
000004c0 2f 20 43 65 6e 74 72 61 6c 20 69 6e 70 75 74 20 |/ Central input |
000004d0 73 74 72 65 61 6d 20 69 73 20 74 68 65 20 73 65 |stream is the se|
000004e0 72 69 61 6c 20 6c 69 6e 65 0a 0a 20 20 20 41 4e |rial line.. AN|
000004f0 44 20 53 65 72 69 61 6c 57 72 69 74 65 28 63 68 |D SerialWrite(ch|
00000500 2c 20 63 68 61 6e 6e 65 6c 2c 20 62 69 6e 61 72 |, channel, binar|
00000510 79 29 20 42 45 20 7b 0a 20 20 20 20 20 20 57 48 |y) BE {. WH|
00000520 49 4c 45 20 4f 53 42 79 74 65 28 23 78 38 30 2c |ILE OSByte(#x80,|
00000530 20 32 35 33 2c 20 32 35 35 29 3c 32 20 44 4f 20 | 253, 255)<2 DO |
00000540 4c 4f 4f 50 3b 0a 20 20 20 20 20 20 49 46 20 4f |LOOP;. IF O|
00000550 53 42 79 74 65 28 23 78 38 41 2c 20 32 2c 20 63 |SByte(#x8A, 2, c|
00000560 68 29 20 20 2f 2f 20 50 75 74 20 63 68 20 69 6e |h) // Put ch in|
00000570 20 52 53 34 32 33 20 62 75 66 66 65 72 0a 20 20 | RS423 buffer. |
00000580 20 20 20 20 49 46 20 63 68 3d 27 2a 4e 27 20 26 | IF ch='*N' &|
00000590 20 7e 62 69 6e 61 72 79 20 54 48 45 4e 20 4f 53 | ~binary THEN OS|
000005a0 42 79 74 65 28 23 78 38 41 2c 20 32 2c 20 27 2a |Byte(#x8A, 2, '*|
000005b0 43 27 29 20 7d 0a 0a 20 20 20 73 74 72 65 61 6d |C') }.. stream|
000005c0 20 3a 3d 20 4d 61 6b 65 4e 65 77 53 74 72 65 61 | := MakeNewStrea|
000005d0 6d 28 6e 61 6d 65 2c 0a 09 09 09 20 20 20 73 2e |m(name,.... s.|
000005e0 69 73 2e 73 65 72 69 61 6c 2e 62 69 74 73 2c 0a |is.serial.bits,.|
000005f0 09 09 09 20 20 20 64 69 72 65 63 74 69 6f 6e 2c |... direction,|
00000600 0a 09 09 09 20 20 20 4f 53 52 64 43 68 2c 09 20 |.... OSRdCh,. |
00000610 20 20 20 20 20 2f 2f 20 52 64 43 68 28 29 0a 09 | // RdCh()..|
00000620 09 09 20 20 20 53 65 72 69 61 6c 57 72 69 74 65 |.. SerialWrite|
00000630 29 20 20 20 20 20 20 20 2f 2f 20 57 72 43 68 28 |) // WrCh(|
00000640 29 0a 20 20 20 73 74 72 65 61 6d 21 73 2e 73 65 |). stream!s.se|
00000650 6c 65 63 74 65 72 20 3a 3d 20 53 65 72 69 61 6c |lecter := Serial|
00000660 53 65 6c 65 63 74 0a 20 20 20 52 45 53 55 4c 54 |Select. RESULT|
00000670 49 53 20 73 74 72 65 61 6d 20 7d 0a 0a 41 4e 44 |IS stream }..AND|
00000680 20 4d 61 6b 65 50 72 69 6e 74 65 72 53 74 72 65 | MakePrinterStre|
00000690 61 6d 28 64 69 72 65 63 74 69 6f 6e 2c 20 6e 61 |am(direction, na|
000006a0 6d 65 29 20 3d 20 56 41 4c 4f 46 20 7b 0a 20 20 |me) = VALOF {. |
000006b0 20 4c 45 54 20 73 74 72 65 61 6d 20 3d 20 3f 0a | LET stream = ?.|
000006c0 0a 20 20 20 4c 45 54 20 50 72 69 6e 74 65 72 4f |. LET PrinterO|
000006d0 6e 28 63 68 2c 20 70 72 69 6e 74 65 72 29 20 42 |n(ch, printer) B|
000006e0 45 20 7b 0a 20 20 20 20 20 20 4f 53 42 79 74 65 |E {. OSByte|
000006f0 28 33 2c 20 23 62 30 30 30 31 30 30 30 30 2c 20 |(3, #b00010000, |
00000700 30 29 20 2f 2f 20 54 75 72 6e 20 6f 6e 20 76 64 |0) // Turn on vd|
00000710 75 20 74 6f 20 68 61 6e 64 6c 65 20 74 68 65 20 |u to handle the |
00000720 56 44 55 20 32 0a 20 20 20 20 20 20 4f 53 57 72 |VDU 2. OSWr|
00000730 43 68 28 32 29 20 20 2f 2f 20 43 6c 61 69 6d 20 |Ch(2) // Claim |
00000740 74 68 65 20 70 72 69 6e 74 65 72 0a 20 20 20 20 |the printer. |
00000750 20 20 50 72 69 6e 74 65 72 53 65 6c 65 63 74 28 | PrinterSelect(|
00000760 70 72 69 6e 74 65 72 2c 20 73 2e 69 73 2e 6f 75 |printer, s.is.ou|
00000770 74 70 75 74 2e 62 69 74 29 0a 20 20 20 20 20 20 |tput.bit). |
00000780 50 72 69 6e 74 65 72 57 72 43 68 28 63 68 29 0a |PrinterWrCh(ch).|
00000790 20 20 20 20 20 20 63 6f 73 21 73 2e 77 72 69 74 | cos!s.writ|
000007a0 65 72 20 3a 3d 20 50 72 69 6e 74 65 72 57 72 43 |er := PrinterWrC|
000007b0 68 20 7d 0a 0a 20 20 20 41 4e 44 20 50 72 69 6e |h }.. AND Prin|
000007c0 74 65 72 57 72 43 68 28 63 68 2c 20 63 68 61 6e |terWrCh(ch, chan|
000007d0 6e 65 6c 2c 20 62 69 6e 61 72 79 29 20 42 45 20 |nel, binary) BE |
000007e0 7b 0a 20 20 20 20 20 20 49 46 20 63 68 3d 27 2a |{. IF ch='*|
000007f0 6e 27 20 26 20 7e 62 69 6e 61 72 79 20 54 48 45 |n' & ~binary THE|
00000800 4e 20 4f 53 57 72 43 68 28 27 2a 63 27 29 3b 0a |N OSWrCh('*c');.|
00000810 20 20 20 20 20 20 4f 53 57 72 43 68 28 63 68 29 | OSWrCh(ch)|
00000820 20 7d 0a 0a 20 20 20 41 4e 44 20 50 72 69 6e 74 | }.. AND Print|
00000830 65 72 45 6e 64 28 70 72 69 6e 74 65 72 29 20 42 |erEnd(printer) B|
00000840 45 20 7b 0a 20 20 20 20 20 20 4f 53 42 79 74 65 |E {. OSByte|
00000850 28 33 2c 20 23 62 30 30 30 31 30 30 30 30 2c 20 |(3, #b00010000, |
00000860 30 29 20 2f 2f 20 54 75 72 6e 20 6f 6e 20 76 64 |0) // Turn on vd|
00000870 75 20 74 6f 20 68 61 6e 64 6c 65 20 74 68 65 20 |u to handle the |
00000880 56 44 55 20 33 0a 20 20 20 20 20 20 4f 53 57 72 |VDU 3. OSWr|
00000890 43 68 28 33 29 20 20 2f 2f 20 53 74 6f 70 20 73 |Ch(3) // Stop s|
000008a0 65 6e 64 69 6e 67 20 74 6f 20 74 68 65 20 70 72 |ending to the pr|
000008b0 69 6e 74 65 72 0a 20 20 20 20 20 20 4f 53 42 79 |inter. OSBy|
000008c0 74 65 28 33 2c 20 23 62 30 30 30 30 30 31 30 30 |te(3, #b00000100|
000008d0 2c 20 30 29 20 2f 2f 20 56 44 55 20 6f 6e 6c 79 |, 0) // VDU only|
000008e0 20 66 72 6f 6d 20 6e 6f 77 20 6f 6e 0a 20 20 20 | from now on. |
000008f0 20 20 20 45 6e 64 53 74 72 65 61 6d 28 70 72 69 | EndStream(pri|
00000900 6e 74 65 72 29 20 7d 0a 0a 20 20 20 41 4e 44 20 |nter) }.. AND |
00000910 50 72 69 6e 74 65 72 53 65 6c 65 63 74 28 70 72 |PrinterSelect(pr|
00000920 69 6e 74 65 72 2c 20 64 69 72 65 63 74 69 6f 6e |inter, direction|
00000930 29 20 42 45 0a 20 20 20 20 20 20 49 46 20 64 69 |) BE. IF di|
00000940 72 65 63 74 69 6f 6e 3d 73 2e 69 73 2e 6f 75 74 |rection=s.is.out|
00000950 70 75 74 2e 62 69 74 20 54 48 45 4e 20 7b 0a 20 |put.bit THEN {. |
00000960 20 20 20 20 20 2f 2f 20 44 6f 20 74 68 65 20 6e | // Do the n|
00000970 65 63 65 73 73 61 72 79 20 4f 53 42 79 74 65 28 |ecessary OSByte(|
00000980 29 73 20 74 6f 20 74 75 72 6e 20 6f 66 66 20 74 |)s to turn off t|
00000990 68 69 6e 67 73 20 6f 6e 20 63 65 6e 74 72 61 6c |hings on central|
000009a0 0a 20 20 20 20 20 20 2f 2f 20 6f 75 74 70 75 74 |. // output|
000009b0 20 73 74 72 65 61 6d 20 65 78 63 65 70 74 20 66 | stream except f|
000009c0 6f 72 20 74 68 65 20 63 75 72 72 65 6e 74 6c 79 |or the currently|
000009d0 20 73 65 6c 65 63 74 65 64 20 70 72 69 6e 74 65 | selected printe|
000009e0 72 20 21 0a 09 20 4f 53 42 79 74 65 28 33 2c 20 |r !.. OSByte(3, |
000009f0 23 62 30 30 30 31 31 30 31 30 2c 20 30 29 20 7d |#b00011010, 0) }|
00000a00 0a 0a 20 20 20 49 46 20 64 69 72 65 63 74 69 6f |.. IF directio|
00000a10 6e 7e 3d 73 2e 6f 70 2e 6f 75 74 70 75 74 20 54 |n~=s.op.output T|
00000a20 48 45 4e 20 52 45 53 55 4c 54 49 53 20 30 0a 20 |HEN RESULTIS 0. |
00000a30 20 20 73 74 72 65 61 6d 20 3a 3d 20 4d 61 6b 65 | stream := Make|
00000a40 4e 65 77 53 74 72 65 61 6d 28 6e 61 6d 65 2c 0a |NewStream(name,.|
00000a50 09 09 09 20 20 20 73 2e 69 73 2e 70 72 69 6e 74 |... s.is.print|
00000a60 65 72 2e 62 69 74 73 2c 0a 09 09 09 20 20 20 64 |er.bits,.... d|
00000a70 69 72 65 63 74 69 6f 6e 2c 0a 09 09 09 20 20 20 |irection,.... |
00000a80 45 72 72 6f 72 52 64 2c 20 20 20 20 2f 2f 20 52 |ErrorRd, // R|
00000a90 64 43 68 28 29 0a 09 09 09 20 20 20 50 72 69 6e |dCh().... Prin|
00000aa0 74 65 72 4f 6e 29 09 2f 2f 20 57 72 43 68 28 29 |terOn).// WrCh()|
00000ab0 0a 20 20 20 73 74 72 65 61 6d 21 73 2e 73 65 6c |. stream!s.sel|
00000ac0 65 63 74 65 72 20 3a 3d 20 50 72 69 6e 74 65 72 |ecter := Printer|
00000ad0 53 65 6c 65 63 74 0a 20 20 20 73 74 72 65 61 6d |Select. stream|
00000ae0 21 73 2e 65 6e 64 77 72 69 74 65 72 20 3a 3d 20 |!s.endwriter := |
00000af0 50 72 69 6e 74 65 72 45 6e 64 0a 20 20 20 52 45 |PrinterEnd. RE|
00000b00 53 55 4c 54 49 53 20 73 74 72 65 61 6d 20 7d 0a |SULTIS stream }.|
00000b10 0a 41 4e 44 20 4d 61 6b 65 46 69 6c 65 53 74 72 |.AND MakeFileStr|
00000b20 65 61 6d 28 64 69 72 65 63 74 69 6f 6e 2c 20 6e |eam(direction, n|
00000b30 61 6d 65 29 20 3d 20 56 41 4c 4f 46 20 7b 0a 20 |ame) = VALOF {. |
00000b40 20 20 4c 45 54 20 73 74 72 65 61 6d 20 3d 20 3f | LET stream = ?|
00000b50 0a 20 20 20 4c 45 54 20 63 68 61 6e 6e 65 6c 20 |. LET channel |
00000b60 3d 20 3f 0a 0a 20 20 20 4c 45 54 20 46 69 6c 65 |= ?.. LET File|
00000b70 45 6e 64 52 65 61 64 57 72 69 74 65 28 73 74 72 |EndReadWrite(str|
00000b80 65 61 6d 29 20 42 45 20 7b 0a 20 20 20 2f 2a 20 |eam) BE {. /* |
00000b90 63 61 6c 6c 65 64 20 77 68 65 6e 20 45 6e 64 52 |called when EndR|
00000ba0 65 61 64 20 6f 72 20 45 6e 64 57 72 69 74 65 20 |ead or EndWrite |
00000bb0 64 6f 6e 65 20 6f 66 20 61 20 64 69 73 6b 20 66 |done of a disk f|
00000bc0 69 6c 65 20 2a 2f 0a 20 20 20 20 20 20 49 46 20 |ile */. IF |
00000bd0 28 73 74 72 65 61 6d 21 73 2e 66 6c 61 67 73 20 |(stream!s.flags |
00000be0 26 20 73 2e 68 61 73 2e 63 68 61 6e 6e 65 6c 2e |& s.has.channel.|
00000bf0 62 69 74 29 7e 3d 30 20 54 48 45 4e 20 7b 0a 09 |bit)~=0 THEN {..|
00000c00 20 4f 53 46 69 6e 64 28 73 2e 6f 70 2e 63 6c 6f | OSFind(s.op.clo|
00000c10 73 65 2c 20 73 74 72 65 61 6d 21 73 2e 63 68 61 |se, stream!s.cha|
00000c20 6e 6e 65 6c 29 3b 0a 09 20 49 46 20 72 65 73 75 |nnel);.. IF resu|
00000c30 6c 74 32 20 3c 20 30 20 54 48 45 4e 0a 09 20 20 |lt2 < 0 THEN.. |
00000c40 20 20 4e 61 73 74 79 45 72 72 6f 72 48 61 6e 64 | NastyErrorHand|
00000c50 6c 65 72 28 73 74 72 65 61 6d 2c 20 65 2e 6e 61 |ler(stream, e.na|
00000c60 73 74 79 2e 65 72 72 6f 72 29 0a 20 20 20 20 20 |sty.error). |
00000c70 20 7d 0a 20 20 20 20 20 20 73 74 72 65 61 6d 21 | }. stream!|
00000c80 73 2e 66 6c 61 67 73 20 3a 3d 20 73 74 72 65 61 |s.flags := strea|
00000c90 6d 21 73 2e 66 6c 61 67 73 20 26 20 7e 73 2e 68 |m!s.flags & ~s.h|
00000ca0 61 73 2e 63 68 61 6e 6e 65 6c 2e 62 69 74 0a 20 |as.channel.bit. |
00000cb0 20 20 20 20 20 45 6e 64 53 74 72 65 61 6d 28 73 | EndStream(s|
00000cc0 74 72 65 61 6d 29 20 7d 0a 0a 20 20 20 63 68 61 |tream) }.. cha|
00000cd0 6e 6e 65 6c 20 3a 3d 20 4f 53 46 69 6e 64 28 64 |nnel := OSFind(d|
00000ce0 69 72 65 63 74 69 6f 6e 2c 20 6e 61 6d 65 29 0a |irection, name).|
00000cf0 20 20 20 49 46 20 63 68 61 6e 6e 65 6c 3d 30 20 | IF channel=0 |
00000d00 54 48 45 4e 20 7b 0a 20 20 20 20 20 20 72 65 73 |THEN {. res|
00000d10 75 6c 74 32 20 3a 3d 20 63 68 61 6e 6e 65 6c 20 |ult2 := channel |
00000d20 20 2f 2f 20 53 61 76 65 20 65 72 72 6f 72 20 6e | // Save error n|
00000d30 75 6d 62 65 72 0a 20 20 20 20 20 20 52 45 53 55 |umber. RESU|
00000d40 4c 54 49 53 20 30 20 7d 3b 0a 20 20 20 73 74 72 |LTIS 0 };. str|
00000d50 65 61 6d 20 3a 3d 20 4d 61 6b 65 4e 65 77 53 74 |eam := MakeNewSt|
00000d60 72 65 61 6d 28 6e 61 6d 65 2c 0a 09 09 09 20 20 |ream(name,.... |
00000d70 20 73 2e 69 73 2e 66 69 6c 65 2e 62 69 74 73 2c | s.is.file.bits,|
00000d80 0a 09 09 09 20 20 20 64 69 72 65 63 74 69 6f 6e |.... direction|
00000d90 2c 0a 09 09 09 20 20 20 4f 53 42 47 65 74 2c 20 |,.... OSBGet, |
00000da0 20 20 2f 2f 20 52 64 43 68 28 29 0a 09 09 09 20 | // RdCh().... |
00000db0 20 20 4f 53 42 50 75 74 29 20 20 20 2f 2f 20 57 | OSBPut) // W|
00000dc0 72 43 68 28 29 0a 20 20 20 73 74 72 65 61 6d 21 |rCh(). stream!|
00000dd0 73 2e 63 68 61 6e 6e 65 6c 20 3a 3d 20 63 68 61 |s.channel := cha|
00000de0 6e 6e 65 6c 0a 20 20 20 73 74 72 65 61 6d 21 73 |nnel. stream!s|
00000df0 2e 66 6c 61 67 73 20 3a 3d 20 73 74 72 65 61 6d |.flags := stream|
00000e00 21 73 2e 66 6c 61 67 73 20 7c 20 73 2e 68 61 73 |!s.flags | s.has|
00000e10 2e 63 68 61 6e 6e 65 6c 2e 62 69 74 0a 20 20 20 |.channel.bit. |
00000e20 73 74 72 65 61 6d 21 73 2e 65 6e 64 72 65 61 64 |stream!s.endread|
00000e30 65 72 20 3a 3d 20 46 69 6c 65 45 6e 64 52 65 61 |er := FileEndRea|
00000e40 64 57 72 69 74 65 0a 20 20 20 73 74 72 65 61 6d |dWrite. stream|
00000e50 21 73 2e 65 6e 64 77 72 69 74 65 72 20 3a 3d 20 |!s.endwriter := |
00000e60 46 69 6c 65 45 6e 64 52 65 61 64 57 72 69 74 65 |FileEndReadWrite|
00000e70 0a 20 20 20 52 45 53 55 4c 54 49 53 20 73 74 72 |. RESULTIS str|
00000e80 65 61 6d 20 7d 0a 0a 41 4e 44 20 4d 61 6b 65 4e |eam }..AND MakeN|
00000e90 65 77 53 74 72 65 61 6d 28 6e 61 6d 65 2c 20 74 |ewStream(name, t|
00000ea0 79 70 65 2c 20 64 69 72 65 63 74 69 6f 6e 2c 20 |ype, direction, |
00000eb0 72 64 2c 20 77 72 29 20 3d 20 56 41 4c 4f 46 20 |rd, wr) = VALOF |
00000ec0 7b 0a 20 20 20 4d 41 4e 49 46 45 53 54 20 7b 20 |{. MANIFEST { |
00000ed0 73 2e 6e 61 6d 65 2e 6d 61 78 2e 73 69 7a 65 2e |s.name.max.size.|
00000ee0 6d 2e 31 20 3d 20 73 2e 6e 61 6d 65 2e 6d 61 78 |m.1 = s.name.max|
00000ef0 2e 73 69 7a 65 2d 31 20 7d 3b 0a 20 20 20 4c 45 |.size-1 };. LE|
00000f00 54 20 73 74 72 65 61 6d 20 3d 20 47 65 74 56 65 |T stream = GetVe|
00000f10 63 28 73 2e 73 74 72 65 61 6d 2e 73 69 7a 65 29 |c(s.stream.size)|
00000f20 0a 0a 20 20 20 41 4e 44 20 68 63 64 72 28 63 68 |.. AND hcdr(ch|
00000f30 61 6e 6e 65 6c 29 20 42 45 20 7b 0a 20 20 20 2f |annel) BE {. /|
00000f40 2a 20 63 61 6c 6c 65 64 20 77 68 65 6e 20 55 6e |* called when Un|
00000f50 52 64 43 68 28 29 20 64 6f 6e 65 20 6f 6e 20 74 |RdCh() done on t|
00000f60 68 65 20 63 75 72 72 65 6e 74 20 73 74 72 65 61 |he current strea|
00000f70 6d 20 2a 2f 0a 20 20 20 20 20 20 4c 45 54 20 4e |m */. LET N|
00000f80 65 78 74 52 64 43 68 28 63 68 61 6e 6e 65 6c 29 |extRdCh(channel)|
00000f90 20 3d 20 56 41 4c 4f 46 20 7b 0a 20 20 20 20 20 | = VALOF {. |
00000fa0 20 2f 2a 20 63 61 6c 6c 65 64 20 6f 6e 20 6e 65 | /* called on ne|
00000fb0 78 74 20 52 64 43 68 28 29 20 61 66 74 65 72 20 |xt RdCh() after |
00000fc0 61 20 55 6e 52 64 43 68 28 29 20 2a 2f 0a 09 20 |a UnRdCh() */.. |
00000fd0 63 69 73 21 73 2e 72 65 61 64 65 72 20 3a 3d 20 |cis!s.reader := |
00000fe0 63 69 73 21 73 2e 72 65 61 6c 2e 72 65 61 64 65 |cis!s.real.reade|
00000ff0 72 0a 09 20 52 45 53 55 4c 54 49 53 20 63 69 73 |r.. RESULTIS cis|
00001000 21 73 2e 6c 61 73 74 2e 63 68 61 72 20 7d 0a 20 |!s.last.char }. |
00001010 20 20 20 20 20 63 69 73 21 73 2e 72 65 61 64 65 | cis!s.reade|
00001020 72 20 3a 3d 20 4e 65 78 74 52 64 43 68 20 7d 0a |r := NextRdCh }.|
00001030 0a 20 20 20 49 46 20 73 74 72 65 61 6d 3d 30 20 |. IF stream=0 |
00001040 54 48 45 4e 0a 20 20 20 20 20 20 46 61 75 6c 74 |THEN. Fault|
00001050 28 22 4e 6f 20 72 6f 6f 6d 20 66 6f 72 20 73 74 |("No room for st|
00001060 72 65 61 6d 73 22 2c 20 65 2e 6e 6f 2e 77 6f 72 |reams", e.no.wor|
00001070 6b 2e 73 70 61 63 65 29 0a 20 20 20 73 74 72 65 |k.space). stre|
00001080 61 6d 21 73 2e 6d 61 67 69 63 20 3a 3d 20 73 2e |am!s.magic := s.|
00001090 69 73 2e 61 2e 73 74 72 65 61 6d 0a 20 20 20 73 |is.a.stream. s|
000010a0 74 72 65 61 6d 21 73 2e 73 74 72 65 61 6d 2e 63 |tream!s.stream.c|
000010b0 68 61 69 6e 20 3a 3d 20 73 74 72 65 61 6d 63 68 |hain := streamch|
000010c0 61 69 6e 0a 20 20 20 73 74 72 65 61 6d 63 68 61 |ain. streamcha|
000010d0 69 6e 20 3a 3d 20 73 74 72 65 61 6d 0a 20 20 20 |in := stream. |
000010e0 73 74 72 65 61 6d 21 73 2e 66 6c 61 67 73 20 3a |stream!s.flags :|
000010f0 3d 20 74 79 70 65 20 7c 20 28 64 69 72 65 63 74 |= type | (direct|
00001100 69 6f 6e 7e 3d 73 2e 6f 70 2e 6f 75 74 70 75 74 |ion~=s.op.output|
00001110 20 2d 3e 20 73 2e 69 73 2e 69 6e 70 75 74 2e 62 | -> s.is.input.b|
00001120 69 74 2c 0a 09 09 09 20 20 20 20 20 64 69 72 65 |it,.... dire|
00001130 63 74 69 6f 6e 7e 3d 73 2e 6f 70 2e 69 6e 70 75 |ction~=s.op.inpu|
00001140 74 20 2d 3e 20 73 2e 69 73 2e 6f 75 74 70 75 74 |t -> s.is.output|
00001150 2e 62 69 74 2c 20 30 29 0a 20 20 20 46 4f 52 20 |.bit, 0). FOR |
00001160 69 20 3d 20 30 20 54 4f 20 73 2e 6e 61 6d 65 2e |i = 0 TO s.name.|
00001170 6d 61 78 2e 73 69 7a 65 2e 6d 2e 31 20 44 4f 0a |max.size.m.1 DO.|
00001180 20 20 20 20 20 20 28 40 28 73 74 72 65 61 6d 21 | (@(stream!|
00001190 73 2e 6e 61 6d 65 29 29 25 69 20 3a 3d 20 69 3e |s.name))%i := i>|
000011a0 6e 61 6d 65 25 30 20 2d 3e 20 27 20 27 2c 20 6e |name%0 -> ' ', n|
000011b0 61 6d 65 25 69 0a 20 20 20 49 46 20 6e 61 6d 65 |ame%i. IF name|
000011c0 25 30 3e 3d 73 2e 6e 61 6d 65 2e 6d 61 78 2e 73 |%0>=s.name.max.s|
000011d0 69 7a 65 20 54 48 45 4e 0a 20 20 20 20 20 20 28 |ize THEN. (|
000011e0 40 28 73 74 72 65 61 6d 21 73 2e 6e 61 6d 65 29 |@(stream!s.name)|
000011f0 29 25 30 20 3a 3d 20 73 2e 6e 61 6d 65 2e 6d 61 |)%0 := s.name.ma|
00001200 78 2e 73 69 7a 65 2d 31 0a 20 20 20 73 74 72 65 |x.size-1. stre|
00001210 61 6d 21 73 2e 63 68 61 6e 6e 65 6c 20 3a 3d 20 |am!s.channel := |
00001220 2d 31 0a 20 20 20 73 74 72 65 61 6d 21 73 2e 65 |-1. stream!s.e|
00001230 72 72 6f 72 2e 68 61 6e 64 6c 65 72 20 3a 3d 20 |rror.handler := |
00001240 4e 61 73 74 79 45 72 72 6f 72 48 61 6e 64 6c 65 |NastyErrorHandle|
00001250 72 0a 20 20 20 73 74 72 65 61 6d 21 73 2e 73 65 |r. stream!s.se|
00001260 6c 65 63 74 65 72 20 3a 3d 20 4e 6f 74 68 69 6e |lecter := Nothin|
00001270 67 0a 20 20 20 73 74 72 65 61 6d 21 73 2e 72 65 |g. stream!s.re|
00001280 61 64 65 72 20 3a 3d 20 64 69 72 65 63 74 69 6f |ader := directio|
00001290 6e 7e 3d 73 2e 6f 70 2e 6f 75 74 70 75 74 20 2d |n~=s.op.output -|
000012a0 3e 20 72 64 2c 20 45 72 72 6f 72 52 64 0a 20 20 |> rd, ErrorRd. |
000012b0 20 73 74 72 65 61 6d 21 73 2e 77 72 69 74 65 72 | stream!s.writer|
000012c0 20 3a 3d 20 64 69 72 65 63 74 69 6f 6e 7e 3d 73 | := direction~=s|
000012d0 2e 6f 70 2e 69 6e 70 75 74 20 2d 3e 20 77 72 2c |.op.input -> wr,|
000012e0 20 45 72 72 6f 72 57 72 0a 20 20 20 73 74 72 65 | ErrorWr. stre|
000012f0 61 6d 21 73 2e 75 6e 72 65 61 64 65 72 20 3a 3d |am!s.unreader :=|
00001300 20 64 69 72 65 63 74 69 6f 6e 7e 3d 73 2e 6f 70 | direction~=s.op|
00001310 2e 6f 75 74 70 75 74 20 2d 3e 20 68 63 64 72 2c |.output -> hcdr,|
00001320 20 45 72 72 6f 72 52 64 0a 20 20 20 73 74 72 65 | ErrorRd. stre|
00001330 61 6d 21 73 2e 6c 61 73 74 2e 63 68 61 72 20 3a |am!s.last.char :|
00001340 3d 20 45 6e 64 53 74 72 65 61 6d 43 68 0a 20 20 |= EndStreamCh. |
00001350 20 73 74 72 65 61 6d 21 73 2e 72 65 61 6c 2e 72 | stream!s.real.r|
00001360 65 61 64 65 72 20 3a 3d 20 73 74 72 65 61 6d 21 |eader := stream!|
00001370 73 2e 72 65 61 64 65 72 0a 20 20 20 73 74 72 65 |s.reader. stre|
00001380 61 6d 21 73 2e 65 72 72 6f 72 2e 63 6f 75 6e 74 |am!s.error.count|
00001390 20 3a 3d 20 30 0a 20 20 20 73 74 72 65 61 6d 21 | := 0. stream!|
000013a0 73 2e 6c 61 73 74 2e 65 72 72 6f 72 20 3a 3d 20 |s.last.error := |
000013b0 30 0a 20 20 20 73 74 72 65 61 6d 21 73 2e 65 6e |0. stream!s.en|
000013c0 64 72 65 61 64 65 72 20 3a 3d 20 45 6e 64 53 74 |dreader := EndSt|
000013d0 72 65 61 6d 0a 20 20 20 73 74 72 65 61 6d 21 73 |ream. stream!s|
000013e0 2e 65 6e 64 77 72 69 74 65 72 20 3a 3d 20 45 6e |.endwriter := En|
000013f0 64 53 74 72 65 61 6d 0a 20 20 20 73 74 72 65 61 |dStream. strea|
00001400 6d 21 73 2e 62 75 66 66 65 72 2e 73 69 7a 65 20 |m!s.buffer.size |
00001410 3a 3d 20 30 0a 20 20 20 73 74 72 65 61 6d 21 73 |:= 0. stream!s|
00001420 2e 62 75 66 66 65 72 2e 61 64 64 72 65 73 73 20 |.buffer.address |
00001430 3a 3d 20 30 0a 20 20 20 73 74 72 65 61 6d 21 73 |:= 0. stream!s|
00001440 2e 62 75 66 66 65 72 2e 63 6f 75 6e 74 20 3a 3d |.buffer.count :=|
00001450 20 30 0a 20 20 20 73 74 72 65 61 6d 21 73 2e 62 | 0. stream!s.b|
00001460 75 66 66 65 72 2e 70 6f 69 6e 74 65 72 20 3a 3d |uffer.pointer :=|
00001470 20 30 0a 20 20 20 52 45 53 55 4c 54 49 53 20 73 | 0. RESULTIS s|
00001480 74 72 65 61 6d 20 7d 0a 0a 41 4e 44 20 45 72 72 |tream }..AND Err|
00001490 6f 72 52 64 28 29 20 42 45 0a 2f 2a 20 63 61 6c |orRd() BE./* cal|
000014a0 6c 65 64 20 77 68 65 6e 20 74 72 79 69 6e 67 20 |led when trying |
000014b0 64 6f 20 72 65 61 64 20 66 72 6f 6d 20 61 20 77 |do read from a w|
000014c0 72 69 74 65 20 6f 6e 6c 79 20 73 74 72 65 61 6d |rite only stream|
000014d0 20 2a 2f 0a 20 20 20 46 61 75 6c 74 28 22 52 65 | */. Fault("Re|
000014e0 61 64 20 6e 6f 74 20 70 65 72 6d 69 74 74 65 64 |ad not permitted|
000014f0 20 6f 6e 20 73 74 72 65 61 6d 20 2a 22 25 53 2a | on stream *"%S*|
00001500 22 22 2c 0a 09 20 20 65 2e 6d 75 73 74 2e 6e 6f |"",.. e.must.no|
00001510 74 2e 72 65 61 64 2c 20 40 28 63 69 73 21 73 2e |t.read, @(cis!s.|
00001520 6e 61 6d 65 29 29 0a 0a 41 4e 44 20 45 72 72 6f |name))..AND Erro|
00001530 72 57 72 28 29 20 42 45 0a 2f 2a 20 63 61 6c 6c |rWr() BE./* call|
00001540 65 64 20 77 68 65 6e 20 74 72 79 69 6e 67 20 74 |ed when trying t|
00001550 6f 20 77 72 69 74 65 20 74 6f 20 61 20 72 65 61 |o write to a rea|
00001560 64 20 6f 6e 6c 79 20 73 74 72 65 61 6d 20 2a 2f |d only stream */|
00001570 0a 20 20 20 46 61 75 6c 74 28 22 57 72 69 74 65 |. Fault("Write|
00001580 20 6e 6f 74 20 70 65 72 6d 69 74 74 65 64 20 6f | not permitted o|
00001590 6e 20 73 74 72 65 61 6d 20 2a 22 25 53 2a 22 22 |n stream *"%S*""|
000015a0 2c 0a 09 20 20 65 2e 6d 75 73 74 2e 6e 6f 74 2e |,.. e.must.not.|
000015b0 77 72 69 74 65 2c 20 40 28 63 6f 73 21 73 2e 6e |write, @(cos!s.n|
000015c0 61 6d 65 29 29 0a 0a 41 4e 44 20 45 6e 64 53 74 |ame))..AND EndSt|
000015d0 72 65 61 6d 28 73 74 72 65 61 6d 29 20 42 45 20 |ream(stream) BE |
000015e0 7b 0a 2f 2a 20 63 61 6c 6c 65 64 20 77 68 65 6e |{./* called when|
000015f0 20 45 6e 64 52 65 61 64 28 29 20 6f 72 20 45 6e | EndRead() or En|
00001600 64 57 72 69 74 65 28 29 20 64 6f 6e 65 20 6f 6e |dWrite() done on|
00001610 20 74 68 69 73 20 73 74 72 65 61 6d 20 2a 2f 0a | this stream */.|
00001620 20 20 20 4c 45 54 20 73 73 20 3d 20 2d 73 2e 73 | LET ss = -s.s|
00001630 74 72 65 61 6d 2e 63 68 61 69 6e 2b 40 73 74 72 |tream.chain+@str|
00001640 65 61 6d 43 68 61 69 6e 3b 0a 20 20 20 4c 45 54 |eamChain;. LET|
00001650 20 73 20 3d 20 73 74 72 65 61 6d 43 68 61 69 6e | s = streamChain|
00001660 3b 0a 20 20 20 57 48 49 4c 45 20 73 7e 3d 30 20 |;. WHILE s~=0 |
00001670 44 4f 20 7b 0a 20 20 20 20 20 20 49 46 20 73 3d |DO {. IF s=|
00001680 73 74 72 65 61 6d 20 54 48 45 4e 20 7b 0a 09 20 |stream THEN {.. |
00001690 73 2e 73 74 72 65 61 6d 2e 63 68 61 69 6e 21 73 |s.stream.chain!s|
000016a0 73 20 3a 3d 20 73 2e 73 74 72 65 61 6d 2e 63 68 |s := s.stream.ch|
000016b0 61 69 6e 21 73 74 72 65 61 6d 3b 20 42 52 45 41 |ain!stream; BREA|
000016c0 4b 20 7d 3b 0a 20 20 20 20 20 20 73 73 20 3a 3d |K };. ss :=|
000016d0 20 73 3b 20 73 20 3a 3d 20 73 2e 73 74 72 65 61 | s; s := s.strea|
000016e0 6d 2e 63 68 61 69 6e 21 73 20 7d 3b 0a 20 20 20 |m.chain!s };. |
000016f0 54 45 53 54 20 73 74 72 65 61 6d 3d 63 69 73 0a |TEST stream=cis.|
00001700 20 20 20 20 20 20 54 48 45 4e 20 63 69 73 20 3a | THEN cis :|
00001710 3d 20 65 72 72 6f 72 73 74 72 65 61 6d 0a 20 20 |= errorstream. |
00001720 20 20 20 20 45 4c 53 45 20 63 6f 73 20 3a 3d 20 | ELSE cos := |
00001730 65 72 72 6f 72 73 74 72 65 61 6d 3b 0a 20 20 20 |errorstream;. |
00001740 46 72 65 65 56 65 63 28 73 74 72 65 61 6d 29 20 |FreeVec(stream) |
00001750 7d 0a 0a 41 4e 44 20 4e 61 73 74 79 45 72 72 6f |}..AND NastyErro|
00001760 72 48 61 6e 64 6c 65 72 28 73 74 72 65 61 6d 2c |rHandler(stream,|
00001770 20 65 72 72 6f 72 29 20 42 45 20 7b 0a 2f 2a 20 | error) BE {./* |
00001780 64 65 66 61 75 6c 74 20 72 6f 75 74 69 6e 65 20 |default routine |
00001790 74 6f 20 68 61 6e 64 6c 65 20 48 4f 53 54 20 65 |to handle HOST e|
000017a0 72 72 6f 72 73 2c 20 6a 75 73 74 20 62 6c 6f 77 |rrors, just blow|
000017b0 73 20 68 69 6d 20 61 77 61 79 2e 2e 2e 20 2a 2f |s him away... */|
000017c0 0a 0a 20 20 20 4c 45 54 20 6d 65 73 73 61 67 65 |.. LET message|
000017d0 20 3d 20 56 45 43 20 32 35 36 2f 42 79 74 65 73 | = VEC 256/Bytes|
000017e0 50 65 72 57 6f 72 64 0a 0a 20 20 20 73 74 72 65 |PerWord.. stre|
000017f0 61 6d 21 73 2e 65 72 72 6f 72 2e 63 6f 75 6e 74 |am!s.error.count|
00001800 20 3a 3d 20 73 74 72 65 61 6d 21 73 2e 65 72 72 | := stream!s.err|
00001810 6f 72 2e 63 6f 75 6e 74 2b 31 0a 20 20 20 73 74 |or.count+1. st|
00001820 72 65 61 6d 21 73 2e 6c 61 73 74 2e 65 72 72 6f |ream!s.last.erro|
00001830 72 20 3a 3d 20 65 72 72 6f 72 0a 20 20 20 74 6b |r := error. tk|
00001840 72 65 72 72 28 6d 65 73 73 61 67 65 2c 20 32 35 |rerr(message, 25|
00001850 36 29 0a 20 20 20 46 61 75 6c 74 28 22 46 61 74 |6). Fault("Fat|
00001860 61 6c 20 49 2f 4f 20 65 72 72 6f 72 20 25 78 38 |al I/O error %x8|
00001870 20 25 73 20 6f 6e 20 25 73 20 73 74 72 65 61 6d | %s on %s stream|
00001880 20 2a 22 25 73 2a 22 22 2c 0a 09 20 20 65 2e 6e | *"%s*"",.. e.n|
00001890 61 73 74 79 2e 65 72 72 6f 72 2c 0a 09 20 20 65 |asty.error,.. e|
000018a0 72 72 6f 72 2c 0a 09 20 20 6d 65 73 73 61 67 65 |rror,.. message|
000018b0 2c 0a 09 20 20 28 73 74 72 65 61 6d 21 73 2e 66 |,.. (stream!s.f|
000018c0 6c 61 67 73 20 26 20 73 2e 69 73 2e 69 6e 70 75 |lags & s.is.inpu|
000018d0 74 2e 62 69 74 29 7e 3d 30 20 2d 3e 20 22 69 6e |t.bit)~=0 -> "in|
000018e0 70 75 74 22 2c 20 22 6f 75 74 70 75 74 22 2c 0a |put", "output",.|
000018f0 09 20 20 40 28 73 74 72 65 61 6d 21 73 2e 6e 61 |. @(stream!s.na|
00001900 6d 65 29 29 0a 20 20 20 54 45 53 54 20 28 73 74 |me)). TEST (st|
00001910 72 65 61 6d 21 73 2e 66 6c 61 67 73 20 26 20 73 |ream!s.flags & s|
00001920 2e 69 73 2e 69 6e 70 75 74 2e 62 69 74 29 7e 3d |.is.input.bit)~=|
00001930 30 0a 20 20 20 20 20 20 54 48 45 4e 20 73 74 72 |0. THEN str|
00001940 65 61 6d 21 73 2e 72 65 61 64 65 72 20 3a 3d 20 |eam!s.reader := |
00001950 4e 75 6c 6c 52 65 61 64 65 72 0a 20 20 20 20 20 |NullReader. |
00001960 20 45 4c 53 45 20 73 74 72 65 61 6d 21 73 2e 77 | ELSE stream!s.w|
00001970 72 69 74 65 72 20 3a 3d 20 4e 6f 74 68 69 6e 67 |riter := Nothing|
00001980 20 7d 0a 0a 41 4e 44 20 4e 75 6c 6c 52 65 61 64 | }..AND NullRead|
00001990 65 72 28 29 20 3d 20 45 6e 64 53 74 72 65 61 6d |er() = EndStream|
000019a0 43 68 0a 0a 41 4e 44 20 4d 61 6b 65 50 65 72 6d |Ch..AND MakePerm|
000019b0 61 6e 65 6e 74 53 74 72 65 61 6d 73 28 29 20 42 |anentStreams() B|
000019c0 45 20 7b 0a 2f 2a 20 74 6f 20 6d 61 6b 65 20 74 |E {./* to make t|
000019d0 68 65 20 56 44 55 3a 20 61 6e 64 20 65 72 72 6f |he VDU: and erro|
000019e0 72 20 73 74 72 65 61 6d 73 20 2a 2f 0a 0a 20 20 |r streams */.. |
000019f0 20 4c 45 54 20 4e 6f 74 4d 75 63 68 28 73 74 72 | LET NotMuch(str|
00001a00 65 61 6d 29 20 42 45 20 7b 0a 20 20 20 2f 2a 20 |eam) BE {. /* |
00001a10 63 61 6c 6c 65 64 20 77 68 65 6e 20 45 6e 64 52 |called when EndR|
00001a20 65 61 64 28 29 20 6f 72 20 45 6e 64 57 72 69 74 |ead() or EndWrit|
00001a30 65 28 29 20 64 6f 6e 65 20 74 6f 20 74 68 65 20 |e() done to the |
00001a40 63 6f 6e 73 6f 6c 65 20 73 74 72 65 61 6d 20 2a |console stream *|
00001a50 2f 0a 20 20 20 20 20 20 73 74 72 65 61 6d 21 73 |/. stream!s|
00001a60 2e 72 65 61 64 65 72 20 3a 3d 20 73 74 72 65 61 |.reader := strea|
00001a70 6d 21 73 2e 72 65 61 6c 2e 72 65 61 64 65 72 3b |m!s.real.reader;|
00001a80 0a 20 20 20 20 20 20 73 74 72 65 61 6d 21 73 2e |. stream!s.|
00001a90 65 72 72 6f 72 2e 63 6f 75 6e 74 20 3a 3d 20 30 |error.count := 0|
00001aa0 3b 0a 20 20 20 20 20 20 73 74 72 65 61 6d 21 73 |;. stream!s|
00001ab0 2e 6c 61 73 74 2e 65 72 72 6f 72 20 3a 3d 20 30 |.last.error := 0|
00001ac0 20 7d 0a 0a 20 20 20 41 4e 44 20 56 64 75 52 65 | }.. AND VduRe|
00001ad0 61 64 65 72 28 29 20 3d 20 56 41 4c 4f 46 20 7b |ader() = VALOF {|
00001ae0 0a 20 20 20 20 20 20 4c 45 54 20 63 68 20 3d 20 |. LET ch = |
00001af0 3f 3b 0a 20 20 20 20 20 20 4c 45 54 20 6f 6c 64 |?;. LET old|
00001b00 2e 63 6f 73 20 3d 20 4f 75 74 70 75 74 28 29 3b |.cos = Output();|
00001b10 0a 0a 20 20 20 20 20 20 57 48 49 4c 45 20 6c 69 |.. WHILE li|
00001b20 6e 65 62 75 66 66 25 32 3d 30 20 44 4f 20 7b 20 |nebuff%2=0 DO { |
00001b30 2f 2f 20 6c 69 6e 65 20 62 75 66 66 65 72 20 69 |// line buffer i|
00001b40 73 20 65 6d 70 74 79 2c 20 73 6f 20 66 69 6c 6c |s empty, so fill|
00001b50 20 69 74 0a 09 20 4c 45 54 20 70 61 72 61 6d 62 | it.. LET paramb|
00001b60 6c 6f 63 6b 20 3d 20 56 45 43 20 31 3b 0a 0a 09 |lock = VEC 1;...|
00001b70 20 53 65 6c 65 63 74 4f 75 74 70 75 74 28 76 64 | SelectOutput(vd|
00001b80 75 73 74 72 65 61 6d 29 3b 0a 09 20 70 61 72 61 |ustream);.. para|
00001b90 6d 62 6c 6f 63 6b 21 30 20 3a 3d 20 28 6c 69 6e |mblock!0 := (lin|
00001ba0 65 62 75 66 66 20 3c 3c 20 32 29 2b 33 3b 0a 09 |ebuff << 2)+3;..|
00001bb0 20 70 61 72 61 6d 62 6c 6f 63 6b 25 34 20 3a 3d | paramblock%4 :=|
00001bc0 20 6c 69 6e 65 62 75 66 66 25 30 3b 0a 09 20 70 | linebuff%0;.. p|
00001bd0 61 72 61 6d 62 6c 6f 63 6b 25 35 20 3a 3d 20 33 |aramblock%5 := 3|
00001be0 32 3b 0a 09 20 70 61 72 61 6d 62 6c 6f 63 6b 25 |2;.. paramblock%|
00001bf0 36 20 3a 3d 20 31 32 36 3b 0a 09 20 6c 69 6e 65 |6 := 126;.. line|
00001c00 62 75 66 66 25 32 20 3a 3d 20 4f 53 57 6f 72 64 |buff%2 := OSWord|
00001c10 28 30 2c 20 70 61 72 61 6d 62 6c 6f 63 6b 29 2b |(0, paramblock)+|
00001c20 31 3b 20 2f 2f 20 52 65 61 64 20 61 20 6c 69 6e |1; // Read a lin|
00001c30 65 0a 09 20 6c 69 6e 65 62 75 66 66 25 31 20 3a |e.. linebuff%1 :|
00001c40 3d 20 30 3b 0a 09 20 49 46 20 72 65 73 75 6c 74 |= 0;.. IF result|
00001c50 32 20 54 48 45 4e 20 7b 0a 09 20 20 20 20 6c 69 |2 THEN {.. li|
00001c60 6e 65 62 75 66 66 25 32 20 3a 3d 20 30 3b 0a 09 |nebuff%2 := 0;..|
00001c70 20 20 20 20 63 69 73 21 73 2e 6c 61 73 74 2e 63 | cis!s.last.c|
00001c80 68 61 72 20 3a 3d 20 27 2a 45 27 3b 0a 09 20 20 |har := '*E';.. |
00001c90 20 20 73 65 6c 65 63 74 6f 75 74 70 75 74 28 6f | selectoutput(o|
00001ca0 6c 64 2e 63 6f 73 29 3b 0a 09 20 20 20 20 52 45 |ld.cos);.. RE|
00001cb0 53 55 4c 54 49 53 20 27 2a 45 27 20 7d 20 7d 3b |SULTIS '*E' } };|
00001cc0 0a 20 20 20 20 20 20 63 68 20 3a 3d 20 6c 69 6e |. ch := lin|
00001cd0 65 62 75 66 66 25 28 6c 69 6e 65 62 75 66 66 25 |ebuff%(linebuff%|
00001ce0 31 2b 33 29 3b 0a 20 20 20 20 20 20 6c 69 6e 65 |1+3);. line|
00001cf0 62 75 66 66 25 31 20 3a 3d 20 6c 69 6e 65 62 75 |buff%1 := linebu|
00001d00 66 66 25 31 2b 31 3b 0a 20 20 20 20 20 20 6c 69 |ff%1+1;. li|
00001d10 6e 65 62 75 66 66 25 32 20 3a 3d 20 6c 69 6e 65 |nebuff%2 := line|
00001d20 62 75 66 66 25 32 2d 31 3b 0a 20 20 20 20 20 20 |buff%2-1;. |
00001d30 49 46 20 63 68 3d 27 2a 43 27 20 54 48 45 4e 20 |IF ch='*C' THEN |
00001d40 63 68 20 3a 3d 20 27 2a 4e 27 3b 0a 20 20 20 20 |ch := '*N';. |
00001d50 20 20 63 69 73 21 73 2e 6c 61 73 74 2e 63 68 61 | cis!s.last.cha|
00001d60 72 20 3a 3d 20 63 68 3b 0a 20 20 20 20 20 20 53 |r := ch;. S|
00001d70 65 6c 65 63 74 4f 75 74 70 75 74 28 6f 6c 64 2e |electOutput(old.|
00001d80 63 6f 73 29 3b 0a 20 20 20 20 20 20 52 45 53 55 |cos);. RESU|
00001d90 4c 54 49 53 20 63 68 20 7d 0a 0a 20 20 20 41 4e |LTIS ch }.. AN|
00001da0 44 20 56 64 75 57 72 69 74 65 72 28 63 68 2c 20 |D VduWriter(ch, |
00001db0 68 61 6e 64 6c 65 2c 20 62 69 6e 61 72 79 29 20 |handle, binary) |
00001dc0 42 45 20 7b 0a 20 20 20 20 20 20 49 46 20 7e 62 |BE {. IF ~b|
00001dd0 69 6e 61 72 79 20 54 48 45 4e 20 7b 0a 09 20 49 |inary THEN {.. I|
00001de0 46 20 63 68 3d 27 2a 4e 27 20 54 48 45 4e 20 4f |F ch='*N' THEN O|
00001df0 53 57 72 43 68 28 27 2a 43 27 29 3b 0a 09 20 49 |SWrCh('*C');.. I|
00001e00 46 20 63 68 3c 27 2a 53 27 20 26 20 28 63 68 7e |F ch<'*S' & (ch~|
00001e10 3d 27 2a 50 27 20 26 20 63 68 7e 3d 27 2a 4e 27 |='*P' & ch~='*N'|
00001e20 20 26 20 63 68 7e 3d 27 2a 43 27 29 20 54 48 45 | & ch~='*C') THE|
00001e30 4e 20 7b 0a 09 20 20 20 20 4f 53 57 72 43 68 28 |N {.. OSWrCh(|
00001e40 27 5e 27 29 3b 20 63 68 20 3a 3d 20 63 68 2b 23 |'^'); ch := ch+#|
00001e50 78 36 30 20 7d 20 7d 3b 0a 20 20 20 20 20 20 4f |x60 } };. O|
00001e60 53 57 72 43 68 28 63 68 29 20 7d 0a 0a 20 20 20 |SWrCh(ch) }.. |
00001e70 41 4e 44 20 56 64 75 41 67 61 69 6e 28 73 74 72 |AND VduAgain(str|
00001e80 65 61 6d 2c 20 64 69 72 65 63 74 69 6f 6e 29 20 |eam, direction) |
00001e90 42 45 20 7b 0a 20 20 20 2f 2a 20 63 61 6c 6c 65 |BE {. /* calle|
00001ea0 64 20 77 68 65 6e 20 74 68 65 20 76 64 75 20 73 |d when the vdu s|
00001eb0 74 72 65 61 6d 20 69 73 20 28 72 65 29 73 65 6c |tream is (re)sel|
00001ec0 65 63 74 65 64 2e 20 4d 61 6b 65 73 20 76 64 75 |ected. Makes vdu|
00001ed0 20 77 6f 72 6b 20 61 67 61 69 6e 20 2a 2f 0a 0a | work again */..|
00001ee0 20 20 20 20 20 20 54 45 53 54 20 64 69 72 65 63 | TEST direc|
00001ef0 74 69 6f 6e 3d 73 2e 69 73 2e 6f 75 74 70 75 74 |tion=s.is.output|
00001f00 2e 62 69 74 20 54 48 45 4e 0a 09 20 4f 53 42 79 |.bit THEN.. OSBy|
00001f10 74 65 28 33 2c 20 23 62 30 30 30 30 30 31 30 30 |te(3, #b00000100|
00001f20 2c 20 30 29 0a 20 20 20 20 20 20 45 4c 53 45 20 |, 0). ELSE |
00001f30 7b 0a 09 20 4c 45 54 20 73 20 3d 20 73 74 72 65 |{.. LET s = stre|
00001f40 61 6d 63 68 61 69 6e 0a 0a 09 20 57 48 49 4c 45 |amchain... WHILE|
00001f50 20 73 7e 3d 30 20 44 4f 20 7b 0a 09 20 20 20 20 | s~=0 DO {.. |
00001f60 49 46 20 28 73 21 73 2e 66 6c 61 67 73 20 26 20 |IF (s!s.flags & |
00001f70 73 2e 65 6e 64 65 64 2e 62 69 74 29 3d 30 20 26 |s.ended.bit)=0 &|
00001f80 0a 09 20 20 20 20 20 20 20 28 73 21 73 2e 66 6c |.. (s!s.fl|
00001f90 61 67 73 20 26 20 73 2e 73 74 72 65 61 6d 2e 74 |ags & s.stream.t|
00001fa0 79 70 65 2e 62 69 74 73 29 3d 73 2e 69 73 2e 73 |ype.bits)=s.is.s|
00001fb0 65 72 69 61 6c 2e 62 69 74 73 20 54 48 45 4e 20 |erial.bits THEN |
00001fc0 7b 0a 09 20 20 20 20 20 20 20 4f 53 42 79 74 65 |{.. OSByte|
00001fd0 28 32 2c 20 32 29 20 2f 2f 20 45 6e 61 62 6c 65 |(2, 2) // Enable|
00001fe0 20 4b 65 79 62 6f 61 72 64 2c 20 6c 65 61 76 65 | Keyboard, leave|
00001ff0 20 52 53 34 32 33 20 65 6e 61 62 6c 65 64 0a 09 | RS423 enabled..|
00002000 20 20 20 20 20 20 20 52 45 54 55 52 4e 20 7d 3b | RETURN };|
00002010 0a 09 20 20 20 20 73 20 3a 3d 20 73 21 73 2e 73 |.. s := s!s.s|
00002020 74 72 65 61 6d 2e 63 68 61 69 6e 20 7d 3b 0a 09 |tream.chain };..|
00002030 20 4f 53 42 79 74 65 28 32 2c 20 30 29 20 7d 20 | OSByte(2, 0) } |
00002040 2f 2f 20 45 6e 61 62 6c 65 20 4b 65 79 62 6f 61 |// Enable Keyboa|
00002050 72 64 2c 20 44 69 73 61 62 6c 65 20 52 53 34 32 |rd, Disable RS42|
00002060 33 0a 20 20 20 7d 3b 0a 0a 20 20 20 76 64 75 73 |3. };.. vdus|
00002070 74 72 65 61 6d 20 3a 3d 20 4d 61 6b 65 4e 65 77 |tream := MakeNew|
00002080 53 74 72 65 61 6d 28 22 56 44 55 3a 22 2c 0a 09 |Stream("VDU:",..|
00002090 09 09 20 20 20 20 20 20 73 2e 69 73 2e 76 64 75 |.. s.is.vdu|
000020a0 2e 62 69 74 73 2c 0a 09 09 09 20 20 20 20 20 20 |.bits,.... |
000020b0 73 2e 6f 70 2e 75 70 64 61 74 65 2c 0a 09 09 09 |s.op.update,....|
000020c0 20 20 20 20 20 20 56 64 75 52 65 61 64 65 72 2c | VduReader,|
000020d0 0a 09 09 09 20 20 20 20 20 20 56 64 75 57 72 69 |.... VduWri|
000020e0 74 65 72 29 0a 20 20 20 76 64 75 73 74 72 65 61 |ter). vdustrea|
000020f0 6d 21 73 2e 65 6e 64 72 65 61 64 65 72 20 3a 3d |m!s.endreader :=|
00002100 20 4e 6f 74 4d 75 63 68 0a 20 20 20 76 64 75 73 | NotMuch. vdus|
00002110 74 72 65 61 6d 21 73 2e 65 6e 64 77 72 69 74 65 |tream!s.endwrite|
00002120 72 20 3a 3d 20 4e 6f 74 4d 75 63 68 0a 20 20 20 |r := NotMuch. |
00002130 76 64 75 73 74 72 65 61 6d 21 73 2e 73 65 6c 65 |vdustream!s.sele|
00002140 63 74 65 72 20 3a 3d 20 56 64 75 41 67 61 69 6e |cter := VduAgain|
00002150 0a 20 20 20 65 72 72 6f 72 73 74 72 65 61 6d 20 |. errorstream |
00002160 3a 3d 20 4d 61 6b 65 4e 65 77 53 74 72 65 61 6d |:= MakeNewStream|
00002170 28 22 4e 6f 20 73 65 6c 65 63 74 65 64 20 73 74 |("No selected st|
00002180 72 65 61 6d 22 2c 0a 09 09 09 09 30 2c 20 2f 2f |ream",.....0, //|
00002190 20 73 2e 69 73 2e 6e 6f 74 68 69 6e 67 2e 61 74 | s.is.nothing.at|
000021a0 2e 61 6c 6c 2e 62 69 74 73 20 21 21 0a 09 09 09 |.all.bits !!....|
000021b0 09 73 2e 6f 70 2e 75 70 64 61 74 65 2c 0a 09 09 |.s.op.update,...|
000021c0 09 09 45 72 72 6f 72 52 64 2c 0a 09 09 09 09 45 |..ErrorRd,.....E|
000021d0 72 72 6f 72 57 72 29 0a 0a 20 20 20 65 72 72 6f |rrorWr).. erro|
000021e0 72 73 74 72 65 61 6d 21 73 2e 65 6e 64 72 65 61 |rstream!s.endrea|
000021f0 64 65 72 20 3a 3d 20 4e 6f 74 68 69 6e 67 20 20 |der := Nothing |
00002200 2f 2f 20 4d 61 6b 65 20 69 74 20 70 65 72 6d 61 |// Make it perma|
00002210 6e 65 6e 74 0a 20 20 20 65 72 72 6f 72 73 74 72 |nent. errorstr|
00002220 65 61 6d 21 73 2e 65 6e 64 77 72 69 74 65 72 20 |eam!s.endwriter |
00002230 3a 3d 20 4e 6f 74 68 69 6e 67 20 7d 0a 0a 2f 2a |:= Nothing }../*|
00002240 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a |****************|
*
00002270 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 0a 20 2a 09 |************. *.|
00002280 09 09 09 09 09 09 20 20 20 20 20 2a 0a 20 2a 20 |...... *. * |
00002290 54 68 65 20 75 73 65 72 20 69 6e 74 65 72 66 61 |The user interfa|
000022a0 63 65 20 72 6f 75 74 69 6e 65 73 09 09 09 09 20 |ce routines.... |
000022b0 20 20 20 20 2a 0a 20 2a 09 09 09 09 09 09 09 20 | *. *....... |
000022c0 20 20 20 20 2a 0a 20 2a 2a 2a 2a 2a 2a 2a 2a 2a | *. *********|
000022d0 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a |****************|
*
00002300 2a 2a 2a 2a 2f 0a 0a 0a 41 4e 44 20 4c 69 62 72 |****/...AND Libr|
00002310 61 72 79 49 6e 69 74 49 4f 28 29 20 42 45 20 7b |aryInitIO() BE {|
00002320 0a 2f 2a 20 74 6f 20 69 6e 69 74 69 61 6c 69 73 |./* to initialis|
00002330 65 20 74 68 65 20 49 2f 4f 20 73 79 73 74 65 6d |e the I/O system|
00002340 20 2a 2f 0a 20 20 20 49 46 20 6c 69 6e 65 62 75 | */. IF linebu|
00002350 66 66 7e 3d 30 20 54 48 45 4e 20 46 72 65 65 56 |ff~=0 THEN FreeV|
00002360 65 63 28 6c 69 6e 65 62 75 66 66 29 0a 20 20 20 |ec(linebuff). |
00002370 6c 69 6e 65 62 75 66 66 20 3a 3d 20 47 65 74 56 |linebuff := GetV|
00002380 65 63 28 36 33 29 20 2f 2f 20 66 6f 72 20 75 73 |ec(63) // for us|
00002390 65 20 62 79 20 52 64 43 68 0a 20 20 20 6c 69 6e |e by RdCh. lin|
000023a0 65 62 75 66 66 25 30 20 3a 3d 20 36 33 2a 34 2b |ebuff%0 := 63*4+|
000023b0 31 20 20 2f 2f 20 6d 61 78 2e 20 6e 6f 2e 20 6f |1 // max. no. o|
000023c0 66 20 62 79 74 65 73 0a 20 20 20 6c 69 6e 65 62 |f bytes. lineb|
000023d0 75 66 66 25 31 20 3a 3d 20 30 09 20 20 20 2f 2f |uff%1 := 0. //|
000023e0 20 70 6f 69 6e 74 65 72 20 74 6f 20 6e 65 78 74 | pointer to next|
000023f0 20 63 68 61 72 0a 20 20 20 6c 69 6e 65 62 75 66 | char. linebuf|
00002400 66 25 32 20 3a 3d 20 30 09 20 20 20 2f 2f 20 6e |f%2 := 0. // n|
00002410 75 6d 62 65 72 20 6f 66 20 62 79 74 65 73 20 69 |umber of bytes i|
00002420 6e 20 62 75 66 66 65 72 0a 0a 20 20 20 6f 72 69 |n buffer.. ori|
00002430 67 69 6e 61 6c 56 44 55 53 74 61 74 65 20 3a 3d |ginalVDUState :=|
00002440 20 4f 53 42 79 74 65 28 33 2c 20 30 2c 20 30 29 | OSByte(3, 0, 0)|
00002450 3b 0a 20 20 20 4f 53 42 79 74 65 28 33 2c 20 6f |;. OSByte(3, o|
00002460 72 69 67 69 6e 61 6c 56 44 55 53 74 61 74 65 2c |riginalVDUState,|
00002470 20 30 29 3b 0a 0a 20 20 20 4c 69 62 72 61 72 79 | 0);.. Library|
00002480 54 65 72 6d 69 6e 61 74 65 49 4f 28 29 3b 0a 20 |TerminateIO();. |
00002490 20 20 4d 61 6b 65 50 65 72 6d 61 6e 65 6e 74 53 | MakePermanentS|
000024a0 74 72 65 61 6d 73 28 29 0a 20 20 20 63 69 73 20 |treams(). cis |
000024b0 3a 3d 20 76 64 75 73 74 72 65 61 6d 0a 20 20 20 |:= vdustream. |
000024c0 63 6f 73 20 3a 3d 20 76 64 75 73 74 72 65 61 6d |cos := vdustream|
000024d0 20 7d 0a 0a 41 4e 44 20 4c 69 62 72 61 72 79 54 | }..AND LibraryT|
000024e0 65 72 6d 69 6e 61 74 65 49 4f 28 29 20 42 45 20 |erminateIO() BE |
000024f0 7b 0a 20 20 20 57 48 49 4c 45 20 73 74 72 65 61 |{. WHILE strea|
00002500 6d 63 68 61 69 6e 7e 3d 30 20 44 4f 20 7b 0a 20 |mchain~=0 DO {. |
00002510 20 20 20 20 20 4c 45 54 20 73 74 72 65 61 6d 20 | LET stream |
00002520 3d 20 73 74 72 65 61 6d 63 68 61 69 6e 3b 0a 20 |= streamchain;. |
00002530 20 20 20 20 20 73 74 72 65 61 6d 63 68 61 69 6e | streamchain|
00002540 20 3a 3d 20 73 74 72 65 61 6d 63 68 61 69 6e 21 | := streamchain!|
00002550 73 2e 73 74 72 65 61 6d 2e 63 68 61 69 6e 3b 0a |s.stream.chain;.|
00002560 20 20 20 20 20 20 54 45 53 54 20 73 74 72 65 61 | TEST strea|
00002570 6d 21 73 2e 6d 61 67 69 63 3d 73 2e 69 73 2e 61 |m!s.magic=s.is.a|
00002580 2e 73 74 72 65 61 6d 20 54 48 45 4e 0a 09 20 5b |.stream THEN.. [|
00002590 73 74 72 65 61 6d 21 73 2e 65 6e 64 77 72 69 74 |stream!s.endwrit|
000025a0 65 72 5d 28 73 74 72 65 61 6d 29 0a 20 20 20 20 |er](stream). |
000025b0 20 20 45 4c 53 45 0a 09 20 73 74 72 65 61 6d 63 | ELSE.. streamc|
000025c0 68 61 69 6e 20 3a 3d 20 30 20 7d 3b 20 2f 2f 20 |hain := 0 }; // |
000025d0 49 74 20 77 61 73 20 63 6f 72 72 75 70 74 2c 20 |It was corrupt, |
000025e0 47 49 56 45 20 55 50 21 21 0a 20 20 20 4f 53 42 |GIVE UP!!. OSB|
000025f0 79 74 65 28 33 2c 20 6f 72 69 67 69 6e 61 6c 56 |yte(3, originalV|
00002600 44 55 53 74 61 74 65 2c 20 30 29 20 7d 0a 0a 41 |DUState, 0) }..A|
00002610 4e 44 20 53 65 6c 65 63 74 49 6e 70 75 74 28 6e |ND SelectInput(n|
00002620 65 77 2e 73 74 72 65 61 6d 29 20 42 45 20 7b 0a |ew.stream) BE {.|
00002630 2f 2a 20 74 6f 20 63 68 61 6e 67 65 20 74 68 65 |/* to change the|
00002640 20 63 75 72 72 65 6e 74 20 69 6e 70 75 74 20 73 | current input s|
00002650 74 72 65 61 6d 20 2a 2f 0a 20 20 20 4c 45 54 20 |tream */. LET |
00002660 6f 6c 64 2e 73 74 72 65 61 6d 20 3d 20 63 69 73 |old.stream = cis|
00002670 0a 0a 20 20 20 49 46 20 6e 65 77 2e 73 74 72 65 |.. IF new.stre|
00002680 61 6d 3d 30 20 54 48 45 4e 0a 20 20 20 20 20 20 |am=0 THEN. |
00002690 6e 65 77 2e 73 74 72 65 61 6d 20 3a 3d 20 65 72 |new.stream := er|
000026a0 72 6f 72 73 74 72 65 61 6d 20 20 2f 2f 20 54 68 |rorstream // Th|
000026b0 65 20 6d 61 6e 75 61 6c 20 73 61 79 73 20 64 65 |e manual says de|
000026c0 6c 61 79 20 74 68 65 20 65 72 72 6f 72 20 6d 65 |lay the error me|
000026d0 73 73 61 67 65 0a 20 20 20 49 46 20 6e 65 77 2e |ssage. IF new.|
000026e0 73 74 72 65 61 6d 21 73 2e 6d 61 67 69 63 7e 3d |stream!s.magic~=|
000026f0 73 2e 69 73 2e 61 2e 73 74 72 65 61 6d 20 44 4f |s.is.a.stream DO|
00002700 0a 20 20 20 20 20 20 46 61 75 6c 74 28 22 42 61 |. Fault("Ba|
00002710 64 20 69 6e 70 75 74 20 73 74 72 65 61 6d 22 2c |d input stream",|
00002720 20 65 2e 62 61 64 2e 69 6e 70 75 74 2e 73 74 72 | e.bad.input.str|
00002730 65 61 6d 29 0a 20 20 20 49 46 20 28 6e 65 77 2e |eam). IF (new.|
00002740 73 74 72 65 61 6d 21 73 2e 66 6c 61 67 73 20 26 |stream!s.flags &|
00002750 20 73 2e 65 6e 64 65 64 2e 62 69 74 29 7e 3d 30 | s.ended.bit)~=0|
00002760 20 54 48 45 4e 0a 20 20 20 20 20 20 46 61 75 6c | THEN. Faul|
00002770 74 28 22 53 74 72 65 61 6d 20 2a 22 25 53 2a 22 |t("Stream *"%S*"|
00002780 20 68 61 73 20 62 65 65 6e 20 65 6e 64 65 64 22 | has been ended"|
00002790 2c 20 65 2e 68 61 73 2e 62 65 65 6e 2e 65 6e 64 |, e.has.been.end|
000027a0 65 64 2c 0a 09 09 09 09 40 28 6e 65 77 2e 73 74 |ed,.....@(new.st|
000027b0 72 65 61 6d 21 73 2e 6e 61 6d 65 29 29 0a 20 20 |ream!s.name)). |
000027c0 20 28 6e 65 77 2e 73 74 72 65 61 6d 21 73 2e 73 | (new.stream!s.s|
000027d0 65 6c 65 63 74 65 72 29 28 6e 65 77 2e 73 74 72 |electer)(new.str|
000027e0 65 61 6d 2c 20 73 2e 69 73 2e 69 6e 70 75 74 2e |eam, s.is.input.|
000027f0 62 69 74 29 0a 20 20 20 63 69 73 20 3a 3d 20 6e |bit). cis := n|
00002800 65 77 2e 73 74 72 65 61 6d 20 7d 0a 0a 0a 41 4e |ew.stream }...AN|
00002810 44 20 53 65 6c 65 63 74 4f 75 74 70 75 74 28 6e |D SelectOutput(n|
00002820 65 77 2e 73 74 72 65 61 6d 29 20 42 45 20 7b 0a |ew.stream) BE {.|
00002830 2f 2a 20 74 6f 20 63 68 61 6e 67 65 20 74 68 65 |/* to change the|
00002840 20 63 75 72 72 65 6e 74 20 6f 75 74 70 75 74 20 | current output |
00002850 73 74 72 65 61 6d 20 2a 2f 0a 20 20 20 4c 45 54 |stream */. LET|
00002860 20 6f 6c 64 2e 73 74 72 65 61 6d 20 3d 20 63 6f | old.stream = co|
00002870 73 0a 0a 20 20 20 49 46 20 6e 65 77 2e 73 74 72 |s.. IF new.str|
00002880 65 61 6d 3d 30 20 54 48 45 4e 0a 20 20 20 20 20 |eam=0 THEN. |
00002890 20 6e 65 77 2e 73 74 72 65 61 6d 20 3a 3d 20 65 | new.stream := e|
000028a0 72 72 6f 72 73 74 72 65 61 6d 20 20 2f 2f 20 54 |rrorstream // T|
000028b0 68 65 20 6d 61 6e 75 61 6c 20 73 61 79 73 20 64 |he manual says d|
000028c0 65 6c 61 79 20 74 68 65 20 65 72 72 6f 72 20 6d |elay the error m|
000028d0 65 73 73 61 67 65 0a 20 20 20 49 46 20 6e 65 77 |essage. IF new|
000028e0 2e 73 74 72 65 61 6d 21 73 2e 6d 61 67 69 63 7e |.stream!s.magic~|
000028f0 3d 73 2e 69 73 2e 61 2e 73 74 72 65 61 6d 20 44 |=s.is.a.stream D|
00002900 4f 0a 20 20 20 20 20 20 46 61 75 6c 74 28 22 42 |O. Fault("B|
00002910 61 64 20 6f 75 74 70 75 74 20 73 74 72 65 61 6d |ad output stream|
00002920 22 2c 20 65 2e 62 61 64 2e 6f 75 74 70 75 74 2e |", e.bad.output.|
00002930 73 74 72 65 61 6d 29 0a 20 20 20 49 46 20 28 6e |stream). IF (n|
00002940 65 77 2e 73 74 72 65 61 6d 21 73 2e 66 6c 61 67 |ew.stream!s.flag|
00002950 73 20 26 20 73 2e 65 6e 64 65 64 2e 62 69 74 29 |s & s.ended.bit)|
00002960 7e 3d 30 20 54 48 45 4e 0a 20 20 20 20 20 20 46 |~=0 THEN. F|
00002970 61 75 6c 74 28 22 53 74 72 65 61 6d 20 2a 22 25 |ault("Stream *"%|
00002980 53 2a 22 20 68 61 73 20 62 65 65 6e 20 65 6e 64 |S*" has been end|
00002990 65 64 22 2c 20 65 2e 68 61 73 2e 62 65 65 6e 2e |ed", e.has.been.|
000029a0 65 6e 64 65 64 2c 0a 09 09 09 09 40 28 6e 65 77 |ended,.....@(new|
000029b0 2e 73 74 72 65 61 6d 21 73 2e 6e 61 6d 65 29 29 |.stream!s.name))|
000029c0 0a 20 20 20 28 6e 65 77 2e 73 74 72 65 61 6d 21 |. (new.stream!|
000029d0 73 2e 73 65 6c 65 63 74 65 72 29 28 6e 65 77 2e |s.selecter)(new.|
000029e0 73 74 72 65 61 6d 2c 20 73 2e 69 73 2e 6f 75 74 |stream, s.is.out|
000029f0 70 75 74 2e 62 69 74 29 0a 20 20 20 63 6f 73 20 |put.bit). cos |
00002a00 3a 3d 20 6e 65 77 2e 73 74 72 65 61 6d 20 7d 0a |:= new.stream }.|
00002a10 0a 41 4e 44 20 46 69 6e 64 49 6e 70 75 74 28 6e |.AND FindInput(n|
00002a20 61 6d 65 29 20 3d 20 46 69 6e 64 53 74 72 65 61 |ame) = FindStrea|
00002a30 6d 28 73 2e 6f 70 2e 69 6e 70 75 74 2c 20 6e 61 |m(s.op.input, na|
00002a40 6d 65 29 0a 0a 41 4e 44 20 46 69 6e 64 4f 75 74 |me)..AND FindOut|
00002a50 70 75 74 28 6e 61 6d 65 29 20 3d 20 46 69 6e 64 |put(name) = Find|
00002a60 53 74 72 65 61 6d 28 73 2e 6f 70 2e 6f 75 74 70 |Stream(s.op.outp|
00002a70 75 74 2c 20 6e 61 6d 65 29 0a 0a 41 4e 44 20 52 |ut, name)..AND R|
00002a80 64 43 68 28 29 20 3d 20 56 41 4c 4f 46 20 7b 0a |dCh() = VALOF {.|
00002a90 2f 2a 20 74 6f 20 72 65 61 64 20 61 6e 20 41 53 |/* to read an AS|
00002aa0 43 49 49 20 63 68 61 72 61 63 74 65 72 20 66 72 |CII character fr|
00002ab0 6f 6d 20 74 68 65 20 63 75 72 72 65 6e 74 20 69 |om the current i|
00002ac0 6e 70 75 74 20 73 74 72 65 61 6d 20 2a 2f 0a 20 |nput stream */. |
00002ad0 20 20 4c 45 54 20 63 68 20 3d 20 28 63 69 73 21 | LET ch = (cis!|
00002ae0 73 2e 72 65 61 64 65 72 29 28 63 69 73 21 73 2e |s.reader)(cis!s.|
00002af0 63 68 61 6e 6e 65 6c 29 0a 20 20 20 49 46 20 30 |channel). IF 0|
00002b00 3c 3d 63 68 3c 45 6e 64 53 74 72 65 61 6d 43 68 |<=ch<EndStreamCh|
00002b10 20 54 48 45 4e 20 7b 0a 20 20 20 20 20 20 63 69 | THEN {. ci|
00002b20 73 21 73 2e 6c 61 73 74 2e 63 68 61 72 20 3a 3d |s!s.last.char :=|
00002b30 20 63 68 20 20 2f 2f 20 54 68 65 20 67 72 6f 74 | ch // The grot|
00002b40 74 79 20 55 6e 52 64 43 68 28 29 20 6e 65 65 64 |ty UnRdCh() need|
00002b50 73 20 74 68 69 73 0a 20 20 20 20 20 20 52 45 53 |s this. RES|
00002b60 55 4c 54 49 53 20 63 68 20 7d 0a 0a 20 20 20 49 |ULTIS ch }.. I|
00002b70 46 20 63 68 3d 45 6e 64 53 74 72 65 61 6d 43 68 |F ch=EndStreamCh|
00002b80 20 54 48 45 4e 20 7b 0a 20 20 20 20 20 20 63 69 | THEN {. ci|
00002b90 73 21 73 2e 6c 61 73 74 2e 63 68 61 72 20 3a 3d |s!s.last.char :=|
00002ba0 20 63 68 0a 20 20 20 20 20 20 63 69 73 21 73 2e | ch. cis!s.|
00002bb0 72 65 61 64 65 72 20 3a 3d 20 4e 75 6c 6c 52 65 |reader := NullRe|
00002bc0 61 64 65 72 0a 20 20 20 20 20 20 52 45 53 55 4c |ader. RESUL|
00002bd0 54 49 53 20 45 6e 64 53 74 72 65 61 6d 43 68 20 |TIS EndStreamCh |
00002be0 7d 3b 0a 20 20 20 28 63 69 73 21 73 2e 65 72 72 |};. (cis!s.err|
00002bf0 6f 72 2e 68 61 6e 64 6c 65 72 29 28 63 69 73 2c |or.handler)(cis,|
00002c00 20 63 68 29 0a 20 20 20 63 69 73 21 73 2e 6c 61 | ch). cis!s.la|
00002c10 73 74 2e 63 68 61 72 20 3a 3d 20 63 68 0a 20 20 |st.char := ch. |
00002c20 20 52 45 53 55 4c 54 49 53 20 63 68 20 7d 0a 0a | RESULTIS ch }..|
00002c30 41 4e 44 20 52 64 42 69 6e 28 29 20 3d 20 52 64 |AND RdBin() = Rd|
00002c40 43 68 28 29 0a 0a 41 4e 44 20 57 72 43 68 28 63 |Ch()..AND WrCh(c|
00002c50 68 29 20 42 45 20 7b 0a 2f 2a 20 74 6f 20 77 72 |h) BE {./* to wr|
00002c60 69 74 65 20 61 6e 20 63 68 61 72 61 63 74 65 72 |ite an character|
00002c70 20 74 6f 20 74 68 65 20 63 75 72 72 65 6e 74 20 | to the current |
00002c80 6f 75 74 70 75 74 20 73 74 72 65 61 6d 20 2a 2f |output stream */|
00002c90 0a 20 20 20 4c 45 54 20 65 72 72 6f 72 2e 63 6f |. LET error.co|
00002ca0 64 65 20 3d 20 28 63 6f 73 21 73 2e 77 72 69 74 |de = (cos!s.writ|
00002cb0 65 72 29 28 63 68 2c 20 63 6f 73 21 73 2e 63 68 |er)(ch, cos!s.ch|
00002cc0 61 6e 6e 65 6c 2c 20 46 41 4c 53 45 29 0a 20 20 |annel, FALSE). |
00002cd0 20 49 46 20 65 72 72 6f 72 2e 63 6f 64 65 3c 30 | IF error.code<0|
00002ce0 20 54 48 45 4e 20 28 63 6f 73 21 73 2e 65 72 72 | THEN (cos!s.err|
00002cf0 6f 72 2e 68 61 6e 64 6c 65 72 29 28 63 6f 73 2c |or.handler)(cos,|
00002d00 20 65 72 72 6f 72 2e 63 6f 64 65 29 20 7d 0a 0a | error.code) }..|
00002d10 41 4e 44 20 57 72 42 69 6e 28 62 79 74 65 29 20 |AND WrBin(byte) |
00002d20 42 45 20 7b 0a 2f 2a 20 74 6f 20 77 72 69 74 65 |BE {./* to write|
00002d30 20 61 6e 20 63 68 61 72 61 63 74 65 72 20 74 6f | an character to|
00002d40 20 74 68 65 20 63 75 72 72 65 6e 74 20 6f 75 74 | the current out|
00002d50 70 75 74 20 73 74 72 65 61 6d 20 2a 2f 0a 20 20 |put stream */. |
00002d60 20 4c 45 54 20 65 72 72 6f 72 2e 63 6f 64 65 20 | LET error.code |
00002d70 3d 20 28 63 6f 73 21 73 2e 77 72 69 74 65 72 29 |= (cos!s.writer)|
00002d80 28 62 79 74 65 2c 20 63 6f 73 21 73 2e 63 68 61 |(byte, cos!s.cha|
00002d90 6e 6e 65 6c 2c 20 54 52 55 45 29 0a 20 20 20 49 |nnel, TRUE). I|
00002da0 46 20 65 72 72 6f 72 2e 63 6f 64 65 3c 30 20 54 |F error.code<0 T|
00002db0 48 45 4e 20 28 63 6f 73 21 73 2e 65 72 72 6f 72 |HEN (cos!s.error|
00002dc0 2e 68 61 6e 64 6c 65 72 29 28 63 6f 73 2c 20 65 |.handler)(cos, e|
00002dd0 72 72 6f 72 2e 63 6f 64 65 29 20 7d 0a 0a 41 4e |rror.code) }..AN|
00002de0 44 20 45 6e 64 52 65 61 64 28 29 20 3d 20 56 41 |D EndRead() = VA|
00002df0 4c 4f 46 20 7b 20 28 63 69 73 21 73 2e 65 6e 64 |LOF { (cis!s.end|
00002e00 72 65 61 64 65 72 29 28 63 69 73 29 3b 20 52 45 |reader)(cis); RE|
00002e10 53 55 4c 54 49 53 20 54 52 55 45 20 7d 0a 0a 41 |SULTIS TRUE }..A|
00002e20 4e 44 20 45 6e 64 57 72 69 74 65 28 29 20 3d 20 |ND EndWrite() = |
00002e30 56 41 4c 4f 46 20 7b 20 28 63 6f 73 21 73 2e 65 |VALOF { (cos!s.e|
00002e40 6e 64 77 72 69 74 65 72 29 28 63 6f 73 29 3b 20 |ndwriter)(cos); |
00002e50 52 45 53 55 4c 54 49 53 20 54 52 55 45 20 7d 0a |RESULTIS TRUE }.|
00002e60 0a 41 4e 44 20 55 6e 52 64 43 68 28 29 20 42 45 |.AND UnRdCh() BE|
00002e70 20 7b 0a 2f 2a 20 61 20 76 65 72 79 20 73 69 6c | {./* a very sil|
00002e80 6c 79 20 77 61 79 20 74 6f 20 64 6f 20 70 75 74 |ly way to do put|
00002e90 62 61 63 6b 28 29 0a 20 2a 20 55 6e 52 64 43 68 |back(). * UnRdCh|
00002ea0 28 29 20 6d 61 6b 65 73 20 74 68 65 20 6e 65 78 |() makes the nex|
00002eb0 74 20 63 68 61 72 63 74 65 72 20 72 65 61 64 20 |t charcter read |
00002ec0 62 79 20 52 64 43 68 28 29 20 74 68 65 20 73 61 |by RdCh() the sa|
00002ed0 6d 65 20 61 73 20 74 68 65 20 6c 61 73 74 20 6f |me as the last o|
00002ee0 6e 65 2e 0a 20 2a 2f 0a 20 20 20 28 63 69 73 21 |ne.. */. (cis!|
00002ef0 73 2e 75 6e 72 65 61 64 65 72 29 28 63 69 73 29 |s.unreader)(cis)|
00002f00 20 7d 0a 0a 41 4e 44 20 52 65 61 64 4f 66 66 73 | }..AND ReadOffs|
00002f10 65 74 28 73 74 72 65 61 6d 2c 20 76 65 63 74 6f |et(stream, vecto|
00002f20 72 29 20 42 45 20 7b 0a 20 20 20 43 68 65 63 6b |r) BE {. Check|
00002f30 46 69 6c 65 28 73 74 72 65 61 6d 2c 20 22 52 65 |File(stream, "Re|
00002f40 61 64 2e 4f 66 66 73 65 74 22 29 3b 0a 20 20 20 |ad.Offset");. |
00002f50 4f 53 41 72 67 73 28 30 2c 20 73 74 72 65 61 6d |OSArgs(0, stream|
00002f60 21 73 2e 63 68 61 6e 6e 65 6c 2c 20 30 29 3b 0a |!s.channel, 0);.|
00002f70 20 20 20 76 65 63 74 6f 72 21 30 20 3a 3d 20 72 | vector!0 := r|
00002f80 65 73 75 6c 74 32 20 7d 0a 0a 41 4e 44 20 53 65 |esult2 }..AND Se|
00002f90 74 4f 66 66 73 65 74 28 73 74 72 65 61 6d 2c 20 |tOffset(stream, |
00002fa0 76 65 63 74 6f 72 29 20 42 45 20 7b 0a 20 20 20 |vector) BE {. |
00002fb0 43 68 65 63 6b 46 69 6c 65 28 73 74 72 65 61 6d |CheckFile(stream|
00002fc0 2c 20 22 53 65 74 2e 4f 66 66 73 65 74 22 29 3b |, "Set.Offset");|
00002fd0 0a 20 20 20 4f 53 41 72 67 73 28 31 2c 20 73 74 |. OSArgs(1, st|
00002fe0 72 65 61 6d 21 73 2e 63 68 61 6e 6e 65 6c 2c 20 |ream!s.channel, |
00002ff0 76 65 63 74 6f 72 21 30 29 20 7d 0a 0a 41 4e 44 |vector!0) }..AND|
00003000 20 45 78 74 65 6e 74 28 73 74 72 65 61 6d 29 20 | Extent(stream) |
00003010 3d 20 56 41 4c 4f 46 20 7b 0a 20 20 20 43 68 65 |= VALOF {. Che|
00003020 63 6b 46 69 6c 65 28 73 74 72 65 61 6d 2c 20 22 |ckFile(stream, "|
00003030 45 78 74 65 6e 74 22 29 3b 0a 20 20 20 4f 53 41 |Extent");. OSA|
00003040 72 67 73 28 32 2c 20 73 74 72 65 61 6d 21 73 2e |rgs(2, stream!s.|
00003050 63 68 61 6e 6e 65 6c 2c 20 30 29 3b 0a 20 20 20 |channel, 0);. |
00003060 52 45 53 55 4c 54 49 53 20 72 65 73 75 6c 74 32 |RESULTIS result2|
00003070 20 7d 0a 0a 41 4e 44 20 43 68 65 63 6b 46 69 6c | }..AND CheckFil|
00003080 65 28 73 74 72 65 61 6d 2c 20 63 61 6c 6c 65 72 |e(stream, caller|
00003090 29 20 42 45 20 7b 0a 20 20 20 4c 45 54 20 66 6c |) BE {. LET fl|
000030a0 61 67 73 20 3d 20 73 74 72 65 61 6d 21 73 2e 66 |ags = stream!s.f|
000030b0 6c 61 67 73 3b 0a 20 20 20 49 46 20 28 66 6c 61 |lags;. IF (fla|
000030c0 67 73 26 73 2e 68 61 73 2e 63 68 61 6e 6e 65 6c |gs&s.has.channel|
000030d0 2e 62 69 74 29 3d 30 20 7c 20 28 66 6c 61 67 73 |.bit)=0 | (flags|
000030e0 26 73 2e 69 73 2e 66 69 6c 65 2e 62 69 74 73 29 |&s.is.file.bits)|
000030f0 3d 30 0a 20 20 20 20 20 20 54 48 45 4e 20 46 61 |=0. THEN Fa|
00003100 75 6c 74 28 22 53 74 72 65 61 6d 20 66 6f 72 20 |ult("Stream for |
00003110 25 73 20 73 68 6f 75 6c 64 20 62 65 20 61 20 66 |%s should be a f|
00003120 69 6c 65 22 2c 20 37 30 39 2c 20 63 61 6c 6c 65 |ile", 709, calle|
00003130 72 29 20 7d 0a 0a 41 4e 44 20 4d 61 78 56 65 63 |r) }..AND MaxVec|
00003140 28 29 20 3d 20 56 41 4c 4f 46 20 7b 0a 20 20 20 |() = VALOF {. |
00003150 4c 45 54 20 62 69 67 67 65 73 74 2c 20 70 20 3d |LET biggest, p =|
00003160 20 30 2c 20 3f 0a 0a 20 20 20 47 65 74 56 65 63 | 0, ?.. GetVec|
00003170 28 6d 61 78 69 6e 74 2f 42 79 74 65 73 50 65 72 |(maxint/BytesPer|
00003180 57 6f 72 64 29 09 2f 2f 20 43 6f 6d 70 61 63 74 |Word).// Compact|
00003190 20 66 72 65 65 20 6d 65 6d 6f 72 79 0a 0a 20 20 | free memory.. |
000031a0 20 70 20 3a 3d 20 62 6c 6f 63 6b 4c 69 73 74 3b | p := blockList;|
000031b0 0a 20 20 20 57 48 49 4c 45 20 21 70 7e 3d 30 20 |. WHILE !p~=0 |
000031c0 44 4f 20 7b 0a 20 20 20 20 20 20 4c 45 54 20 71 |DO {. LET q|
000031d0 3d 21 70 3b 0a 20 20 20 20 20 20 54 45 53 54 20 |=!p;. TEST |
000031e0 71 3e 3d 30 0a 09 20 54 48 45 4e 20 2f 2f 20 62 |q>=0.. THEN // b|
000031f0 6c 6f 63 6b 20 69 73 20 66 72 65 65 0a 09 20 20 |lock is free.. |
00003200 20 20 20 20 49 46 20 71 3e 62 69 67 67 65 73 74 | IF q>biggest|
00003210 20 54 48 45 4e 20 62 69 67 67 65 73 74 20 3a 3d | THEN biggest :=|
00003220 20 71 0a 09 20 45 4c 53 45 20 71 20 3a 3d 20 2d | q.. ELSE q := -|
00003230 71 3b 0a 20 20 20 20 20 20 70 20 3a 3d 20 70 2b |q;. p := p+|
00003240 71 20 7d 3b 0a 20 20 20 52 45 53 55 4c 54 49 53 |q };. RESULTIS|
00003250 20 62 69 67 67 65 73 74 2d 32 20 7d 0a 0a 41 4e | biggest-2 }..AN|
00003260 44 20 74 69 6d 65 28 29 20 3d 20 56 41 4c 4f 46 |D time() = VALOF|
00003270 20 7b 0a 20 20 20 4c 45 54 20 76 20 3d 20 56 45 | {. LET v = VE|
00003280 43 20 34 3b 0a 20 20 20 4f 53 57 6f 72 64 28 33 |C 4;. OSWord(3|
00003290 2c 20 76 29 3b 0a 20 20 20 52 45 53 55 4c 54 49 |, v);. RESULTI|
000032a0 53 20 76 21 30 20 7d 0a 0a 0a 41 4e 44 20 44 61 |S v!0 }...AND Da|
000032b0 74 65 28 29 20 3d 20 56 41 4c 4f 46 20 7b 0a 20 |te() = VALOF {. |
000032c0 20 20 4c 45 54 20 65 78 20 3d 20 56 45 43 20 31 | LET ex = VEC 1|
000032d0 3b 0a 20 20 20 4c 45 54 20 76 20 3d 20 54 41 42 |;. LET v = TAB|
000032e0 4c 45 20 30 2c 20 30 2c 20 30 3b 0a 20 20 20 45 |LE 0, 0, 0;. E|
000032f0 78 70 6c 6f 64 65 43 75 72 72 65 6e 74 54 69 6d |xplodeCurrentTim|
00003300 65 28 65 78 29 3b 0a 20 20 20 49 46 20 65 78 25 |e(ex);. IF ex%|
00003310 30 3d 30 20 54 48 45 4e 20 52 45 53 55 4c 54 49 |0=0 THEN RESULTI|
00003320 53 20 22 3c 75 6e 73 65 74 3e 22 3b 0a 20 20 20 |S "<unset>";. |
00003330 76 21 32 20 3a 3d 20 30 3b 0a 20 20 20 50 6c 61 |v!2 := 0;. Pla|
00003340 6e 74 28 76 2c 20 30 2c 20 39 2c 20 65 78 25 32 |nt(v, 0, 9, ex%2|
00003350 29 3b 0a 20 20 20 76 25 33 20 3a 3d 20 27 2d 27 |);. v%3 := '-'|
00003360 0a 20 20 20 7b 20 20 4c 45 54 20 6d 20 3d 20 28 |. { LET m = (|
00003370 65 78 25 31 29 2d 31 3b 0a 20 20 20 20 20 20 46 |ex%1)-1;. F|
00003380 4f 52 20 69 20 3d 20 31 20 54 4f 20 33 20 44 4f |OR i = 1 TO 3 DO|
00003390 0a 09 20 76 25 28 69 2b 33 29 20 3a 3d 20 22 4a |.. v%(i+3) := "J|
000033a0 61 6e 46 65 62 4d 61 72 41 70 72 4d 61 79 4a 75 |anFebMarAprMayJu|
000033b0 6e 4a 75 6c 41 75 67 53 65 70 4f 63 74 4e 6f 76 |nJulAugSepOctNov|
000033c0 44 65 63 22 25 28 33 2a 6d 2b 69 29 20 7d 3b 0a |Dec"%(3*m+i) };.|
000033d0 20 20 20 50 6c 61 6e 74 28 76 2c 20 37 2c 20 27 | Plant(v, 7, '|
000033e0 2d 27 2c 20 65 78 25 30 29 3b 0a 20 20 20 52 45 |-', ex%0);. RE|
000033f0 53 55 4c 54 49 53 20 76 20 7d 0a 0a 41 4e 44 20 |SULTIS v }..AND |
00003400 54 69 6d 65 4f 66 44 61 79 28 29 20 3d 20 56 41 |TimeOfDay() = VA|
00003410 4c 4f 46 20 7b 0a 20 20 20 4c 45 54 20 65 78 20 |LOF {. LET ex |
00003420 3d 20 56 45 43 20 31 3b 0a 20 20 20 4c 45 54 20 |= VEC 1;. LET |
00003430 76 20 3d 20 54 41 42 4c 45 20 30 2c 20 30 2c 20 |v = TABLE 0, 0, |
00003440 30 3b 0a 20 20 20 45 78 70 6c 6f 64 65 43 75 72 |0;. ExplodeCur|
00003450 72 65 6e 74 54 69 6d 65 28 65 78 29 3b 0a 20 20 |rentTime(ex);. |
00003460 20 49 46 20 65 78 25 30 3d 30 20 54 48 45 4e 20 | IF ex%0=0 THEN |
00003470 52 45 53 55 4c 54 49 53 20 22 3c 75 6e 73 65 74 |RESULTIS "<unset|
00003480 3e 22 3b 0a 20 20 20 76 21 32 20 3a 3d 20 30 3b |>";. v!2 := 0;|
00003490 0a 20 20 20 50 6c 61 6e 74 28 76 2c 20 30 2c 20 |. Plant(v, 0, |
000034a0 38 2c 20 65 78 25 33 29 3b 0a 20 20 20 50 6c 61 |8, ex%3);. Pla|
000034b0 6e 74 28 76 2c 20 33 2c 20 27 3a 27 2c 20 65 78 |nt(v, 3, ':', ex|
000034c0 25 34 29 3b 0a 20 20 20 50 6c 61 6e 74 28 76 2c |%4);. Plant(v,|
000034d0 20 36 2c 20 27 3a 27 2c 20 65 78 25 35 29 3b 0a | 6, ':', ex%5);.|
000034e0 20 20 20 52 45 53 55 4c 54 49 53 20 76 20 7d 0a | RESULTIS v }.|
000034f0 0a 41 4e 44 20 50 6c 61 6e 74 28 76 2c 20 62 2c |.AND Plant(v, b,|
00003500 20 63 2c 20 6e 29 20 42 45 20 7b 0a 20 20 20 76 | c, n) BE {. v|
00003510 25 62 09 20 20 20 3a 3d 20 63 0a 20 20 20 76 25 |%b. := c. v%|
00003520 28 62 2b 31 29 20 3a 3d 20 27 30 27 20 2b 20 28 |(b+1) := '0' + (|
00003530 6e 2f 31 30 29 0a 20 20 20 76 25 28 62 2b 32 29 |n/10). v%(b+2)|
00003540 20 3a 3d 20 27 30 27 20 2b 20 28 6e 20 52 45 4d | := '0' + (n REM|
00003550 20 31 30 29 20 7d 0a 0a 41 4e 44 20 45 78 70 6c | 10) }..AND Expl|
00003560 6f 64 65 43 75 72 72 65 6e 74 54 69 6d 65 28 65 |odeCurrentTime(e|
00003570 78 29 20 42 45 20 7b 0a 20 20 20 4c 45 54 20 76 |x) BE {. LET v|
00003580 31 20 3d 20 56 45 43 20 34 3b 0a 20 20 20 42 69 |1 = VEC 4;. Bi|
00003590 6e 61 72 79 54 69 6d 65 28 76 31 29 3b 0a 20 20 |naryTime(v1);. |
000035a0 20 45 78 70 6c 6f 64 65 42 69 6e 61 72 79 54 69 | ExplodeBinaryTi|
000035b0 6d 65 28 76 31 2c 20 65 78 29 20 7d 0a 0a 41 4e |me(v1, ex) }..AN|
000035c0 44 20 42 69 6e 61 72 79 54 69 6d 65 28 76 29 20 |D BinaryTime(v) |
000035d0 42 45 0a 20 20 20 54 45 53 54 20 28 68 6f 73 74 |BE. TEST (host|
000035e0 50 72 6f 63 65 73 73 6f 72 3e 3e 32 34 29 3d 36 |Processor>>24)=6|
000035f0 20 54 48 45 4e 20 7b 0a 20 20 20 2f 2f 20 49 73 | THEN {. // Is|
00003600 20 74 68 69 73 20 61 6e 20 41 72 74 68 75 72 3f | this an Arthur?|
00003610 20 20 49 66 20 73 6f 2c 20 67 65 74 20 74 68 65 | If so, get the|
00003620 20 74 69 6d 65 20 66 72 6f 6d 20 69 74 73 20 43 | time from its C|
00003630 4d 4f 53 20 63 6c 6f 63 6b 0a 20 20 20 20 20 20 |MOS clock. |
00003640 76 25 30 20 3a 3d 20 33 3b 0a 20 20 20 20 20 20 |v%0 := 3;. |
00003650 4f 53 57 6f 72 64 28 31 34 2c 20 76 29 20 7d 0a |OSWord(14, v) }.|
00003660 20 20 20 45 4c 53 45 20 7b 0a 20 20 20 2f 2f 20 | ELSE {. // |
00003670 52 65 61 64 20 73 79 73 74 65 6d 20 74 69 6d 65 |Read system time|
00003680 72 20 69 6e 20 74 68 65 20 42 42 43 2e 20 20 54 |r in the BBC. T|
00003690 68 65 72 65 20 69 73 20 6f 66 20 63 6f 75 72 73 |here is of cours|
000036a0 65 20 73 63 6f 70 65 20 68 65 72 65 20 66 6f 72 |e scope here for|
000036b0 0a 20 20 20 2f 2f 20 72 65 61 64 69 6e 67 20 74 |. // reading t|
000036c0 68 65 20 43 4d 4f 53 20 63 6c 6f 63 6b 20 69 6e |he CMOS clock in|
000036d0 20 61 20 6d 61 73 74 65 72 0a 20 20 20 20 20 20 | a master. |
000036e0 4f 53 57 6f 72 64 28 31 2c 20 76 29 20 7d 0a 0a |OSWord(1, v) }..|
000036f0 41 4e 44 20 45 78 70 6c 6f 64 65 42 69 6e 61 72 |AND ExplodeBinar|
00003700 79 54 69 6d 65 28 76 2c 20 72 65 73 29 20 42 45 |yTime(v, res) BE|
00003710 20 7b 0a 20 20 20 4c 45 54 20 73 32 20 3d 20 76 | {. LET s2 = v|
00003720 21 30 3b 0a 20 20 20 4c 45 54 20 79 65 61 72 73 |!0;. LET years|
00003730 2c 20 6d 6f 6e 74 68 73 2c 20 64 61 79 73 2c 20 |, months, days, |
00003740 68 6f 75 72 73 2c 20 6d 69 6e 73 2c 20 73 65 63 |hours, mins, sec|
00003750 73 2c 20 74 69 63 6b 73 2c 20 6c 65 61 70 20 3d |s, ticks, leap =|
00003760 0a 20 20 20 20 20 20 20 3f 2c 20 3f 2c 20 3f 2c |. ?, ?, ?,|
00003770 20 3f 2c 20 3f 2c 20 3f 2c 20 3f 2c 20 3f 0a 0a | ?, ?, ?, ?, ?..|
00003780 20 20 20 74 69 63 6b 73 20 3a 3d 20 28 73 32 3e | ticks := (s2>|
00003790 3e 38 29 20 7c 20 28 28 76 25 34 29 3c 3c 32 34 |>8) | ((v%4)<<24|
000037a0 29 20 2f 2f 20 48 69 67 68 20 6f 72 64 65 72 20 |) // High order |
000037b0 33 32 20 62 69 74 73 0a 20 20 20 64 61 79 73 20 |32 bits. days |
000037c0 3a 3d 20 74 69 63 6b 73 20 2f 20 33 33 37 35 30 |:= ticks / 33750|
000037d0 0a 20 20 20 74 69 63 6b 73 20 3a 3d 20 28 28 74 |. ticks := ((t|
000037e0 69 63 6b 73 20 52 45 4d 20 33 33 37 35 30 29 3c |icks REM 33750)<|
000037f0 3c 38 29 20 7c 20 28 73 32 26 32 35 35 29 0a 0a |<8) | (s2&255)..|
00003800 20 20 20 68 6f 75 72 73 20 3a 3d 20 74 69 63 6b | hours := tick|
00003810 73 20 2f 20 33 36 30 30 30 30 3b 20 20 20 74 69 |s / 360000; ti|
00003820 63 6b 73 20 3a 3d 20 74 69 63 6b 73 20 2d 20 33 |cks := ticks - 3|
00003830 36 30 30 30 30 2a 68 6f 75 72 73 0a 20 20 20 6d |60000*hours. m|
00003840 69 6e 73 20 20 3a 3d 20 74 69 63 6b 73 20 2f 20 |ins := ticks / |
00003850 36 30 30 30 3b 20 20 20 20 20 74 69 63 6b 73 20 |6000; ticks |
00003860 3a 3d 20 74 69 63 6b 73 20 2d 20 36 30 30 30 2a |:= ticks - 6000*|
00003870 6d 69 6e 73 0a 20 20 20 73 65 63 73 20 20 3a 3d |mins. secs :=|
00003880 20 74 69 63 6b 73 20 2f 20 31 30 30 3b 20 20 2f | ticks / 100; /|
00003890 2f 20 20 74 69 63 6b 73 20 3a 3d 20 74 69 63 6b |/ ticks := tick|
000038a0 73 20 2d 20 31 30 30 2a 73 65 63 73 0a 0a 2f 2f |s - 100*secs..//|
000038b0 20 54 69 6d 65 73 20 61 72 65 20 6b 65 70 74 20 | Times are kept |
000038c0 73 74 61 72 74 69 6e 67 20 66 72 6f 6d 20 4a 61 |starting from Ja|
000038d0 6e 75 61 72 79 20 31 73 74 20 31 39 30 30 20 61 |nuary 1st 1900 a|
000038e0 73 20 64 61 79 20 7a 65 72 6f 2e 20 31 39 30 34 |s day zero. 1904|
000038f0 20 77 61 73 0a 2f 2f 20 74 68 65 20 66 69 72 73 | was.// the firs|
00003900 74 20 6c 65 61 70 20 79 65 61 72 20 61 66 74 65 |t leap year afte|
00003910 72 20 74 68 61 74 2e 0a 0a 20 20 20 79 65 61 72 |r that... year|
00003920 73 20 3a 3d 20 31 20 2b 20 28 34 20 2a 20 28 64 |s := 1 + (4 * (d|
00003930 61 79 73 2d 33 36 35 29 29 20 2f 20 31 34 36 31 |ays-365)) / 1461|
00003940 20 20 20 20 20 20 2f 2f 20 20 28 33 36 35 2e 32 | // (365.2|
00003950 35 29 0a 20 20 20 64 61 79 73 20 20 3a 3d 20 64 |5). days := d|
00003960 61 79 73 20 2d 20 33 36 35 2a 79 65 61 72 73 20 |ays - 365*years |
00003970 2d 20 28 79 65 61 72 73 2d 31 29 2f 34 0a 20 20 |- (years-1)/4. |
00003980 20 6c 65 61 70 20 20 3a 3d 20 28 28 79 65 61 72 | leap := ((year|
00003990 73 20 52 45 4d 20 34 29 3d 30 29 20 26 20 28 79 |s REM 4)=0) & (y|
000039a0 65 61 72 73 3e 30 29 20 20 20 20 2f 2f 20 31 39 |ears>0) // 19|
000039b0 30 30 20 77 61 73 20 6e 6f 74 20 61 20 6c 65 61 |00 was not a lea|
000039c0 70 20 79 65 61 72 0a 0a 20 20 20 49 46 20 28 79 |p year.. IF (y|
000039d0 65 61 72 73 3c 38 33 29 20 7c 20 28 79 65 61 72 |ears<83) | (year|
000039e0 73 3e 39 39 29 20 54 48 45 4e 20 7b 0a 20 20 20 |s>99) THEN {. |
000039f0 20 20 20 72 65 73 25 30 20 3a 3d 20 30 3b 20 52 | res%0 := 0; R|
00003a00 45 54 55 52 4e 20 7d 09 09 20 20 20 20 20 2f 2f |ETURN }.. //|
00003a10 20 75 6e 73 65 74 0a 0a 20 20 20 6d 6f 6e 74 68 | unset.. month|
00003a20 73 20 3a 3d 20 30 0a 20 20 20 7b 20 20 4c 45 54 |s := 0. { LET|
00003a30 20 6d 6f 6e 6c 65 6e 20 3d 20 6d 6f 6e 74 68 73 | monlen = months|
00003a40 21 74 61 62 6c 65 20 33 31 2c 20 32 38 2c 20 33 |!table 31, 28, 3|
00003a50 31 2c 20 33 30 2c 20 33 31 2c 20 33 30 2c 20 33 |1, 30, 31, 30, 3|
00003a60 31 2c 20 33 31 2c 20 33 30 2c 20 33 31 2c 20 33 |1, 31, 30, 31, 3|
00003a70 30 2c 20 33 31 0a 20 20 20 20 20 20 49 46 20 6c |0, 31. IF l|
00003a80 65 61 70 20 26 20 28 6d 6f 6e 74 68 73 3d 31 29 |eap & (months=1)|
00003a90 20 54 48 45 4e 20 6d 6f 6e 6c 65 6e 20 3a 3d 20 | THEN monlen := |
00003aa0 32 39 0a 20 20 20 20 20 20 49 46 20 6d 6f 6e 6c |29. IF monl|
00003ab0 65 6e 3e 64 61 79 73 20 54 48 45 4e 20 42 52 45 |en>days THEN BRE|
00003ac0 41 4b 0a 20 20 20 20 20 20 64 61 79 73 20 3a 3d |AK. days :=|
00003ad0 20 64 61 79 73 2d 6d 6f 6e 6c 65 6e 0a 20 20 20 | days-monlen. |
00003ae0 20 20 20 6d 6f 6e 74 68 73 20 3a 3d 20 6d 6f 6e | months := mon|
00003af0 74 68 73 2b 31 20 7d 20 52 45 50 45 41 54 0a 0a |ths+1 } REPEAT..|
00003b00 20 20 20 72 65 73 25 32 20 3a 3d 20 64 61 79 73 | res%2 := days|
00003b10 2b 31 3b 20 72 65 73 25 31 20 3a 3d 20 6d 6f 6e |+1; res%1 := mon|
00003b20 74 68 73 2b 31 3b 20 72 65 73 25 30 20 3a 3d 20 |ths+1; res%0 := |
00003b30 79 65 61 72 73 3b 0a 20 20 20 72 65 73 25 33 20 |years;. res%3 |
00003b40 3a 3d 20 68 6f 75 72 73 3b 20 72 65 73 25 34 20 |:= hours; res%4 |
00003b50 3a 3d 20 6d 69 6e 73 3b 20 72 65 73 25 35 20 3a |:= mins; res%5 :|
00003b60 3d 20 73 65 63 73 20 7d 0a 0a 41 4e 44 20 52 61 |= secs }..AND Ra|
00003b70 6e 64 6f 6d 28 6e 29 20 3d 20 56 41 4c 4f 46 20 |ndom(n) = VALOF |
00003b80 7b 0a 20 20 20 49 46 20 6e 3d 30 20 54 48 45 4e |{. IF n=0 THEN|
00003b90 20 6e 20 3a 3d 20 6c 61 73 74 52 61 6e 64 6f 6d | n := lastRandom|
00003ba0 3b 0a 20 20 20 6c 61 73 74 52 61 6e 64 6f 6d 20 |;. lastRandom |
00003bb0 3a 3d 20 32 31 34 37 30 30 31 33 32 35 20 2a 20 |:= 2147001325 * |
00003bc0 6e 20 2b 20 37 31 35 31 33 36 33 30 35 3b 0a 20 |n + 715136305;. |
00003bd0 20 20 52 45 53 55 4c 54 49 53 20 6c 61 73 74 52 | RESULTIS lastR|
00003be0 61 6e 64 6f 6d 20 7d 0a 0a 41 4e 44 20 4e 6f 74 |andom }..AND Not|
00003bf0 68 69 6e 67 28 6d 75 63 68 2e 61 74 2e 61 6c 6c |hing(much.at.all|
00003c00 29 20 42 45 20 7b 0a 20 20 20 6d 75 63 68 2e 61 |) BE {. much.a|
00003c10 74 2e 61 6c 6c 20 3a 3d 20 6d 75 63 68 2e 61 74 |t.all := much.at|
00003c20 2e 61 6c 6c 20 7d 0a 0a 41 4e 44 20 46 61 75 6c |.all }..AND Faul|
00003c30 74 28 6d 65 73 73 61 67 65 2c 20 63 6f 64 65 2c |t(message, code,|
00003c40 20 61 31 2c 20 61 32 2c 20 61 33 2c 20 61 34 2c | a1, a2, a3, a4,|
00003c50 20 61 35 2c 20 61 36 2c 20 61 37 2c 20 61 38 2c | a5, a6, a7, a8,|
00003c60 20 61 39 2c 20 61 31 30 29 20 42 45 20 7b 0a 20 | a9, a10) BE {. |
00003c70 20 20 4c 45 54 20 72 65 61 6c 46 61 75 6c 74 20 | LET realFault |
00003c80 3d 20 46 61 75 6c 74 3b 0a 20 20 20 46 61 75 6c |= Fault;. Faul|
00003c90 74 20 3a 3d 20 4e 6f 74 68 69 6e 67 3b 0a 20 20 |t := Nothing;. |
00003ca0 20 53 65 6c 65 63 74 4f 75 74 70 75 74 28 76 64 | SelectOutput(vd|
00003cb0 75 73 74 72 65 61 6d 29 3b 0a 20 20 20 4f 53 42 |ustream);. OSB|
00003cc0 79 74 65 28 23 78 44 41 2c 20 30 2c 20 2d 31 29 |yte(#xDA, 0, -1)|
00003cd0 3b 20 2f 2f 20 41 62 6f 72 74 20 61 6e 79 20 56 |; // Abort any V|
00003ce0 44 55 20 70 61 72 61 6d 65 74 65 72 73 20 73 74 |DU parameters st|
00003cf0 69 6c 6c 20 6e 65 65 64 65 64 0a 20 20 20 57 72 |ill needed. Wr|
00003d00 69 74 65 46 28 22 2a 4e 45 72 72 6f 72 20 25 4e |iteF("*NError %N|
00003d10 3a 20 22 2c 20 63 6f 64 65 29 3b 0a 20 20 20 57 |: ", code);. W|
00003d20 72 69 74 65 46 28 6d 65 73 73 61 67 65 2c 20 61 |riteF(message, a|
00003d30 31 2c 20 61 32 2c 20 61 33 2c 20 61 34 2c 20 61 |1, a2, a3, a4, a|
00003d40 35 2c 20 61 36 2c 20 61 37 2c 20 61 38 2c 20 61 |5, a6, a7, a8, a|
00003d50 39 2c 20 61 31 30 29 3b 0a 20 20 20 57 72 69 74 |9, a10);. Writ|
00003d60 65 53 28 22 2a 4e 22 29 3b 0a 20 20 20 54 45 53 |eS("*N");. TES|
00003d70 54 20 28 41 62 6f 72 74 3e 3e 32 34 29 7e 3d 23 |T (Abort>>24)~=#|
00003d80 78 41 45 20 54 48 45 4e 20 41 62 6f 72 74 28 30 |xAE THEN Abort(0|
00003d90 29 20 45 4c 53 45 20 53 74 6f 70 28 32 35 36 29 |) ELSE Stop(256)|
00003da0 3b 0a 20 20 20 46 61 75 6c 74 20 3a 3d 20 72 65 |;. Fault := re|
00003db0 61 6c 46 61 75 6c 74 20 7d 0a 0a 41 4e 44 20 55 |alFault }..AND U|
00003dc0 6e 70 61 63 6b 53 74 72 69 6e 67 28 73 2c 20 76 |npackString(s, v|
00003dd0 29 20 42 45 0a 20 20 20 46 4f 52 20 69 20 3d 20 |) BE. FOR i = |
00003de0 73 25 30 20 54 4f 20 30 20 42 59 20 2d 31 20 44 |s%0 TO 0 BY -1 D|
00003df0 4f 20 76 21 69 20 3a 3d 20 73 25 69 0a 0a 41 4e |O v!i := s%i..AN|
00003e00 44 20 50 61 63 6b 53 74 72 69 6e 67 28 76 2c 20 |D PackString(v, |
00003e10 73 29 20 3d 20 56 41 4c 4f 46 20 7b 0a 20 20 20 |s) = VALOF {. |
00003e20 4c 45 54 20 6e 20 3d 20 76 21 30 20 26 20 32 35 |LET n = v!0 & 25|
00003e30 35 3b 0a 20 20 20 4c 45 54 20 73 69 7a 65 20 3d |5;. LET size =|
00003e40 20 6e 2f 42 79 74 65 73 50 65 72 57 6f 72 64 3b | n/BytesPerWord;|
00003e50 0a 20 20 20 46 4f 52 20 69 20 3d 20 30 20 54 4f |. FOR i = 0 TO|
00003e60 20 6e 20 44 4f 20 73 25 69 20 3a 3d 20 76 21 69 | n DO s%i := v!i|
00003e70 3b 0a 20 20 20 46 4f 52 20 69 20 3d 20 6e 2b 31 |;. FOR i = n+1|
00003e80 20 54 4f 20 28 73 69 7a 65 2b 31 29 2a 42 79 74 | TO (size+1)*Byt|
00003e90 65 73 50 65 72 57 6f 72 64 2d 31 20 44 4f 20 73 |esPerWord-1 DO s|
00003ea0 25 69 20 3a 3d 20 30 3b 0a 20 20 20 52 45 53 55 |%i := 0;. RESU|
00003eb0 4c 54 49 53 20 73 69 7a 65 20 7d 0a 0a 41 4e 44 |LTIS size }..AND|
00003ec0 20 49 6e 70 75 74 28 29 20 3d 20 63 69 73 0a 0a | Input() = cis..|
00003ed0 41 4e 44 20 4f 75 74 70 75 74 28 29 20 3d 20 63 |AND Output() = c|
00003ee0 6f 73 0a 0a 41 4e 44 20 52 65 61 64 4e 28 29 20 |os..AND ReadN() |
00003ef0 3d 20 56 41 4c 4f 46 20 7b 0a 20 20 20 4c 45 54 |= VALOF {. LET|
00003f00 20 73 75 6d 2c 20 63 68 2c 20 6e 65 67 20 3d 20 | sum, ch, neg = |
00003f10 30 2c 20 30 2c 20 46 41 4c 53 45 0a 0a 6c 3a 20 |0, 0, FALSE..l: |
00003f20 63 68 20 3a 3d 20 52 64 43 68 28 29 3b 0a 20 20 |ch := RdCh();. |
00003f30 20 49 46 20 7e 28 27 30 27 3c 3d 63 68 3c 3d 27 | IF ~('0'<=ch<='|
00003f40 39 27 29 20 54 48 45 4e 20 53 57 49 54 43 48 4f |9') THEN SWITCHO|
00003f50 4e 20 63 68 20 49 4e 54 4f 20 7b 0a 20 20 20 20 |N ch INTO {. |
00003f60 20 20 44 45 46 41 55 4c 54 3a 09 20 55 6e 52 64 | DEFAULT:. UnRd|
00003f70 43 68 28 29 3b 0a 09 09 20 72 65 73 75 6c 74 32 |Ch();... result2|
00003f80 20 3a 3d 20 2d 31 3b 0a 09 09 20 52 45 53 55 4c | := -1;... RESUL|
00003f90 54 49 53 20 30 0a 20 20 20 20 20 20 43 41 53 45 |TIS 0. CASE|
00003fa0 20 27 2a 53 27 3a 0a 20 20 20 20 20 20 43 41 53 | '*S':. CAS|
00003fb0 45 20 27 2a 54 27 3a 0a 20 20 20 20 20 20 43 41 |E '*T':. CA|
00003fc0 53 45 20 27 2a 4e 27 3a 20 47 4f 54 4f 20 6c 0a |SE '*N': GOTO l.|
00003fd0 20 20 20 20 20 20 43 41 53 45 20 27 2d 27 3a 20 | CASE '-': |
00003fe0 20 6e 65 67 20 3a 3d 20 54 52 55 45 0a 20 20 20 | neg := TRUE. |
00003ff0 20 20 20 43 41 53 45 20 27 2b 27 3a 20 20 63 68 | CASE '+': ch|
00004000 20 3a 3d 20 52 64 43 68 28 29 20 7d 0a 0a 20 20 | := RdCh() }.. |
00004010 20 57 48 49 4c 45 20 27 30 27 3c 3d 63 68 3c 3d | WHILE '0'<=ch<=|
00004020 27 39 27 20 44 4f 20 7b 0a 20 20 20 20 20 20 73 |'9' DO {. s|
00004030 75 6d 20 3a 3d 20 31 30 2a 73 75 6d 2b 63 68 2d |um := 10*sum+ch-|
00004040 27 30 27 3b 0a 20 20 20 20 20 20 63 68 20 3a 3d |'0';. ch :=|
00004050 20 52 64 43 68 28 29 20 7d 3b 0a 0a 20 20 20 49 | RdCh() };.. I|
00004060 46 20 6e 65 67 20 54 48 45 4e 20 73 75 6d 20 3a |F neg THEN sum :|
00004070 3d 20 2d 73 75 6d 3b 0a 20 20 20 55 6e 52 64 43 |= -sum;. UnRdC|
00004080 68 28 29 3b 0a 20 20 20 72 65 73 75 6c 74 32 20 |h();. result2 |
00004090 3a 3d 20 30 3b 0a 20 20 20 52 45 53 55 4c 54 49 |:= 0;. RESULTI|
000040a0 53 20 73 75 6d 20 7d 0a 0a 41 4e 44 20 4e 65 77 |S sum }..AND New|
000040b0 4c 69 6e 65 28 29 20 42 45 20 57 72 43 68 28 27 |Line() BE WrCh('|
000040c0 2a 4e 27 29 0a 0a 41 4e 44 20 4e 65 77 50 61 67 |*N')..AND NewPag|
000040d0 65 28 29 20 42 45 20 57 72 43 68 28 27 2a 50 27 |e() BE WrCh('*P'|
000040e0 29 0a 0a 41 4e 44 20 57 72 69 74 65 44 28 6e 2c |)..AND WriteD(n,|
000040f0 20 64 29 20 42 45 20 7b 0a 20 20 20 4c 45 54 20 | d) BE {. LET |
00004100 74 20 3d 20 56 45 43 20 31 30 0a 20 20 20 41 4e |t = VEC 10. AN|
00004110 44 20 69 2c 20 6b 20 3d 20 30 2c 20 6e 3b 0a 20 |D i, k = 0, n;. |
00004120 20 20 49 46 20 6e 3c 30 20 54 48 45 4e 20 64 2c | IF n<0 THEN d,|
00004130 20 6b 20 3a 3d 20 64 2d 31 2c 20 2d 6e 3b 0a 20 | k := d-1, -n;. |
00004140 20 20 74 21 69 2c 20 6b 2c 20 69 20 3a 3d 20 6b | t!i, k, i := k|
00004150 20 52 45 4d 20 31 30 2c 20 6b 2f 31 30 2c 20 69 | REM 10, k/10, i|
00004160 2b 31 20 52 45 50 45 41 54 55 4e 54 49 4c 20 6b |+1 REPEATUNTIL k|
00004170 3d 30 3b 0a 20 20 20 46 4f 52 20 6a 20 3d 20 69 |=0;. FOR j = i|
00004180 2b 31 20 54 4f 20 64 20 44 4f 20 57 72 43 68 28 |+1 TO d DO WrCh(|
00004190 27 2a 53 27 29 3b 0a 20 20 20 49 46 20 6e 3c 30 |'*S');. IF n<0|
000041a0 20 54 48 45 4e 20 57 72 43 68 28 27 2d 27 29 3b | THEN WrCh('-');|
000041b0 0a 20 20 20 46 4f 52 20 6a 20 3d 20 69 2d 31 20 |. FOR j = i-1 |
000041c0 54 4f 20 30 20 42 59 20 2d 31 20 44 4f 20 57 72 |TO 0 BY -1 DO Wr|
000041d0 43 68 28 74 21 6a 2b 27 30 27 29 20 7d 0a 0a 41 |Ch(t!j+'0') }..A|
000041e0 4e 44 20 57 72 69 74 65 4e 28 6e 29 20 42 45 20 |ND WriteN(n) BE |
000041f0 57 72 69 74 65 44 28 6e 2c 20 30 29 0a 0a 41 4e |WriteD(n, 0)..AN|
00004200 44 20 57 72 69 74 65 48 65 78 28 6e 2c 20 64 29 |D WriteHex(n, d)|
00004210 20 42 45 20 7b 0a 20 20 20 49 46 20 64 3e 31 20 | BE {. IF d>1 |
00004220 44 4f 20 57 72 69 74 65 48 65 78 28 6e 3e 3e 34 |DO WriteHex(n>>4|
00004230 2c 20 64 2d 31 29 3b 0a 20 20 20 57 72 43 68 28 |, d-1);. WrCh(|
00004240 28 6e 26 31 35 29 21 54 41 42 4c 45 0a 09 27 30 |(n&15)!TABLE..'0|
00004250 27 2c 27 31 27 2c 27 32 27 2c 27 33 27 2c 27 34 |','1','2','3','4|
00004260 27 2c 27 35 27 2c 27 36 27 2c 27 37 27 2c 0a 09 |','5','6','7',..|
00004270 27 38 27 2c 27 39 27 2c 27 41 27 2c 27 42 27 2c |'8','9','A','B',|
00004280 27 43 27 2c 27 44 27 2c 27 45 27 2c 27 46 27 29 |'C','D','E','F')|
00004290 20 7d 0a 0a 41 4e 44 20 57 72 69 74 65 4f 63 74 | }..AND WriteOct|
000042a0 28 6e 2c 20 64 29 20 42 45 20 7b 0a 20 20 20 49 |(n, d) BE {. I|
000042b0 46 20 64 3e 31 20 44 4f 20 57 72 69 74 65 4f 63 |F d>1 DO WriteOc|
000042c0 74 28 6e 3e 3e 33 2c 20 64 2d 31 29 3b 0a 20 20 |t(n>>3, d-1);. |
000042d0 20 57 72 43 68 28 28 6e 26 37 29 2b 27 30 27 29 | WrCh((n&7)+'0')|
000042e0 20 7d 0a 0a 41 4e 44 20 57 72 69 74 65 53 28 73 | }..AND WriteS(s|
000042f0 29 20 42 45 0a 20 20 20 46 4f 52 20 69 20 3d 20 |) BE. FOR i = |
00004300 31 20 54 4f 20 73 25 30 20 44 4f 20 57 72 43 68 |1 TO s%0 DO WrCh|
00004310 28 73 25 69 29 0a 0a 41 4e 44 20 57 72 69 74 65 |(s%i)..AND Write|
00004320 54 28 73 2c 20 6e 29 20 42 45 20 7b 0a 20 20 20 |T(s, n) BE {. |
00004330 57 72 69 74 65 53 28 73 29 3b 0a 20 20 20 46 4f |WriteS(s);. FO|
00004340 52 20 69 20 3d 20 31 20 54 4f 20 6e 2d 73 25 30 |R i = 1 TO n-s%0|
00004350 20 44 4f 20 57 72 43 68 28 27 2a 53 27 29 20 7d | DO WrCh('*S') }|
00004360 0a 0a 41 4e 44 20 57 72 69 74 65 55 28 6e 2c 20 |..AND WriteU(n, |
00004370 64 29 20 42 45 20 7b 0a 20 20 20 4c 45 54 20 6d |d) BE {. LET m|
00004380 20 3d 20 28 6e 3e 3e 31 29 2f 35 3b 0a 20 20 20 | = (n>>1)/5;. |
00004390 49 46 20 6d 7e 3d 30 20 54 48 45 4e 20 7b 0a 20 |IF m~=0 THEN {. |
000043a0 20 20 20 20 20 57 72 69 74 65 44 28 6d 2c 20 64 | WriteD(m, d|
000043b0 2d 31 29 0a 20 20 20 20 20 20 64 20 3a 3d 20 31 |-1). d := 1|
000043c0 20 7d 3b 0a 20 20 20 57 72 69 74 65 44 28 6e 2d | };. WriteD(n-|
000043d0 6d 2a 31 30 2c 20 64 29 20 7d 0a 0a 41 4e 44 20 |m*10, d) }..AND |
000043e0 57 72 69 74 65 46 28 66 6f 72 6d 61 74 2c 20 61 |WriteF(format, a|
000043f0 2c 20 62 2c 20 63 2c 20 64 2c 20 65 2c 20 66 2c |, b, c, d, e, f,|
00004400 20 67 2c 20 68 2c 20 69 2c 20 6a 2c 20 6b 29 20 | g, h, i, j, k) |
00004410 42 45 20 7b 0a 20 20 20 4c 45 54 20 74 20 3d 20 |BE {. LET t = |
00004420 40 61 0a 0a 20 20 20 46 4f 52 20 70 20 3d 20 31 |@a.. FOR p = 1|
00004430 20 54 4f 20 66 6f 72 6d 61 74 25 30 20 44 4f 20 | TO format%0 DO |
00004440 7b 0a 20 20 20 20 20 20 4c 45 54 20 6b 20 3d 20 |{. LET k = |
00004450 66 6f 72 6d 61 74 25 70 0a 0a 20 20 20 20 20 20 |format%p.. |
00004460 54 45 53 54 20 6b 3d 27 25 27 20 54 48 45 4e 20 |TEST k='%' THEN |
00004470 7b 0a 09 20 4c 45 54 20 66 2c 20 61 72 67 2c 20 |{.. LET f, arg, |
00004480 6e 20 3d 20 30 2c 20 74 21 30 2c 20 30 0a 09 20 |n = 0, t!0, 0.. |
00004490 70 20 3a 3d 20 70 2b 31 0a 09 20 53 57 49 54 43 |p := p+1.. SWITC|
000044a0 48 4f 4e 20 43 61 70 69 74 61 6c 43 68 28 66 6f |HON CapitalCh(fo|
000044b0 72 6d 61 74 25 70 29 20 49 4e 54 4f 20 7b 0a 09 |rmat%p) INTO {..|
000044c0 20 20 20 20 44 45 46 41 55 4c 54 3a 20 57 72 43 | DEFAULT: WrC|
000044d0 68 28 66 6f 72 6d 61 74 25 70 29 3b 20 45 4e 44 |h(format%p); END|
000044e0 43 41 53 45 0a 09 20 20 20 20 43 41 53 45 20 27 |CASE.. CASE '|
000044f0 53 27 3a 20 66 20 3a 3d 20 57 72 69 74 65 53 3b |S': f := WriteS;|
00004500 20 47 4f 54 4f 20 6c 0a 09 20 20 20 20 43 41 53 | GOTO l.. CAS|
00004510 45 20 27 54 27 3a 20 66 20 3a 3d 20 57 72 69 74 |E 'T': f := Writ|
00004520 65 54 3b 20 47 4f 54 4f 20 6d 0a 09 20 20 20 20 |eT; GOTO m.. |
00004530 43 41 53 45 20 27 43 27 3a 20 66 20 3a 3d 20 57 |CASE 'C': f := W|
00004540 72 43 68 3b 20 47 4f 54 4f 20 6c 0a 09 20 20 20 |rCh; GOTO l.. |
00004550 20 43 41 53 45 20 27 4f 27 3a 20 66 20 3a 3d 20 | CASE 'O': f := |
00004560 57 72 69 74 65 4f 63 74 3b 20 47 4f 54 4f 20 6d |WriteOct; GOTO m|
00004570 0a 09 20 20 20 20 43 41 53 45 20 27 58 27 3a 20 |.. CASE 'X': |
00004580 66 20 3a 3d 20 57 72 69 74 65 48 65 78 3b 20 47 |f := WriteHex; G|
00004590 4f 54 4f 20 6d 0a 09 20 20 20 20 43 41 53 45 20 |OTO m.. CASE |
000045a0 27 49 27 3a 20 66 20 3a 3d 20 57 72 69 74 65 44 |'I': f := WriteD|
000045b0 3b 20 47 4f 54 4f 20 6d 0a 09 20 20 20 20 43 41 |; GOTO m.. CA|
000045c0 53 45 20 27 4e 27 3a 20 66 20 3a 3d 20 57 72 69 |SE 'N': f := Wri|
000045d0 74 65 4e 3b 20 47 4f 54 4f 20 6c 0a 09 20 20 20 |teN; GOTO l.. |
000045e0 20 43 41 53 45 20 27 55 27 3a 20 66 20 3a 3d 20 | CASE 'U': f := |
000045f0 57 72 69 74 65 55 3b 20 47 4f 54 4f 20 6d 0a 09 |WriteU; GOTO m..|
00004600 20 20 20 20 43 41 53 45 20 27 46 27 3a 20 66 20 | CASE 'F': f |
00004610 3a 3d 20 57 72 46 6c 4e 75 6d 3b 20 47 4f 54 4f |:= WrFlNum; GOTO|
00004620 20 6c 0a 0a 09 20 20 20 20 6d 3a 20 70 20 3a 3d | l... m: p :=|
00004630 20 70 2b 31 0a 09 20 20 20 20 20 20 20 6e 20 3a | p+1.. n :|
00004640 3d 20 66 6f 72 6d 61 74 25 70 0a 09 20 20 20 20 |= format%p.. |
00004650 20 20 20 6e 20 3a 3d 20 27 30 27 3c 3d 6e 3c 3d | n := '0'<=n<=|
00004660 27 39 27 20 2d 3e 20 6e 2d 27 30 27 2c 0a 09 09 |'9' -> n-'0',...|
00004670 09 09 20 20 20 6e 2d 27 41 27 2b 31 30 0a 0a 09 |.. n-'A'+10...|
00004680 20 20 20 20 6c 3a 20 66 28 61 72 67 2c 20 6e 29 | l: f(arg, n)|
00004690 0a 0a 09 20 20 20 20 43 41 53 45 20 27 24 27 3a |... CASE '$':|
000046a0 0a 09 20 20 20 20 20 20 20 74 20 3a 3d 20 74 2b |.. t := t+|
000046b0 53 74 61 63 6b 46 72 61 6d 65 44 69 72 65 63 74 |StackFrameDirect|
000046c0 69 6f 6e 20 7d 20 7d 0a 0a 20 20 20 20 20 20 45 |ion } }.. E|
000046d0 4c 53 45 0a 09 20 57 72 43 68 28 6b 29 20 7d 20 |LSE.. WrCh(k) } |
000046e0 7d 0a 0a 41 4e 44 20 57 72 46 6c 4e 75 6d 28 61 |}..AND WrFlNum(a|
000046f0 29 20 42 45 20 7b 0a 20 20 20 4c 45 54 20 76 20 |) BE {. LET v |
00004700 3d 20 56 45 43 20 32 3b 0a 20 20 20 4c 45 54 20 |= VEC 2;. LET |
00004710 6d 20 3d 20 56 45 43 20 33 3b 0a 20 20 20 4c 45 |m = VEC 3;. LE|
00004720 54 20 6b 2c 20 65 20 3d 20 30 2c 20 30 3b 0a 20 |T k, e = 0, 0;. |
00004730 20 20 4c 45 54 20 73 65 2c 20 73 6d 20 3d 20 30 | LET se, sm = 0|
00004740 2c 20 30 3b 0a 20 20 20 4c 45 54 20 65 78 70 2c |, 0;. LET exp,|
00004750 20 6c 61 73 74 44 69 67 69 74 20 3d 20 30 2c 20 | lastDigit = 0, |
00004760 30 3b 0a 0a 2f 2a 20 47 65 74 20 61 20 70 61 63 |0;../* Get a pac|
00004770 6b 65 64 20 64 65 63 69 6d 61 6c 20 76 65 72 73 |ked decimal vers|
00004780 69 6f 6e 20 6f 66 20 74 68 65 20 66 6c 6f 61 74 |ion of the float|
00004790 69 6e 67 20 70 6f 69 6e 74 20 76 61 6c 75 65 3a |ing point value:|
000047a0 20 66 6f 72 6d 61 74 0a 09 73 20 20 65 33 20 2e | format..s e3 .|
000047b0 20 65 32 20 65 31 20 2e 20 65 30 20 6d 31 38 2e | e2 e1 . e0 m18.|
000047c0 6d 31 37 20 6d 31 36 2e 0a 20 20 20 20 20 20 20 |m17 m16.. |
000047d0 6d 31 35 20 6d 31 34 2e 6d 31 33 20 6d 31 32 2e |m15 m14.m13 m12.|
000047e0 6d 31 31 20 6d 31 30 2e 20 6d 39 20 6d 38 20 2e |m11 m10. m9 m8 .|
000047f0 0a 20 20 20 20 20 20 20 6d 37 20 6d 36 20 20 2e |. m7 m6 .|
00004800 20 6d 35 20 6d 34 20 2e 20 6d 33 20 6d 32 20 2e | m5 m4 . m3 m2 .|
00004810 20 6d 31 20 6d 30 20 2e 0a 20 20 20 57 69 74 68 | m1 m0 .. With|
00004820 20 73 20 62 69 74 20 33 20 3d 20 73 69 67 6e 20 | s bit 3 = sign |
00004830 6f 66 20 6d 61 6e 74 69 73 73 61 2c 20 73 20 62 |of mantissa, s b|
00004840 69 74 20 32 20 3d 20 73 69 67 6e 20 6f 66 20 65 |it 2 = sign of e|
00004850 78 70 6f 6e 65 6e 74 0a 2a 2f 0a 20 20 20 43 6f |xponent.*/. Co|
00004860 6e 76 65 72 74 53 54 6f 50 28 61 2c 20 76 29 3b |nvertSToP(a, v);|
00004870 0a 20 20 20 7b 20 20 4c 45 54 20 73 20 3d 20 76 |. { LET s = v|
00004880 25 33 3b 0a 20 20 20 20 20 20 73 65 20 3a 3d 20 |%3;. se := |
00004890 73 26 23 78 34 30 3b 0a 20 20 20 20 20 20 73 6d |s@. sm|
000048a0 20 3a 3d 20 73 26 23 78 38 30 20 7d 3b 0a 0a 2f | := s€ };../|
000048b0 2a 20 41 20 73 69 6e 67 6c 65 20 70 72 65 63 69 |* A single preci|
000048c0 73 69 6f 6e 20 49 45 45 45 20 6e 75 6d 62 65 72 |sion IEEE number|
000048d0 20 68 61 73 20 61 74 20 6d 6f 73 74 20 37 20 64 | has at most 7 d|
000048e0 69 67 69 74 73 20 6f 66 20 70 72 65 63 69 73 69 |igits of precisi|
000048f0 6f 6e 0a 20 20 20 28 32 33 20 62 69 74 20 6d 61 |on. (23 bit ma|
00004900 6e 74 69 73 73 61 29 2c 20 73 6f 20 77 65 20 63 |ntissa), so we c|
00004910 61 6e 20 74 68 72 6f 77 20 61 77 61 79 20 6d 37 |an throw away m7|
00004920 2e 2e 6d 30 20 2a 2f 0a 0a 20 20 20 46 4f 52 20 |..m0 */.. FOR |
00004930 69 20 3d 20 31 20 54 4f 20 30 20 42 59 20 2d 31 |i = 1 TO 0 BY -1|
00004940 20 44 4f 20 7b 0a 20 20 20 20 20 20 4c 45 54 20 | DO {. LET |
00004950 77 20 3d 20 76 21 69 3b 0a 20 20 20 20 20 20 46 |w = v!i;. F|
00004960 4f 52 20 6a 20 3d 20 30 20 54 4f 20 37 20 44 4f |OR j = 0 TO 7 DO|
00004970 20 7b 0a 09 20 6d 25 6b 20 3a 3d 20 77 26 31 35 | {.. m%k := w&15|
00004980 3b 20 77 20 3a 3d 20 77 3e 3e 34 3b 20 6b 20 3a |; w := w>>4; k :|
00004990 3d 20 6b 2b 31 20 7d 20 7d 3b 0a 0a 2f 2a 20 49 |= k+1 } };../* I|
000049a0 20 6a 75 73 74 20 74 72 75 6e 63 61 74 65 20 68 | just truncate h|
000049b0 65 72 65 2c 20 77 68 65 72 65 20 72 65 61 6c 6c |ere, where reall|
000049c0 79 20 49 20 73 68 6f 75 6c 64 20 72 6f 75 6e 64 |y I should round|
000049d0 20 2a 2f 0a 0a 20 20 20 6b 20 3a 3d 20 31 32 2d | */.. k := 12-|
000049e0 38 3b 0a 20 20 20 57 48 49 4c 45 20 6b 3c 28 31 |8;. WHILE k<(1|
000049f0 38 2d 38 29 20 26 20 6d 25 6b 3d 30 20 44 4f 20 |8-8) & m%k=0 DO |
00004a00 6b 20 3a 3d 20 6b 2b 31 3b 0a 20 20 20 65 20 3a |k := k+1;. e :|
00004a10 3d 20 28 32 32 2d 38 29 3b 0a 20 20 20 57 48 49 |= (22-8);. WHI|
00004a20 4c 45 20 65 3e 28 31 39 2d 38 29 20 26 20 6d 25 |LE e>(19-8) & m%|
00004a30 65 3d 30 20 44 4f 20 65 20 3a 3d 20 65 2d 31 3b |e=0 DO e := e-1;|
00004a40 0a 0a 20 20 20 65 78 70 20 3a 3d 20 30 3b 0a 20 |.. exp := 0;. |
00004a50 20 20 46 4f 52 20 69 20 3d 20 65 20 54 4f 20 31 | FOR i = e TO 1|
00004a60 39 2d 38 20 42 59 20 2d 31 20 44 4f 20 65 78 70 |9-8 BY -1 DO exp|
00004a70 20 3a 3d 20 65 78 70 2a 31 30 2b 6d 25 69 3b 0a | := exp*10+m%i;.|
00004a80 20 20 20 49 46 20 73 65 20 54 48 45 4e 20 65 78 | IF se THEN ex|
00004a90 70 20 3a 3d 20 2d 65 78 70 3b 0a 0a 2f 2a 20 50 |p := -exp;../* P|
00004aa0 72 65 74 74 69 66 79 20 74 68 65 20 6f 75 74 70 |rettify the outp|
00004ab0 75 74 20 61 20 62 69 74 2c 20 6e 6f 74 20 70 72 |ut a bit, not pr|
00004ac0 69 6e 74 69 6e 67 20 20 65 78 78 78 20 20 69 66 |inting exxx if|
00004ad0 20 69 74 20 77 6f 6e 27 74 20 63 61 75 73 65 20 | it won't cause |
00004ae0 75 73 0a 20 20 20 74 6f 20 70 72 69 6e 74 20 61 |us. to print a|
00004af0 6e 79 20 6d 6f 72 65 20 64 69 67 69 74 73 20 74 |ny more digits t|
00004b00 6f 20 61 76 6f 69 64 20 69 74 20 28 6f 74 68 65 |o avoid it (othe|
00004b10 72 20 74 68 61 6e 20 61 20 73 69 6e 67 6c 65 20 |r than a single |
00004b20 6c 65 61 64 69 6e 67 20 6f 72 0a 20 20 20 74 72 |leading or. tr|
00004b30 61 69 6c 69 6e 67 20 7a 65 72 6f 29 20 2a 2f 0a |ailing zero) */.|
00004b40 0a 20 20 20 54 45 53 54 20 2d 31 3c 3d 65 78 70 |. TEST -1<=exp|
00004b50 3c 3d 36 20 54 48 45 4e 0a 20 20 20 20 20 20 6c |<=6 THEN. l|
00004b60 61 73 74 44 69 67 69 74 20 3a 3d 20 31 38 2d 38 |astDigit := 18-8|
00004b70 2d 65 78 70 0a 20 20 20 45 4c 53 45 0a 20 20 20 |-exp. ELSE. |
00004b80 20 20 20 6c 61 73 74 44 69 67 69 74 20 3a 3d 20 | lastDigit := |
00004b90 31 38 2d 38 3b 0a 0a 20 20 20 49 46 20 73 6d 7e |18-8;.. IF sm~|
00004ba0 3d 30 20 54 48 45 4e 20 57 72 43 68 28 27 2d 27 |=0 THEN WrCh('-'|
00004bb0 29 3b 0a 20 20 20 49 46 20 65 78 70 3d 2d 31 20 |);. IF exp=-1 |
00004bc0 54 48 45 4e 20 57 72 43 68 28 27 30 27 29 3b 0a |THEN WrCh('0');.|
00004bd0 20 20 20 46 4f 52 20 69 20 3d 20 31 38 2d 38 20 | FOR i = 18-8 |
00004be0 54 4f 20 6c 61 73 74 44 69 67 69 74 20 42 59 20 |TO lastDigit BY |
00004bf0 2d 31 20 44 4f 20 57 72 43 68 28 6d 25 69 2b 27 |-1 DO WrCh(m%i+'|
00004c00 30 27 29 3b 0a 20 20 20 57 72 43 68 28 27 2e 27 |0');. WrCh('.'|
00004c10 29 3b 0a 20 20 20 54 45 53 54 20 6b 3e 3d 6c 61 |);. TEST k>=la|
00004c20 73 74 44 69 67 69 74 20 54 48 45 4e 0a 20 20 20 |stDigit THEN. |
00004c30 20 20 20 57 72 43 68 28 27 30 27 29 0a 20 20 20 | WrCh('0'). |
00004c40 45 4c 53 45 20 46 4f 52 20 69 20 3d 20 6c 61 73 |ELSE FOR i = las|
00004c50 74 44 69 67 69 74 2d 31 20 54 4f 20 6b 20 42 59 |tDigit-1 TO k BY|
00004c60 20 2d 31 20 44 4f 20 57 72 43 68 28 6d 25 69 2b | -1 DO WrCh(m%i+|
00004c70 27 30 27 29 3b 0a 20 20 20 55 4e 4c 45 53 53 20 |'0');. UNLESS |
00004c80 2d 31 3c 3d 65 78 70 3c 3d 36 20 54 48 45 4e 20 |-1<=exp<=6 THEN |
00004c90 7b 0a 20 20 20 20 20 20 57 72 43 68 28 27 65 27 |{. WrCh('e'|
00004ca0 29 3b 0a 20 20 20 20 20 20 49 46 20 73 65 7e 3d |);. IF se~=|
00004cb0 30 20 54 48 45 4e 20 57 72 43 68 28 27 2d 27 29 |0 THEN WrCh('-')|
00004cc0 3b 0a 20 20 20 20 20 20 46 4f 52 20 69 20 3d 20 |;. FOR i = |
00004cd0 65 20 54 4f 20 31 39 2d 38 20 42 59 20 2d 31 20 |e TO 19-8 BY -1 |
00004ce0 44 4f 20 57 72 43 68 28 6d 25 69 2b 27 30 27 29 |DO WrCh(m%i+'0')|
00004cf0 20 7d 20 7d 0a 0a 41 4e 44 20 43 61 70 69 74 61 | } }..AND Capita|
00004d00 6c 43 68 28 63 68 29 20 3d 20 27 61 27 3c 3d 63 |lCh(ch) = 'a'<=c|
00004d10 68 3c 3d 27 7a 27 20 2d 3e 20 63 68 2b 27 41 27 |h<='z' -> ch+'A'|
00004d20 2d 27 61 27 2c 20 63 68 0a 0a 41 4e 44 20 43 6f |-'a', ch..AND Co|
00004d30 6d 70 43 68 28 63 68 31 2c 20 63 68 32 29 20 3d |mpCh(ch1, ch2) =|
00004d40 20 43 61 70 69 74 61 6c 43 68 28 63 68 31 29 2d | CapitalCh(ch1)-|
00004d50 43 61 70 69 74 61 6c 43 68 28 63 68 32 29 0a 0a |CapitalCh(ch2)..|
00004d60 41 4e 44 20 43 6f 6d 70 53 74 72 69 6e 67 28 73 |AND CompString(s|
00004d70 31 2c 20 73 32 29 20 3d 20 56 41 4c 4f 46 20 7b |1, s2) = VALOF {|
00004d80 0a 20 20 20 4c 45 54 20 6c 65 6e 73 31 2c 20 6c |. LET lens1, l|
00004d90 65 6e 73 32 20 3d 20 73 31 25 30 2c 20 73 32 25 |ens2 = s1%0, s2%|
00004da0 30 0a 20 20 20 4c 45 54 20 73 6d 61 6c 6c 65 72 |0. LET smaller|
00004db0 20 3d 20 6c 65 6e 73 31 3c 6c 65 6e 73 32 20 2d | = lens1<lens2 -|
00004dc0 3e 20 73 31 2c 20 73 32 0a 0a 20 20 20 46 4f 52 |> s1, s2.. FOR|
00004dd0 20 69 20 3d 20 31 20 54 4f 20 73 6d 61 6c 6c 65 | i = 1 TO smalle|
00004de0 72 25 30 20 44 4f 20 7b 0a 20 20 20 20 20 20 4c |r%0 DO {. L|
00004df0 45 54 20 72 65 73 20 3d 20 43 6f 6d 70 43 68 28 |ET res = CompCh(|
00004e00 73 31 25 69 2c 20 73 32 25 69 29 0a 20 20 20 20 |s1%i, s2%i). |
00004e10 20 20 49 46 20 72 65 73 7e 3d 30 20 54 48 45 4e | IF res~=0 THEN|
00004e20 20 52 45 53 55 4c 54 49 53 20 72 65 73 20 7d 0a | RESULTIS res }.|
00004e30 0a 20 20 20 49 46 20 6c 65 6e 73 31 3d 6c 65 6e |. IF lens1=len|
00004e40 73 32 20 54 48 45 4e 20 52 45 53 55 4c 54 49 53 |s2 THEN RESULTIS|
00004e50 20 30 0a 0a 20 20 20 52 45 53 55 4c 54 49 53 20 | 0.. RESULTIS |
00004e60 73 6d 61 6c 6c 65 72 3d 73 31 20 2d 3e 20 2d 31 |smaller=s1 -> -1|
00004e70 2c 20 31 20 7d 0a |, 1 }.|
00004e76 
.