// 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&#x40;
      sm := s&#x80 };

/* 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 }
