// (C) Copyright 1979 Tripos Research Group
//     University of Cambridge
//     Computer Laboratory

   /* This version has disced built in */

SECTION "CLI"

GET "LIBHDR"
GET "CLIHDR"
GET "IOHDR"

GLOBAL $( discedcomm:ug+180 $)
MANIFEST
$(
namemax    = 25
promptmax  = 15
filemax    = 10
$)

LET START(parm.pkt) BE
  $( LET prompt  = VEC promptmax
     LET commandname = VEC namemax
     LET commandfile = VEC filemax
     LET globbase = @globsize
     LET error = FALSE

     cli.prompt := prompt
     cli.commandname := commandname
     cli.commandfile := commandfile

     cli.init(parm.pkt)(result2)

     $( LET ch = ?

     $( LET item = ?

        cli.interactive :=  NOT cli.background &
               cli.currentinput=cli.standardinput

        selectinput(cli.currentinput)
        ch := unrdch() -> rdch(), 0

        TEST cli.interactive THEN
           UNLESS ch=';' THEN
           $( LET mins = rootnode!rtn.mins
              selectoutput(cli.standardoutput)
              writef(cli.prompt,taskid,mins/60,mins REM 60)
              wrch('*E')
              selectoutput(cli.currentoutput)
           $)
        ELSE
        $( IF testflags(2) THEN
           $( error := TRUE
              writes("****BREAK - CLI*N")
           $)
           IF error BREAK
        $)

        error := FALSE

        item := rditem(cli.commandname, namemax)
        ch := 0

        UNLESS item=0 THEN
        $( error := TRUE
           TEST item=1 THEN
           $( LET coptr = 0
              LET builtin = findbuiltin(cli.commandname)
 //             cli.module := loadseg(cli.commandname)

 //             IF cli.module=0 THEN
 //             $( LET dir = currentdir
 //                currentdir := cli.commanddir
 //                cli.module := loadseg(cli.commandname)
 //                currentdir := dir
 //             $)

 //             UNLESS cli.module=0 | globin(cli.module)=0 DO
                UNLESS builtin=0 DO
                 coptr := createco(builtin, cli.defaultstack)

              TEST coptr=0 THEN
              $( cli.result2 := result2
                 writef("Can't load %S*N", cli.commandname)
              $)
              ELSE
              $( testflags(1)
                 callco(coptr,0)
                 cli.result2 := returncode=0 -> 0, result2

                 start := cli.undefglobval
                /************************/
                 FOR i = ug TO ug+4 DO
                    globbase!i := cli.undefglobval
                 globin(tcb!tcb.seglist!1)
                 globin(tcb!tcb.seglist!2)
                 cli.returncode := returncode
                 returncode := 0
                 IF cli.returncode<cli.faillevel THEN
                    error := FALSE
                 deleteco(coptr)
                 selectinput(cli.currentinput)
                 selectoutput(cli.currentoutput)
                 ch := unrdch() -> 0, '*N'
                 IF error & NOT cli.interactive THEN
                    writef("%S failed returncode %N*N",
                        cli.commandname, cli.returncode)
              $)

 //             unloadseg(cli.module)
              cli.module := 0
           $)

           ELSE
              writes("Error in command name*N")
        $)

        UNTIL ch='*N' | ch='*E' | ch=';' |
              ch=endstreamch DO ch := rdch()

     $) REPEATUNTIL ch=endstreamch

        TEST cli.currentinput=cli.standardinput THEN
        $( IF cli.background BREAK
           cli.standardinput!scb.end := -1
           cli.standardinput!scb.arg1 := 1
        $)
        ELSE
        $( endread()
           deleteobj(cli.commandfile)
           cli.currentinput := cli.standardinput
           cli.faillevel := cli.initialfaillevel
        $)

     $) REPEAT

     endread()
     endwrite()
     UNLESS cli.currentoutput=cli.standardoutput THEN
     $( selectoutput(cli.standardoutput)
        endwrite()
     $)
     freeobj(currentdir)
     freeobj(cli.commanddir)
     deletetask(taskid)
  $)

AND findbuiltin(s) = VALOF
$( SWITCHON findarg("console,echo,prompt,status,time,wait,*
                     *changepri,dktest,disced", s)
            INTO
    $( DEFAULT: RESULTIS 0
       CASE 8:  RESULTIS discedcomm
    $)
$)

.
|| (C) Copyright 1979 Tripos Research Group
||     University of Cambridge
||     Computer Laboratory

||     Modified by the Network Development Group
||                     SRC Rutherford Laboratory
|| Disc Editor for TRIPOS
|| For version 2 of the filing system (Jan 1979)
|| 8086 version for Intel double density floppy disk system

SECTION "Disced1"

GET "DISCED"

GLOBAL $( discedcomm:ug+180 $)

LET discedcomm(zero.or.packet) BE
    $(
    LET match = ?
    LET temp = ?
    LET currword = 0

    size.block := 256
    sector.origin := 0
    n.surfaces := 1
    n.sectorsperblock := 1
    n.blockspertrack := 13
    lowercylinder := 15
    uppercylinder := 76


    TEST zero.or.packet \= 0 THEN
      $( qpkt(zero.or.packet)
         initio()
         selectinput(findinput("**"))
         selectoutput(findoutput("**"))
      $)
     ELSE
      UNTIL (ch = '*N') | (ch = '*E') | (ch = ';')
      DO ch := rdch()

    writes("TRIPOS (Floppy) Disc Editor version 2.0*N")

    // Code to get cylinder count right on floppies
    FOR z=0 TO ndrives-1
    DO $(
       sendpkt(notinuse, dddevid, act.seek, ?, ?, ?, ?, z, 2)
       sendpkt(notinuse, dddevid, act.seek, ?, ?, ?, ?, z, -80)
       $)

    block.read := FALSE
    style := " %N "
    drive := 0
    cyl, sur, sec := -1, -1, -1
    cylbase := LowerCylinder
    write.protected := TRUE
    writef("Write protect mode set*N*
           *Cylinder base set to %N*N",
           cylbase)
    lbnbase := 0
    lbn := -1
    stringstyle := FALSE
    charstyle   := FALSE
    mask, pattern := -1, 0
    nullnumber := FALSE
    blockbuff := getvec(size.block - 1)
    IF blockbuff = 0
    THEN $( WRITES("No space for buffer*N"); STOP(20) $)
    blockwrittenback := TRUE



    writes("# *E")

    $( || Main loop
    ch := rdch()

    SWITCHON capitalch(ch) INTO
        $(
        CASE '*E': newline()
        CASE '*N': writes("# *E")
                   ENDCASE

        CASE '*S': ENDCASE

        CASE 'B':  || Reset logical block
                   || number base
                   temp := readvalue()

                   UNLESS 0 <= temp < nblocks
                   THEN
                       $(
                       writes(" Silly value %N*N",
                              temp)
                       ENDCASE
                       $)

                   lbnbase := temp
                   writef(" Logical block number *
                     *base set to %N*N", lbnbase)
                   ENDCASE

        CASE 'C':  || Print n characters
                   check.block.read()
                   writes(" '")

                   FOR j = 0 TO readvalue() - 1
                   DO wrch(getbyte(blockbuff+currword,j))

                   writes("'*N")
                   ENDCASE

        CASE 'D':  || Set the disc drive number
                   temp := readvalue()
                   UNLESS 0 <= temp < ndrives
                   THEN
                       $(
                       writef(" Silly drive number %N*N",
                              temp)
                       ENDCASE
                       $)

                   drive := temp
                   writef(" Drive %N selected*N",drive)
                   ENDCASE

        CASE 'G':  || Get block from disc
                   $(
                   LET oldlbn = lbn
                   LET addrok = readdiscaddr()
                   LET newlbn = lbn

                   UNLESS blockwrittenback | NOT block.read
                   THEN
                       $(
                       writes(" Last block not *
                         *yet written back!!*N*
                         * Type N if you do not *
                         *want it updated *E")

                       UNTIL rdch()='*N' LOOP
                       temp := rdch()

                       UNLESS (temp='N') | (temp='n')
                       THEN
                           $(
                           unrdch()
                           lbn := oldlbn
                           convertdiscaddr(oldlbn+lbnbase)
                           UNLESS discaction(act.write)
                           THEN ENDCASE
                           lbn := newlbn
                           convertdiscaddr(newlbn+lbnbase)
                           $)
                       $)

                   IF addrok
                   THEN discaction(act.read)
                   $)
                   ENDCASE

        CASE 'H':  || Calculate hash value given
                   || string
                   $(
                   LET s = VEC filenameupb+1
                   LET p = 0
                   LET h = 0

                   skiplayout()
                   ch := rdch()
                   IF ch = '"' THEN ch := readchar()

                   UNTIL (ch = '*N') | (ch = '"') |
                         (ch = ' ') | (p=filenameupb)
                   DO
                       $(
                       p := p + 1
                       s!p := capitalch(ch)
                       ch := rdch()
                       $)
                   IF ch = '*N' THEN unrdch()

                   h := p
                   FOR z = 1 TO p
                   DO h := (h*13 + s!z) & #X7FF
                   writef(" Hash value = %N*N",
                       B.Dir.HashTableBase +
                       (h REM Size.HashTable))
                   ENDCASE
                   $)

        CASE 'I':  || Print file info
                   || Print the information in the
                   || first few words of the block
                   $(
                   LET type = blockbuff ! B.File.Type
                   LET data.block = ?

                   check.block.read()
                   IF (type & T.Deleted) \= 0
                   THEN writes(" Deleted")

                   type := type & (NOT T.deleted)
                   writef(" %S*N", VALOF
                   SWITCHON type
                   INTO
                       $(
                       CASE T.Long:
                            RESULTIS "Long file"
                       CASE T.Short:
                            RESULTIS "Short file"
                       CASE T.Data:
                            RESULTIS "Data block"
                       CASE T.List:
                            RESULTIS "List"

                       DEFAULT:
                            RESULTIS "Corrupt type"
                       $)
                   )

                   data.block := type = T.Data
                   writef(" Header key:       %N*N",
                          blockbuff ! B.File.Headerkey)
                   TEST data.block
                   THEN writes(" Sequence number:  ")
                   ELSE writes(" Highest seq num:  ")
                   writef("%N*N",
                          blockbuff ! B.File.HighestSeq)
                   writef(" Data size:        %N*N",
                          blockbuff ! B.File.Datasize)
                   TEST data.block
                   THEN writes(" Next data block:  ")
                   ELSE writes(" First data block: ")
                   writef("%N*N",
                          blockbuff ! B.File.FirstDataKey)
                   writef(" Checksum:         %N*N",
                          blockbuff ! B.File.Checksum)
                   UNLESS data.block
                   THEN
                   $(
                   LET datvec = VEC 14
                   writef(" Secondary type:   %S*N",
                     VALOF SWITCHON blockbuff!B.File.Secondarytype
                     INTO
                       $(
                       CASE ST.File: RESULTIS "File"
                       CASE ST.Root: RESULTIS "Root block"
                       CASE ST.UserDirectory:
                                     RESULTIS "User directory"
                       DEFAULT:      RESULTIS "(Unset)"
                       $) )
                    writef(" Info bits:        #X%X4*N",
                           blockbuff ! B.File.Infobits)
                    writef(" Parent Directory: %N*N",
                           blockbuff ! B.File.ParentDir)
                    writef(" Hash Chain:       %N*N",
                           blockbuff ! B.File.HashChain)
                    writef(" Filename:         *"%S*"*N",
                           blockbuff + B.File.Filename)
  /*                 IF zero.or.packet = 0
                   THEN
                     $( // Running as command
                     callseg(":L.dat-to-strings",
                        blockbuff+B.File.CreationDate,
                        datvec)
                     writef(" Created:          %S %S %S*N",
                             datvec+10, datvec, datvec+5)
                     $)
  */
                   $)
                   $)
                   ENDCASE


        CASE 'K':  || Calculate and check checksum
                   check.block.read()
                   $(
                   LET cs = block.checksum()

                   TEST cs = 0
                   THEN writes(" Checksum correct*N")
                   ELSE
                     $(
                     LET bad.cs = blockbuff ! B.File.Checksum
                     LET correct.cs = 0-(cs-bad.cs)
                     blockbuff ! B.File.Checksum := correct.cs
                     writef(" Checksum incorrect*N*
                            * Value in block was %N*N*
                            * Corrected to       %N*N",
                            bad.cs, correct.cs)
                     blockwrittenback := FALSE
                     $)
                   ENDCASE
                   $)


        CASE 'L':  || Locate words which match
                   || pattern under mask
                   match := TRUE
           search: $(
                   LET lwb = readvalue()
                   LET upb = size.block - 1
                   LET maskedpat = mask & pattern
                   check.block.read()
                   skiplayout()

                   UNLESS nullnumber
                   THEN
                       $(
                       UNLESS 0 <= lwb < size.block
                       THEN
                           $(
                           writes(" Invalid lower *
                                  *bound*N")
                           lwb := 0
                           $)

                       upb := readvalue()
                       UNLESS 0 <= upb < size.block
                       THEN
                           $(
                           writes(" Invalid upper *
                                  *bound*N")
                           upb := size.block - 1
                           $)
                       $)

                   FOR j = lwb TO upb
                   DO
                       $(
                       LET v = blockbuff ! j
                       IF TESTFLAGS(1) BREAK

                       IF ((v & mask) = maskedpat) = match
                       THEN
                           $(
                           writef(" %I3:", j)
                           printloc(j)
                           $)
                       $)
                   $)
                   ENDCASE

        CASE 'M':  || Set locate mask
                   mask := readvalue()
                   ENDCASE

        CASE 'N':  // Locate words which don't
                   // match pattern under mask
                   match := false
                   GOTO SEARCH

        CASE 'P':  || Put block back on disc
                   IF readdiscaddr()
                   THEN discaction(act.write)
                   ENDCASE

        CASE 'Q':  || Quit
                   freevec(blockbuff)
                   RETURN

        CASE 'R':  || Identify Root Block
                   writef(" Root Block is block %N*N",
                     RootKey)
                   ENDCASE

        CASE 'S':  || Set printing style
                   stringstyle := FALSE
                   charstyle   := FALSE

                   style := VALOF
                         SWITCHON capitalch(rdch())
                         INTO
                         $(
                         CASE 'C': charstyle := TRUE
                                   RESULTIS style

                         CASE 'S': stringstyle := TRUE
                                   RESULTIS style

                         CASE 'O': RESULTIS " %O6 "

                         CASE 'X': RESULTIS " %X4 "

                         CASE 'D': RESULTIS " %N "

                         DEFAULT:  writes(" Try c,s,o*
                                   *,x or d*N")
                                   RESULTIS style
                         $)

                   printloc(currword)
                   ENDCASE

        CASE 'T':  || Type range of locations
                   $(
                   LET lwb = readvalue()
                   LET upb = readvalue()

                   check.block.read()
                   IF nullnumber
                   THEN upb := lwb

                   FOR j = lwb TO upb
                   DO
                       $(
                       IF TESTFLAGS(1) BREAK
                       writef(" %I3: ", j)
                       printloc(j)
                       $)
                   $)
                   ENDCASE

        CASE 'V':  || Set value for locate
                   pattern := readvalue()
                   ENDCASE

        CASE 'W':  || Windup
                   UNLESS blockwrittenback
                   THEN UNLESS discaction(act.write)
                        THEN ENDCASE
                   freevec(blockbuff)
                   RETURN

        CASE 'X':  || Invert write protect mode
                   write.protected := NOT write.protected
                   writef(" Write protect mode %Sset*N",
                     write.protected -> "","un")
                   ENDCASE


        CASE 'Y':  || Set cylinder base
                   temp := readvalue()

                   UNLESS 0 <= temp <= maxcyl
                   THEN
                       $(
                       writef("Value should be in range*
                         * 0 to %N*N", maxcyl)
                       ENDCASE
                       $)

                   cylbase := temp
                   writef(" Cylinder base set to %N*N", cylbase)
                   ENDCASE


        CASE 'Z':  || Zero buffer
                   FOR i = 0 TO size.block - 1 DO
                     blockbuff ! i := 0
                   ENDCASE
        CASE '-': CASE '+': CASE '#':
        CASE '0': CASE '1': CASE '2':
        CASE '3': CASE '4': CASE '5':
        CASE '6': CASE '7': CASE '8':
        CASE '9':  || Read the offset in the buffer
                   || of the new current word
                   $(
                   LET n = ?
                   unrdch()

                   n := readvalue()
                   IF (n < 0) | (n >= size.block)
                   THEN
                       $(
                       writef(" Offset %N invalid*N", n)
                       ENDCASE
                       $)
                   currword := n
                   $)
                   ENDCASE

        CASE '=':  || Print default values set
                   writef(" Disc drive %N*N",drive)
                   writef(" Block number %N: cyl %N,*
                     * sur %N, sec %N*N", lbn, cyl,
                     sur, sec)
                   writef(" Cylinder base = %N*N*
                     * Write protect mode is %Sset*N*
                     * Current block is %Sup to date*
                     * on disc*N",
                     cylbase,
                     write.protected -> "", "not ",
                     (blockwrittenback -> "", "not ") )
                   writef(" Current word offset = *
                     *%N*N", currword)
                   writef(" Logical block number *
                     *base = %N*N", lbnbase)
                   ENDCASE

        CASE '/':  || Open location
                   $(
                   LET v = readvalue()

                   check.block.read()
                   TEST nullnumber
                   THEN printloc(currword)
                   ELSE
                       $(
                       blockbuff ! currword := v
                       blockwrittenback := FALSE
                       $)
                   $)
                   ENDCASE

        CASE '*'': || Row of characters
                   $(
                   LET stringbase = currword*bytesperword
                   LET boffset = stringbase
                   LET bofflim = size.block * bytesperword

                   check.block.read()
                   ch := readchar()

                   UNTIL (ch = '*'')
                   DO
                       $(
                       IF boffset >= bofflim
                       THEN
                           $(
                           writes(" Attempt to *
                             *overflow block*N")
                           BREAK
                           $)

                       putbyte(blockbuff, boffset, ch)
                       boffset := boffset + 1
                       ch := readchar()
                       $)
                   $)
                   blockwrittenback := FALSE
                   ENDCASE

        CASE '"':  || String
                   $(
                   LET stringbase = currword*bytesperword
                   LET boffset = stringbase + 1
                   LET bofflim = size.block * bytesperword

                   check.block.read()
                   ch := readchar()

                   UNTIL (ch = '"')
                   DO
                       $(
                       IF boffset >= bofflim
                       THEN
                           $(
                           writes(" Attempt to overflow*
                                  * block*N")
                           BREAK
                           $)

                       putbyte(blockbuff, boffset, ch)
                       boffset := boffset + 1
                       ch := readchar()
                       $)

                   || Fill in the length
                   putbyte(blockbuff,stringbase,
                          boffset-1-stringbase)
                   $)
                       blockwrittenback := FALSE
                   ENDCASE

        CASE '?':  writes(" See file :Doc.DiscedSpec*
                     * for a list of commands *
                     *available*N")
                   ENDCASE

        unknown:
        DEFAULT:   writef(" Unknown command %C*N", ch)
                   ch := rdch() REPEATUNTIL ch = '*N'
                   unrdch()
        $)
    $) REPEAT
    $)



.
SECTION "Disced2"

GET "DISCED"

LET skiplayout() BE
    $(
    LET c = rdch()

    WHILE (c = ' ') | (c = '*T')
    DO c := rdch()

    unrdch()
    $)


AND printloc(offset) BE
    $(
    IF (offset < 0) | (offset >= size.block)
    THEN
        $(
        writef(" Offset %N invalid*N", offset)
        RETURN
        $)

    TEST stringstyle
    THEN writef(" *"%S*" *N", blockbuff + offset)
    ELSE
        TEST charstyle
        THEN
            $(
            writes(" '")
            FOR j = 0 TO bytesperword-1
            DO wrch(getbyte(blockbuff+offset, j))
            writes("' *N")
            $)
        ELSE
            $(
            writef(style, blockbuff ! offset,
                (blockbuff!offset) >> 8)
            newline()
            $)
    $)


AND discaction(action) = VALOF
    $(
    || Does a disc read or write as specified by action,
    || using blockbuff. The disc address is given by the
    || globals cyl, sur and sec.
    LET s =  ?

    IF action = act.write
    THEN
      $(
      IF block.checksum() \= 0
      THEN writes(" ******Warning - *
            *block has incorrect *
            *checksum*N")

      IF write.protected
      THEN
        $( writes(" Write protect mode is set: block*
             * not written back*N")
           RESULTIS FALSE
        $)
      $)

    UNLESS 0 <= cyl <= maxcyl
    THEN
        $(
        writef(" Cylinder %N is out of range*N", cyl)
        RESULTIS FALSE
        $)

    FOR r = 1 TO 10
    DO
        $(
        s := sendpkt(notinuse,dddevid,action,?,?,
                     blockbuff,size.block,drive,cyl,sur,sec)

        IF s = 0
        THEN
            $(
            IF r > 2
            THEN writef(" %N tries needed to transfer*
                        * cyl %N, sur %N, sec %N*N",
                        r, cyl, sur, sec)
            IF action = act.read
            THEN block.read := TRUE

            blockwrittenback := TRUE

            writef(" Block %N %S (cyl %N, sur %N, sec %N)*N",
              lbn, (action=act.write-> "updated","read"),
              cyl, sur, sec)
            RESULTIS TRUE
            $)
        $)

    writef(" Transfer failed: cyl %N, sur %N, sec %N*
           *, status %O6*N",cyl,sur,sec,result2)
    RESULTIS FALSE
    $)




AND readdiscaddr() = VALOF
    $(
    || Reads a new disc address.
    || There are 2 possible cases:
    ||  (a) No numbers after the command - keep
    ||      the current address
    ||
    ||  (b) A new block number is specified.
    ||      Set globals cyl, sur and sec from it.
    ||
    || Exits with lbn, cyl, sur and sec set. Returns
    || TRUE if the address is valid, FALSE if an
    || error is detected.

    LET val = readvalue()
    UNLESS nullnumber
    THEN $( lbn := val; skiplayout() $)

    UNLESS convertdiscaddr(lbn+lbnbase)
    THEN RESULTIS FALSE

    RESULTIS TRUE
    $)



AND readchar() = VALOF
    $(
    || Returns the next character, after interpreting
    || escape combinations
    || If the character is the result of an escape
    || combination, then bit #X100 is set in the
    || result. This is so that unescaped quotes
    || can be detected by the caller.

    ch := rdch()

    TEST ch = '**'
    THEN
        $(
        ch := capitalch( rdch() )

        SWITCHON ch INTO
            $(
            CASE '**':RESULTIS '**' | escbit
            CASE '*'':RESULTIS '*'' | escbit
            CASE '*"':RESULTIS '*"' | escbit
            CASE 'N': RESULTIS '*N' | escbit
            CASE 'E': RESULTIS '*E' | escbit
            CASE 'S': RESULTIS '*S' | escbit
            CASE 'T': RESULTIS '*T' | escbit
            CASE 'B': RESULTIS '*B' | escbit

            CASE 'X': || Read 2 digit hex value
                      RESULTIS ((hexval(rdch()) << 4) +
                               hexval(rdch())) | escbit

            CASE '0': CASE '1': CASE '2':
            CASE '3': CASE '4': CASE '5':
            CASE '6': CASE '7':
                      || Read a 3 digit octal value
                      $(
                      LET val = ch - '0'

                      FOR i = 1 TO 2
                      DO
                          $(
                          ch := rdch()

                          UNLESS '0' <= ch <= '7'
                          THEN
                              $(
                              writef(" Invalid octal *
                              *digit %C*N", ch)
                              BREAK
                              $)

                          val := val*8 + ch - '0'
                          $)

                      IF val > 255
                      THEN writef(" Value %O3 too big*N",
                                   val)
                      RESULTIS val | escbit
                      $)

            DEFAULT:  writef(" Unknown escape %C*N",ch)
                      RESULTIS ch | escbit
            $)
        $)
    ELSE
        $(
        IF (ch = '*N') | (ch = '*E')
        THEN unrdch()

        RESULTIS ch
        $)
    $)


AND hexval(c) = VALOF
    $(
    || Gives the value of the hex digit c
    IF '0' <= c <= '9' THEN RESULTIS c - '0'
    IF 'a' <= c <= 'f' THEN RESULTIS c - 'a' + 10
    IF 'A' <= c <= 'F' THEN RESULTIS c - 'A' + 10
    writef(" Invalid hex digit %C*N", c)
    RESULTIS 0
    $)



AND convertdiscaddr(blockno) = VALOF
    $(
    || Sets globals cyl sur and sec.
    || Returns TRUE if blockno is valid, FALSE otherwise.

    IF (blockno >= nblocks) | (blockno < 0)
    THEN
        $(
        writef(" Block number %N is invalid*N", blockno)
        RESULTIS FALSE
        $)

    cyl := blockno/(N.Surfaces * N.blockspertrack) + cylbase
    sur := blockno REM N.Surfaces
    sec := (blockno/N.Surfaces) REM N.blockspertrack *
           N.SectorsPerBlock + Sector.Origin
    RESULTIS TRUE
    $)



AND readvalue() = VALOF
    $(
    || Reads: optionally signed decimal number
    ||        # octal number
    ||        #X hex number
    ||        '<single char>
    nullnumber := FALSE
    skiplayout()
    ch := rdch()

    SWITCHON ch INTO
        $(
        CASE '-': RESULTIS -readvalue()
        CASE '+': RESULTIS readvalue()

        CASE '#': ch := rdch()
                  TEST (ch = 'X') | (ch = 'x')
                  THEN RESULTIS readhexnum()
                  ELSE
                      $(
                      unrdch()
                      RESULTIS readoctnum()
                      $)

        CASE '*'':RESULTIS rdch()

        CASE '0': CASE '1': CASE '2':
        CASE '3': CASE '4': CASE '5':
        CASE '6': CASE '7': CASE '8':
        CASE '9': unrdch()
                  RESULTIS readn()

        DEFAULT:  nullnumber := TRUE
                  unrdch()
                  RESULTIS 0
        $)
    $)


AND readhexnum() = VALOF
    $(
    LET val = 0

    ch := rdch()

    UNLESS ('0' <= ch <= '9') |
           ('A' <= capitalch(ch) <= 'F')
    THEN nullnumber := TRUE

    WHILE ('0' <= ch <= '9') |
          ('A' <= capitalch(ch) <= 'F')
    DO
        $(
        val := (val << 4) + hexval(ch)
        ch := rdch()
        $)

    unrdch()
    RESULTIS val
    $)


AND readoctnum() = VALOF
    $(
    LET val = 0
    ch := rdch()

    UNLESS '0' <= ch <= '7'
    THEN nullnumber := TRUE

    WHILE ('0' <= ch <= '7')
    DO
        $(
        val := (val << 3) + ch - '0'
        ch := rdch()
        $)

    unrdch()
    RESULTIS val
    $)





AND check.block.read() BE
    UNLESS block.read
    THEN writes("****** WARNING - No block has been*
         * read into buffer!*N")


AND block.checksum() = VALOF
    $(
    LET cs = 0
    FOR z=0 TO size.block-1
    DO cs := cs + blockbuff!z

    RESULTIS cs
    $)