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

     /* This version has some commands builtin */

SECTION "CLI"

GET "LIBHDR"
GLOBAL $( CREATEDIRCOMM:180; LOADCOMM:181 ; TYPEHEXCOMM:182 $)
GET "CLIHDR"
GET "IOHDR"

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
              $( COPTR := CREATECO(START, CLI.DEFAULTSTACK)
                 GOTO NB
              $)
                UNLESS builtin=0 DO
                 coptr := createco(builtin, cli.defaultstack)

        NB:
              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 179    //***** temp
                 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)
              $)

              unless cli.module=0 do 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("createdir,load,typehex", s)
            INTO
    $( DEFAULT: RESULTIS 0
       CASE 0:  RESULTIS createdircomm
       CASE 1:  RESULTIS loadcomm
       CASE 2:  RESULTIS typehexcomm
    $)
$)

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

SECTION "CreateDir"

GET "LIBHDR"
GLOBAL $( createdircomm:180 $)

LET createdircomm() BE
$( LET v = VEC 50
   LET rc, res2 = 0, 0
   TEST rdargs("/A", v, 50)=0 THEN
   $( res2 := result2
      writes("Bad args*N")
      rc := 20
   $)
   ELSE
   $( LET obj = createdir(v!0)
      freeobj(obj)
      TEST obj=0
      THEN
      $( res2 := result2
         writef("Can't create directory %S*N", v!0)
         rc := 10
      $)
      ELSE
      $( LET cur = currentdir
         currentdir := locateDIR(v!0)
         freeobj(createdir("-"))
         deleteOBJ("-")
         freeobj(currentdir)
         currentdir := cur
      $)
   $)
   result2 := res2
   stop(rc)
$)
.
SECTION "LOAD"

GET "LIBHDR"

GLOBAL $( LOADCOMM:181 $)

LET LOADCOMM() BE
$( LET V = VEC 50
   LET N, W, R, S = ?, ?, ?, ?
   LET NN = 0
   LET OOUT = OUTPUT()

   IF RDARGS("NUM,FILE", V, 50)=0 DO
   $( WRITES("BAD ARGS*N")
      STOP(20)
   $)

   N := STRTONUM(V!0)
   UNLESS N>0 DO
   $( WRITES("N SHOULD BE > 0*N")
      STOP(20)
   $)

   W := GETVEC(N)
   IF W=0 DO
   $( WRITES("NOT ENOUGH STORE LEFT*N")
      STOP(20)
   $)

   HOLD(TASK.CONSOLEHANDLER)

   WHILE READW(@R) DO
   $( IF NN>N BREAK
      W!NN := R
      NN := NN+1
   $)

   WHILE GCH(@R) DO $( LET C = ? $)

   RELEASE(TASK.CONSOLEHANDLER)


   S := FINDOUTPUT(V!1)

   IF S=0 DO
   $( WRITES("CAN'T CREATE FILE")
      FREEVEC(W)
      STOP(20)
   $)

   SELECTOUTPUT(S)
   R := WRITEWORDS(W, NN)
   ENDWRITE(S)
   SELECTOUTPUT(OOUT)
   WRITEF("R = %X4*N", R)
   FREEVEC(W)
$)

AND strtonum(s) = VALOF
$( LET a = 0
   FOR i = 1 TO s%0 DO
   $( LET ch = s%i
      TEST '0'<=ch<='9' THEN a := 10*a + ch - '0'
                        ELSE RESULTIS 0
   $)
   RESULTIS a
$)

AND READW(AR) = VALOF
$( LET BL = ?
   LET BH = ?

   UNLESS GETB(@BL) RESULTIS FALSE
   UNLESS GETB(@BH) RESULTIS FALSE

   !AR := (BH<<8) | BL
   RESULTIS TRUE
$)

AND GETB(AB) = VALOF
$( LET NL = ?
   LET NH = ?

   UNLESS GCH(@NH) RESULTIS FALSE
   UNLESS GCH(@NL) RESULTIS FALSE

   !AB := (NH<<4) | NL
   RESULTIS TRUE
$)

AND GCH(AN) = VALOF
$( LET C = SCH()

   UNTIL C='$' | ('0'<=C<='9') | ('A'<=C<='F') DO C := SCH()

   IF C='$' RESULTIS FALSE

   !AN := C<='9' -> C-'0', C-'A'+10
   RESULTIS TRUE
$)

AND SCH() = SENDPKT(-1,-3,?,?,?) & #X7F

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

SECTION "TYPEHEX"
get "libhdr"
GLOBAL $( TYPEHEXCOMM:182 $)

let typehexcomm() be
$( let args = vec 50
   let instream = 0
   let outstream= 0
   let cycle = 0
   let word = ?
   let wdcount=0

   if rdargs("FROM/A,TO/K", args, 50)=0 do
   $( writes("bad arguments for TYPEHEX*n")
      stop(10)
   $)

   instream := findinput(args!0)
   if instream=0 do
   $( writef("can't open %s*n", args!0)
      stop(10)
   $)
   selectinput(instream)
   unless args!1=0 do
   $( outstream := findoutput(args!1)
      if outstream=0 do
      $( writef("can't open %s*n", args!1)
         endread()
         stop(10)
      $)
      selectoutput(outstream)
   $)

   while abs(readwords(@word,1))=1 do
   $( writef("%X4",word)
      if testflags(1) then
      $( writes("*N******BREAK*N")
         goto out
      $)
      wdcount:=wdcount+1
      wrch(wdcount rem 16 = 0 ->'*N','*S')
   $)
   unless wdcount rem 16 = 0 do
      wrch('*N')
out:
   endread()
   unless outstream=0 do endwrite()
$)