.NLIST
  .INCLUDE /ASCII.MAC/
  .INCLUDE /HWDF.MAC/
  .INCLUDE /DSMAC.MAC/
  .INCLUDE /MYMAC.MAC/
.LIST

MODULE NAME=<HMTERM>, VER=<2.2PL>, COMM=<XXDP+ OS Monitor - Terminal Engine>, TYPE=<NOSECT>

  .NLIST
    .INCLUDE /XXDPCM.MAC/
    .INCLUDE /XXDPDF.MAC/
  .LIST

  FROM HMINIT IMPORT X$XINI
  FROM HMBTCH IMPORT X$XBAT, BA$ENG
  ; Data
  FROM HMROOT IMPORT B$ASFN, B$AFNM
  FROM HMROOT IMPORT C$LBUF, C$LLIN, C$LLEN, C$LNXT, C$LFLD
  FROM HMROOT IMPORT CL$CMD, CU$ACT, CU$RET
  FROM HMROOT IMPORT D$RIOB
  FROM HMROOT IMPORT F$IBCT, F$IPTR, F$IPOS, F$ISVP, F$IRCK, F$ISCK
  FROM HMROOT IMPORT S$YCOM
  FROM HMROOT IMPORT S$YERR
  FROM HMROOT IMPORT S$YPND, S$YBAT
  FROM HMROOT IMPORT S$YPAD, S$YCOL, S$YPOP, S$YDAT, S$YLPT
  FROM HMROOT IMPORT S$YACT, S$YQUI
  FROM HMROOT IMPORT S$YSUP
  FROM HMROOT IMPORT S$YREL
  FROM HMROOT IMPORT S$YTPB, S$YTPS
  ; Proc
  FROM HMROOT IMPORT PUTCHA
  FROM HMROOT IMPORT RB$CHK

.IF EQ TERM.V-3
  FROM HMROOT IMPORT CL$HL2
.ENDC

  EXPORT QUALIFIED X$XTRA

  EXPORT QUALIFIED GETLIN, PARFLD, TYPMON, TYPMSG, PUTCHK, GETAVL, GETCHK, NEWLIN, PUTTAB
  EXPORT QUALIFIED OPNFIL, CLOFIL
  EXPORT QUALIFIED SETLIN, GETDAT, OCTASC, LPTMOD, TERMOD, LOASUP, PAROCT, PARDEC, PADTER
  EXPORT QUALIFIED PSHBAT, POPBAT
  EXPORT QUALIFIED GETCOM, TYPBRK

  EXPORT QUALIFIED TE$PUT, SU$UNP
  EXPORT QUALIFIED T$ENEW
  EXPORT QUALIFIED TE$CTC

  .MACRO Stack C D E F G H I J
    MAVAL.=0
   .IRP MANAM.,<C D E F G H I J>
     SP.'MANAM.=MAVAL.
     MAVAL.=MAVAL.+^O<2>
   .ENDR
  .ENDM Stack

  .PSECT XXDP3

  .SBTTL Terminal

  X$XTRA:

  ;
  ; TE$PUT - Display a single character
  ;
  ; in  R0 = character
  ;
  ; out R0 = character
  ;
  PROCEDURE TE$PUT
  BEGIN
    REPEAT
    UNTILB @S$YTPS MI #0	; until TPS ready
    LET @S$YTPB :B= R0		; out damned spot
    RETURN		
  END TE$PUT

  ;
  ; TE$CTC - Check ctrl/c
  ;
  ; in R0 = character to check
  ;
  ; CALL TE$CTC
  ;
  ; true  display "^C" and abort without an R0 message
  ; false return
  ;
  PROCEDURE TE$CTC
  BEGIN
    IFB R0 NE #CTRLC GOTO NOCTRL ; not ^C - are you looking at me?
    GOTO CTRL 			 ; yes - display
  END TE$CTC

  ;
  ; TE$CTL - Check control key
  ;
  ; in R0 = character
  ;
  ; CALL TE$CTL
  ;
  ; false BCC is not a control key
  ; true  BCS is a control key
  ;
  ; out R0 = character (whether true or false)
  ;          "^x" if control key and not null,tab,^Q,^S
  ;
  ; abort "^C" if ctrl/c
  ;
  ; DRS control keys:
  ;
  ; ctrl/c Temporarily halt a DRS batch file
  ; ctrl/z Terminate a DRS batch file
  ;
  PROCEDURE TE$CTL
  BEGIN

    ; if     not ^@ - null (GetCmd EPT) and not ^Z - Terminate DRS batch file
    ;    and not ^I - tab and not ^Q - resume output and not ^S - pause output

    IFB R0 NE #0 ANDB R0 LE #CTRLZ  ANDB R0 NE #HT ANDB R0 NE #a.dc1 ANDB R0 NE #a.dc3 THEN

    ; Put control character

  ENTRY CTRL

      LET  S$YPND :B= #0	; clear character pending
      PUSH R0			; save character
        LET  R0 :B= #'^		; "^"
        PutChk			; out 
        LET R0 := TOP SET.BY #100 ; control code -> ascii letter
        PutChk			; "^C"
      POP R0			; get the code back

      IFB R0 EQ #CTRLC		; ctrl/c?
        LET R0 := #0		; no message
        JmpAbt			; we're done here
      END

	CLC			; false - not a control key
    ELSE

      SEC			; true - fine
    END

  ENTRY NOCTRL

    RETURN
  END TE$CTL

  .SBTTL GETLIN, PARFLD							(EMT)

  Stack	R2,R3,R4,PC,PS

  ;
  ; GETLIN - Get Command Line service					(EMT 0)
  ;
  ; GetLin inputs a terminal or batch file command line
  ; GetLin restores the batch file input buffer and position if needed
  ; PopBat triggers a buffer restore to return to a prior batch file
  ;
  ; GetLin 
  ;   BCC EOF		; batch EOF
  ;
  ; out R0     -> command line
  ;     C$LNXT -> command line
  ;
  ; fail abort "? RD ERR" ; batch file read error
  ;
  PROCEDURE GETLIN
  BEGIN
    IFB S$YBAT NE #0 THEN	; if in a chain file

      ; Check batch context

      LETR R5 := #D$RIOB	; R5 -> IOB and relocate it
      CALL RB$CHK		; checksum the file block

    AND F$ISCK NE F$IRCK	; and if has it changed behind our backs?

      ; Restore batch context

      LETR R0 := #B$AFNM	; R0 -> file spec and relocate it
      OpnFil			; open sesame
      LET R4 := F$IPOS		; current file position

      LOOP
        LET R4 := R4 - #1	; advance to the current file location
        IF RESULT IS MI LEAVE LOOP ; one byte at a time
        ReaByt			; errors abort
      END

    END

    ; Common CLI/batch stream

  20$:
    LET R3     := #0		; rubout comes back to here
    LET R2     := C$LLIN	; R2 -> line
    LET C$LNXT := R2		; R2 -> first/next field

  30$:
    LOOP
      REPEAT
        GetChk			; get another character
        IF RESULT IS CC GOTO 110$ ; some error
      UNTILB R0 NE #0		; until got anything
				;
      IFB R0 EQ #LF GOTO 70$	; linefeed
      IFB R0 EQ #CR GOTO 80$	; carriage return

      CALL TE$CTL		; control character?
      IF RESULT IS CC GOTO 70$	; yes

      IFB R0 EQ #del LEAVE LOOP	; rubout

      ; uppercase conversion

      IFB R0 HIS #'a ANDB R0 LOS #'z THEN ; lowercase?
        LET R0 := R0 - #40	; make it uppercase
      END

      IF R3 LT C$LLEN THEN	; if not at end of buffer? if yes - echo and forget hack (note)
        LET R3 := R3 + #1	; nope - advance
        LET (R2)+ :B= R0	; and store
      END

    50$:
      IFB S$YQUI MI #0 GOTO 30$	; quietly?

      PutChk			; no - echo character
    END				; and get another

    LET R3 := R3 - #1		; delete/rubout

    IF RESULT IS MI GOTO 20$	; too far - restart line

    LET  R0 :B= -(R2)		; echo erased character
    GOTO 50$			; echo and get next 

    ; End of line

  70$:
    LET (R2)+ :B=  R0		; LF

  80$:
    LET (R2)+ :B= #0		; CR

    LET R1 := R0		; save character
    NewLin			; newline

    IFB R1 EQ #a.nak GOTO 20$	; delete line? yes - start over

    ;
    ; In batch mode:
    ;
    ; R1 = CR	gobble succeeding LF
    ; R1 = LF	thus never occurs in batch mode
    ;
    ; Save the read block checksum at each line end
    ;

    IFB S$YBAT NE #0 THEN	; in batch mode?
      LET F$IPOS := F$IPOS + #1	; yes - skip the LF position
      ReaByt			; and gobble the LF byte
      ;
      ; Accumulate the batch file checksum
      ;
      ; ReaBlk checksum (F$IRCK) is copied to F$ISCK at each end of line.
      ; Why? Because GETLIN has no way of knowing when a new block has been read in,
      ; however it does know that F$IRCK always has a valid block checksum.
      ;
      LET F$ISCK := F$IRCK	; save the block checksum
    END

    LET R0 := C$LNXT		; fine - R0 -> start of line (first field)

  ENTRY GL$SEC

    LET SP.PS+2(SP) := SP.PS+2(SP) SET.BY #C.BIT	; set return C.BIT (GETCHK branches here)

  110$:

    RETURN
  END GETLIN

  ;
  ; PARFLD - Parse Field service					(EMT 1)
  ;
  ; ParFld
  ;   fail BR EOL ; end-of-command reached
  ;        or NOP ; @R0=0 used as EOL test
  ;
  ;   fine  R0 ->   field line segment
  ;         R0 -> 0 EOL
  ;         R1 =    terminator
  ;
  ;   abort R0 -> "? Er"
  ;
  PROCEDURE PARFLD
  BEGIN
    LET R0 := C$LNXT		; current line position
    IFB -1(R0) NE #0 THEN	; if before EOL

      LOOP
        LET R1 :B= (R0)+	; next line character

        IF RESULT IS EQ LEAVE LOOP ; if no more

        .ADDR R3 := #70$	; terminators

        REPEAT
          IFB R1 EQ (R3)+ GOTO 40$ ; if a terminator ...
        UNTILB (R3) EQ #0	; until didn't get more to come

      END			; no - look at next line character
    
      ; Good return 

    40$:
      LET C$LFLD := C$LNXT	; save field starting point
      LET C$LNXT := R0		; setup new field
      LET R0 := C$LFLD

  ENTRY gf$sec			; gf$sec called by PAROCT

      LET TOP := TOP + #2	; good return
    END

    RETURN

  70$:
    .ASCIZ " /:-=<"<HT>		; terminator list
    .EVEN
  END PARFLD

  .SBTTL TYPMON TYPMSG TYPBRK PUTCHK GETAVL GETCHK NEWLIN PUTTAB	(EMT)

  ;
  ; TYPMON - Type monitor message service				(EMT 2)
  ;
  ; in R0 -> message
  ;
  ; TypMon
  ;
  PROCEDURE TYPMON
  BEGIN
    .ADDR3 R0 := R0		; relocate monitor string
    $GOTO TYPMSG
  END TYPMON

  ;
  ; TYPMSG - Type message service					(EMT 3)
  ;
  ; in R0 -> zero-terminated message
  ;
  ; burnt R0
  ;
  PROCEDURE TYPMSG
  BEGIN
    IFB S$YQUI PL #0 THEN	; are we no quiet?

      LET R2 := R0		; make a pointer
      LOOP
        LET R0 :B= (R2)+	; another
        IF RESULT IS EQ LEAVE LOOP ; done
        PutChk			; out it goes
      END			; more

    END
    RETURN
  END TYPMSG

  ;
  ; TYPBRK - Type Breakthrough message service				(EMT 44)
  ;
  ; Display message even in quiet mode
  ;
  ; in R0 -> zero-terminated message
  ;
  ; burnt R0
  ;
  PROCEDURE TYPBRK
  BEGIN
    LET -(SP)  :B= S$YQUI	; save quiet mode flag
      LET S$YQUI :B= #0		; switch off quiet mode
      TypMsg			; tell the world
    LET S$YQUI :B= (SP)+	; restore quiet mode flag
    RETURN
  END TYPBRK

  ;
  ; PUTCHK - Put Character and check for ctrl/c service			(EMT 4)
  ;
  ; in R0 character
  ;
  ; PutChk
  ;
  ; Abort Ctrl/C
  ;
  PROCEDURE PUTCHK
  BEGIN
    CALL PUTCHA			; output char and check keyboard
    CALL TE$CTC			; check ctrl/c
    RETURN
  END PUTCHK

  ;
  ; GETAVL - Get Available character service				(EMT 5)
  ;
  ; fine R0     character
  ;      S$YPND character as pending
  ;
  ; GetAvl is followed by GetChk to gobble the pending character
  ; GetAvl is also called by GetChk and PutCha
  ;
  PROCEDURE GETAVL
  BEGIN

  .IF EQ TERM.V-1
    IFB @#TKS MI #0		; are we relevant?
      LET R0 := @#TKB		; the good old TKB
      LET R0 := R0 OFF.BY #^C<^O<177>> ; 7 bits only

      IFB R0 NE #a.dc1 THEN	; ^Q ? - continue output

        IFB R0 NE #a.dc3 GOTO 30$ ; ^S ? - continue output

        LET R0 := #0

        LOOP
          REPEAT
          UNTILB @#TKS MI #0	; who is waiting for us?

          IFB #a.dc1 EQ @#TKB GOTO 30$

          LET R0 := @#TKB	; the good old TKB
        END

      END

      LET R0 := #0

    30$:
      LET S$YPND :B= R0		; pending input character
    END

  .ENDC

  .IF EQ TERM.V-3
    LET R0 := #0		;  a flag
  .ENDC

  .IF EQ <TERM.V-2>*<TERM.V-3>
    PUSH R1			; save R1
    IFB @#TKS MI #0		; are we relevant?
      LET -(SP) :B= #0		; result character

    .IF EQ TERM.V-2
      LET R0    := #0		;  a flag
    .ENDC

      REPEAT

        LET R1 := R0		; R1 = a.dc3 => loop
    20$:
        REPEAT
        UNTILB @#TKS MI #0	; who is waiting for us?

        LET R0 :B= @#TKB	; the good old TKB
        LET R0 := R0 OFF.BY #^C<^O<177>> ; 7 bits only

        IFB R0 EQ #a.dc1 GOTO 30$ ; ^Q ? - continue output

      UNTILB R0 NE #a.dc3	; ^S? - wait for ctrl/q

      LET TOP :B= R0		; save anything else

      IFB R1 NE #0 GOTO 20$	; if seen a.dc3 - wait for Ctrl/Q

    30$:
      LET S$YPND :B= TOP	; pending input character
      LET R0     :B= (SP)+	; return it in R0
    END

    POP R1			; restore that
  .ENDC

    RETURN
  END GETAVL

  ;
  ; GETCHK - Get character, check ctrl/c				(EMT 6)
  ;
  ; GetChk
  ;   fail BCC EOF  ; batch EOF only	
  ;
  ;   fine R0 =	char
  ;
  ;   abort "Rd Er" ; batch file read error
  ;
  PROCEDURE GETCHK
  BEGIN

    IFB S$YBAT NE #0		; if batch
      ReaByt			; get yet another
        BCC 50$			; failed
      LET F$IPOS := F$IPOS + #1	; count it
      GOTO 40$			; return
    END

				; keyboard
    LET R0 :B= S$YPND		; got pending input character? yes - use that

  .IF EQ TERM.V-1
    IF RESULT IS NE GOTO 40$	; no
  .ENDC

  .IF EQ TERM.V-2
    IF RESULT IS NE GOTO 30$	; no
  .ENDC

  .IF EQ TERM.V-3
    IF RESULT IS EQ THEN        ; no
  .ENDC

      ; Keyboard spin loop

      REPEAT
        GetAvl			; get available
      UNTIL R0 NE #0		; until  got something
				;
      CALL TE$CTC		; check ctrl/c

  .IF EQ TERM.V-3
    END
  .ENDC

.IF EQ <TERM.V-1>*<TERM.V-3>
    LET S$YPND :B= #0		; pend no more 
.ENDC

.IF EQ TERM.V-2

  30$:
    LET S$YPND :B= #0		; pend no more 
.ENDC

  40$:
    GOTO GL$SEC			; fine: EMT c=1 (GetLin GL$SEC sets carry)

  50$:
    RETURN			; fail: EMT c=0 (batch EOF only)
  END GETCHK

  ;
  ; NEWLIN - NewLine service						(EMT 7)
  ;
  T$ENEW:
    .ASCIZ <CR><LF>		; also used by BU$NEW
    E.VEN

  PROCEDURE NEWLIN
  BEGIN
    LET R0 := #T$ENEW		; newline string
    TypMon			; out, relocated
    RETURN			; life can be easy sometimes
  END NEWLIN

  ;
  ; PUTTAB service							(EMT 10)
  ;
  ; Advances to next 8-column tab stop
  ;
  PROCEDURE PUTTAB
  BEGIN
    REPEAT
      LET R0 :B= #SPACE		; a SPACE
      PutChk			; output
    UNTILB #7 OFF.IN S$YCOL	; until check no more columns
    RETURN
  END PUTTAB

  .SBTTL PAROCT OPNFIL							(EMT)

  ;
  ; PAROCT - Parse octal service					(EMT 11)
  ;
  ; in field "12345"
  ;
  ; ParOct
  ;   fail  BR error
  ;
  ;   fine  R0 = octal value
  ;         R1 = terminator
  ;
  PROCEDURE PAROCT
  BEGIN
    ParFld			; R0 -> field
      GOTO 30$			; error return
    LET R4 :=  R1		; R4 = terminator
    LET R3 :=  #0		; R3 = result octal
    LET R1 :B= (R0)		; check end-of-line conditions

    IF RESULT IS NE ANDB (R0) NE #LF THEN ; if not EOL (zero) and not LF

      ; digit loop

      REPEAT
        LET R2 :B= (R0)+	; R2 = next character

        IFB R2 EQ R4 GOTO 20$	; if the terminator?

        LET R2 := R2 - #'0	; de-ascii

        IF RESULT IS MI GOTO 30$ ; that ain't no digit
        IF R2 GT #7     GOTO 30$ ; over seven? - that ain't no digit

        LET R3 := R3 L.SHIFT 3 + R2 ; multiply accumulator by eight and add us in

      UNTILB (R0) EQ #LF	; until end-of-line

      LET R1 :B= (R0)		; yes - reply with terminator

    20$:
      LET  R0 := R3		; R0 = result; R1 = terminator
      GOTO gf$sec		; GetFil set carry exit
    END

  30$:
    RETURN
  END PAROCT

  ;
  ; OPNFIL - Open file service						(EMT 12)
  ;
  ; in R0 -> ascii "filnam.typ"
  ;
  ; OpnFil
  ;
  ; out R1 burnt
  ;
  ; OPNFIL formats the file spec as SPACE-filled template
  ; Where "_" represents the SPACE, the name "XXX.SYS" becomes:
  ;
  ;  "XXX___.SYS"
  ;   0123456789
  ;
  PROCEDURE OPNFIL
  BEGIN
    LETR R5 := #D$RIOB		; R5 -> IOB
    LET F$IPTR := #0		; file pointer ground zero
    LET F$IBCT := #0		; null byte count
    LET R1 := R5 + #IO.SPC	;  R1 -> IO.SPC
    LET R2 := R1		; R2 -> IO.SPC
    LET R3 := #^D<10>		; .ASCIZ "123456.89A"

    REPEAT
      LET (R2)+ :B= #SPACE	; SPACE fill the name 
      LET R3 := R3 - #1		; all ten
    UNTIL RESULT IS EQ
				; R1 -> IO.SPC
    LET R2 := R1		; R2 -> IO.SPC
    LET R3 := #^D<10>		; R3 = count = 10.

    REPEAT
      IFB (R0) EQ #0 LEAVE LOOP	; if end of string

      IFB (R0) EQ #'. THEN	; at the file type?
        LET R2 := R1 + #6	; yes, position at byte six of the output string
      END			; count is now three, for the file type

      LET (R2)+ :B= (R0)+	; copy one more
      LET R3 := R3 - #1		; until all done
    UNTIL RESULT IS LE

    CALL @DR.OPN(R5)		; the driver opens the file
    LET   IO.BLK(R5) := DR.SBL(R5) ; file start block
    $GOTO CLOFIL		; exit via CloFil return
  END OPNFIL

  ;
  ; CLOFIL - Close file service						(EMT 13)
  ;
  ; CLOFIL is deprecated in the XXDP+ and XXDP V2 monitors
  ;
  PROCEDURE CLOFIL
  BEGIN
    RETURN			; much ado about nothing
  END CLOFIL

  .SBTTL SETLIN OCTASC							(EMT)

  ;
  ; SU$UNP - Convert Rad50 to Ascii utility
  ;
  ; Invalid characters are cheerfully converted to nonsense
  ; Called only by SpcAsc
  ;
  ; in  R0    =  rad50 word to translate
  ;     R2    -> output ascii (no zero byte terminator)
  ;
  ; out	R0    burnt
  ;     R2    -> past ascii 
  ;     R3/R4 burnt	
  ;
  PROCEDURE SU$UNP
  BEGIN
    .ADDR R4 := #80$		; rad50 divisors

    REPEAT
      LET R3 := #0		; result integer

      WHILE (R4) LOS R0		; got another subtraction?
        LET R0 := R0 - (R4)	; subtract
        LET R3 := R3 + #1	; and count
      END

      IF  R3 EQ #0     GOTO 10$	; nulls are SPACEs (16+11+11=40)
      IFB R3 EQ #33    GOTO 30$	; a rad50 dollar sign? yes - range 33-33 (33+11=44='$')
      IF  RESULT IS GT GOTO 20$	; digit

      LET R3 := R3 + #40	; alphabet range 1:32 (1+40+16+11+11=101="A")

    10$:
      LET R3 := R3 + #16	; SPACE

    20$:
      LET R3 := R3 + #11	; digit range 30:39 (36+11+11=60='0')

    30$:
      LET R3 := R3 + #11	; $

      LET (R2)+ :B= R3		; store the byte
      TST (R4)+			; next divisor
    UNTIL (R4) EQ #0		; until end of list

    RETURN

  80$:
    .WORD ^O<50*50>, ^O<50>, ^O<1>, ^O<0> ; rad50 divisors
  END SU$UNP

  ;
  ; SETLIN - Set command line service					(EMT 26)
  ;
  ; in  R0 = buffer address
  ;     R1 = buffer length
  ;     R0 = 0 => use defaults (C$LBUF, CLLEN.)
  ;
  ; SetLin
  ;
  ; out R0 = effective buffer address
  ;     R1 = effective buffer length
  ;
  PROCEDURE SETLIN
  BEGIN
    IF R0 EQ #0 THEN		; if default
      LETR R0 := #C$LBUF 	; C$OLIN
      LET  R1 := #CLLEN.	; 54 byte command line
    END
    LET C$LLIN := R0		; line pointer
    LET R1     := R1 - #2	; length - 2 for termination
    LET C$LLEN := R1		; store available length
    LET C$LNXT := R0		; next is current
    RETURN
  END SETLIN

  ;
  ; GETDAT - Get date service						(EMT 27)
  ;
  ; out R0 system date
  ;
  PROCEDURE GETDAT
  BEGIN
    LET R0 := S$YDAT		; 1970-1999
    RETURN
  END GETDAT

  ;
  ; OCTASC - Octal to Ascii service					(EMT 30)
  ;
  ; Convert an octal value to an ascii string
  ; Strings are zero-filled (e.g. value=1 => string="000001")
  ;
  ; in R0  =  value
  ;    R1  -> output buffer
  ;
  ; OctAsc
  ;
  ; out R0 burnt
  ;     R1 -> past last (sixth) digit
  ;
  PROCEDURE OCTASC
  BEGIN
    LET R3 := R0		; R3 = value
    LET R4 := #6		; R4 = counter
    LET R0 := #0		; R0 = result digit
    LET R3 := R3 L.SHIFT 1	; high order single bit out
    LET R0 := R0 L.ROTATE 1	; into R0 as the low order bit

    LOOP
      LET R0    :=  R0 + #'0	; make it ascii
      LET (R1)+ :B= R0		; store a byte
      LET R4    :=  R4 - #1	; all digits done?

      IF RESULT IS LE LEAVE LOOP ; nope

      LET R0 := #0		; reset accumulator
      LET R3 := R3 L.SHIFT 1	; rotate full digit into R0
      LET R0 := R0 L.ROTATE 1
      LET R3 := R3 L.SHIFT 1	
      LET R0 := R0 L.ROTATE 1
      LET R3 := R3 L.SHIFT 1	
      LET R0 := R0 L.ROTATE 1
    END

    RETURN
  END OCTASC

  .SBTTL LPT/TERMOD LOASUP PARDEC PADTER PSH/POPBAT GETCOM		(EMT)

  ; This code page finishes exactly at the 12000 boundary
  ; It must have been linked /high

  ;
  ; LPTMOD - Output to printer service					(EMT 33)
  ;
  PROCEDURE LPTMOD
  BEGIN
    LET R2 := S$YLPT		; got a printer or something else?
    IF RESULT IS NE THEN
      LET S$YTPS := R2		; csr
      TST (R2)+
      LET S$YTPB := R2		; buffer
    END
    RETURN
  END LPTMOD

  ;
  ; TERMOD - Output to terminal service					(EMT 34)
  ;
  PROCEDURE TERMOD
  BEGIN
    LET S$YTPS := #TPS		; csr
    LET S$YTPB := #TPB		; buffer
    RETURN
  END TERMOD

  ;
  ; LOASUP - Load DRS-11 supervisor HSAA??.SYS service			(EMT 35)
  ;
  ; Batch mode activates supervisor directly
  ; Takes EMT return path (via cu$swi return)
  ;
  ; CLI mode activates the supervisor via CU$ACT
  ; Treats supervisor return as image exit, jumping to CL$CMD
  ;
  PROCEDURE LOASUP
  BEGIN
    .ADDR R0 := #20$		; R0 -> "HSAA??.SYS"
    LET   R1 := S$YSUP		; location
    LoaFil			; read it in
    LET   S$YERR := #0

    IFB S$YBAT NE #0		; if in batch mode

      ; Batch-mode activation

      CALL   @S$YACT		; Batch supervisor activation

    .IF EQ <TERM.V-1>*<TERM.V-2>
      JUMPTO CU$RET		; return via CU$RET return		(note)
    .ENDC

    .IF EQ TERM.V-3
      JUMPTO CL$HL2		; return via CL$HL2(???)
    .ENDC

    END

    ; CLI-mode activation

    CALL   CU$ACT		; CLI supervisor activation
    JUMPTO CL$CMD		; supervisor image exit to CLI engine

  20$:
    .ASCIZ "HSAA??.SYS"		; supervisor file spec
    E.VEN
  END LOASUP

  ;
  ; PARDEC - Parse decimal service					(EMT 36)
  ;
  ; in command line field
  ;
  ; ParDec
  ; fail BR error	; invalid string
  ;
  ; fine R0 =		decimal number
  ;
  PROCEDURE PARDEC
  BEGIN
    ParFld			; isolate the field
      GOTO 30$			; errors have a fail return
    LET R2 := #0		; clear result

    LOOP
      LET R3 :B= (R0)+		; next digit

      IFB R1 EQ R3 LEAVE LOOP	; if this is the terminator (in R1)?

      LET R3 := R3 - #'0	; de-ascii it
      IF RESULT IS LT GOTO 30$	; below the digit range
      IF R3 GT #^D<9> GOTO 30$	; above the range?

      LET R2 := R2 L.SHIFT 1	; R2 * 2
      LET R3 := R3 + R2		; save R2 * 2
      LET R2 := R2 L.SHIFT 2	; R2 * 4 -> R2 * 8
      LET R2 := R2 + R3		; plus R2*2 = R2 * 10

    END

    LET R0 := R2		; result to R0
    LET TOP := TOP + #2		; fine skip

  30$:
    RETURN			; fail return
  END PARDEC

  ;
  ; PADTER - Pad terminal service					(EMT 37)
  ;
  ; Write S$YPAD nulls to terminal
  ;
  ; PutCha invokes PadTer after outputting CR
  ;
  PROCEDURE PADTER
  BEGIN
    LET R2 :B= S$YPAD		; get a counter
    REPEAT
      LET R0 :B= #0		; nulls to pad with
      PutCha			; at least one goes out
      LET R2 := R2 - #1		; count
    UNTIL RESULT IS LE		; more
    RETURN
  END PADTER

  ;
  ; POPBAT - Pop batch chain file service				(EMT 40)
  ;
  ; Restore prior chain file or CLI context
  ;
  ; out R0/R1 preserved
  ;
  PROCEDURE POPBAT
  BEGIN
    LET   S$YPOP :B= S$YPOP + #1 ; flag pop (not push)
    $GOTO PSHBAT		 ; combine code path
  END POPBAT

  ;
  ; PSHBAT - Push batch chain file service				(EMT 41)
  ;
  ; in  R0 -> "filnam" field
  ;     R1 =  field terminator
  ;
  ; out R0 -> end of copied "filnam" string
  ;     R1 =  terminator
  ;
  PROCEDURE PSHBAT
  BEGIN
    LET  F$ISCK := #0		; invalidate batch saved checksum

    LETR R2     := #B$AFNM	; R2 <- current file spec
    PUSH R2			; (SP) -> ditto

    LETR R3     := #B$ASFN	; R3 -> saved file spec
				;
    IFB S$YPOP NE #0 THEN	; popping?
      LET R4 := R3		; popping - reverse the pointers
      LET R3 := R2		; R2 -> R3
      LET R2 := R4		; R3 -> R4 -> R2
    END

    ; Copy loop

    LET R4 := #^D<10>		; filespec counter

    REPEAT
      LET (R3)+ :B= (R2)+	; copy
      LET R4    :=  R4 - #1	; count
    UNTIL RESULT IS EQ

    POP R2

    IFB S$YPOP EQ #0 THEN	; push batch?

      ; PshBat coda

      REPEAT
        LET (R2)+ :B= (R0)+	; push - copy in new filename
      UNTILB (R0) EQ R1		; R1 = gtfld terminator

      LET (R2)   :B= #0		; terminate string
      LET F$ISVP := F$IPOS	; save current batch level position
      LET F$IPOS := #0		; clear forces GetLin to open new file
      LET R0     := R2		; R0 -> end of "filnam"
      LET S$YBAT :B= S$YBAT + #1 ; => GetLin opens/reads the chain file 

    ELSE

      ; PopBat coda

      ; Decrement the batch "stack" and restore the prior file position
      ; GetLin does all the rest of the work

      LET S$YBAT :B= S$YBAT - #1 ; decrement batch file stack
      LET S$YPOP :B= #0		; clear one-shot emt 40/41 flag
      LET F$IPOS := F$ISVP	; restore prior file position
    END

    RETURN
  END PSHBAT

  ;
  ; GETCOM - Get communication area address service			(EMT 42)
  ;
  ; GETCOM returns a pointer to S$YCOM, the system communication area
  ;
  ; GetCom
  ;
  ; out R0 -> S$YCOM
  ;
  ; UPD1 emits GetCom as part of its startup procedure, however it seems to reference a nonsense location in the high syscom.
  ;
  PROCEDURE GETCOM
  BEGIN
    LETR R0 := #S$YCOM		; point to S$YCOM and relocate
    RETURN
  END GETCOM

END HMTERM

.END