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

MODULE NAME=<HMROOT>, VER=<2.2PL>, COMM=<XXDP+ OS Monitor>, TYPE=<NOSECT>

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

  ;
  ; HMROOT.MAC reconstructs the XXDP+ operating system source
  ;
  ; Build procedure (RT-11):
  ;
  ;   MACRO/LIST:HMROOT HMROOT
  ;   LINK/NOBITMAP/LDA HMROOT
  ;
  ; Edit History:
  ;
  ;   01 01-Jan-2000 IJH Disassemble and study XXDP+
  ;   02 14-Mar-2021 IJH Complete initial source code recovery
  ;   03 10-Jun-2022 KXX Changes too use DSMAC macros packages
  ;
  ; Source introduction:
  ;
  ; XXDP was/is the diagnostic operating system for PDP-11 computers.
  ; This source file was created by reverse assembling the binary image of the XXDP+ HMROOT monitor found on XXDP23 distribution.
  ;
  ; XXDP constitutes the de factor definition of the PDP-11, as anyone who writes an emulator soon finds out.
  ; It's the toughest the PDP-11 systems, case-hardened by its use on only partially functioning systems.
  ;
  ; XXDP's architecture is based on a simple, near-boolean level state machine.
  ; There is rarely any analytic vagueness regarding system state.
  ;
  ; XXDP has a remarkably flat structure. Registers rarely need to be saved/restored across routines (less than 10 instances).
  ; All parameters and results are passed in registers, obeying a strict usage protocol.
  ;
  ; Because of the fixed space restrictions placed on the monitor, code compression was always required to find space
  ; for new functionality. XXDP uses many software techniques to achieve that goal. The code is heavily compressed.
  ;
  ; One overarching simplification is the almost complete absence of sanity testing.
  ; It will accept any disk volume as an XXDP volume, no matter how crazy the directory structure might appear.
  ; It tests only for conditions that make it impossible to continue.
  ;
  ; The original XXDP+ would of course have had separate source modules for the monitor and the various drivers.
  ; For this stage of the recovery process I've thought it best to have everything in a single source module
  ; with no external dependencies.
  ;
  ; The monitor source code translation is complete with this release.
  ; However, the documentation requires a programmer's guide and a system logic manual, at some distant point in time.
  ; For clarity I have not used macro definitions for system EMT calls in this, preferring to see all
  ; the binary code instructions. A later release should employ macros for system calls. The comments can also be improved.
  ;
  ; The XXDP monitor itself is restricted to read-only support for system media. The other half of the system,
  ; that creates and writes files, is buried in a DRVCOM package that are embedded in the UPD1, UPD2, PATCH and XTECO utilities
  ; and the stand-alone drivers.
  ;
  ; I began looking at XXDP around year 2000 when I used it to test a PDP-11 emulator I'd written.
  ; I got curious and wrote a simple disassembler and began annotating it (which I came back to in 2010 and 2015).
  ; At first I approached the project as an act of diligence:
  ;   I thought the source was important for the history of the PDP-11. 
  ;   However, it turned out to be a fascinating task and it was a real joy to see the operating system as a whole slowly emerge.
  ;   There were	so many subtleties to be discovered. There's some horrible HELLO WORLD coding here and there,
  ;   but most of it is tight and the state machine design is highly disciplined.
  ;
  ; Some grateful acknowledgements:
  ;
  ; I spent so much time in Al Kossow's amazing bitsavers.org that I thought I should start paying rent.
  ; I crawled endlessly through diagnostics, looking for tiny clues.
  ;
  ; Joerg Hoppe's extensive XXDP microfiche contributions to bitsavers included some critical sources.
  ; A sometime DEC diagnostic programmer, Michael Moroney, who visited alt.sys.pdp11 some years ago,
  ; was kind enough to dig up and send me	a copy of MACROM.MAC, the XXDP+ system macro module,
  ; which was truly invaluable: I had "names" for the system services.
  ;
  ; There have been quite a few valuable websites that have dedicated time and
  ; space to XXDP over the years from which I have gleaned information.
  ;

  FROM HMINIT IMPORT X$XINI
  FROM HMBTCH IMPORT X$XBAT, BA$ENG
  FROM HMTERM IMPORT X$XTRA
  FROM HMTERM IMPORT GETLIN, PARFLD, TYPMON, TYPMSG, PUTCHK, GETAVL, GETCHK, NEWLIN, PUTTAB
  FROM HMTERM IMPORT OPNFIL, CLOFIL
  FROM HMTERM IMPORT SETLIN, GETDAT, OCTASC, LPTMOD, TERMOD, LOASUP, PAROCT, PARDEC, PADTER
  FROM HMTERM IMPORT PSHBAT, POPBAT
  FROM HMTERM IMPORT GETCOM, TYPBRK
  FROM HMTERM IMPORT TE$PUT, SU$UNP
  FROM DRIVER IMPORT X$XDRV, SYCSR., D$PUFD, DR$TRA, DR$DEV, DR$OPN, DR$RST ; DKDRV, DLDRV and etc

  ; Data
  EXPORT QUALIFIED B$ASFN, B$AFNM
  EXPORT QUALIFIED C$LAUT, C$LBUF, C$LLIN, C$LLEN, C$LNXT, C$LFLD
  EXPORT QUALIFIED CL$CMD, CU$ACT, CU$RET
  EXPORT QUALIFIED D$RUNI, D$RCSR, D$RIOB, D$RDIS
  EXPORT QUALIFIED F$IBCT, F$IPTR, F$IBUF, F$IPOS, F$ISVP, F$IRCK, F$ISCK
  EXPORT QUALIFIED H$WLTC, H$WKWP
  EXPORT QUALIFIED I$NR2,  I$NR6,  I$NR7,  I$NR8,  I$NR9,  I$NR13, I$NR14
  EXPORT QUALIFIED S$YCOM
  EXPORT QUALIFIED S$YDEV, S$YCSR, S$YUNI
  EXPORT QUALIFIED S$YEMT
  EXPORT QUALIFIED S$YERR
  EXPORT QUALIFIED S$YGTO
  EXPORT QUALIFIED S$YPND, S$YQVS, S$YBAT
  EXPORT QUALIFIED S$YPAD, S$YCOL, S$YPOP, S$YDAT, S$YLTC, S$YKWP, S$YLPT
  EXPORT QUALIFIED S$YLOA, S$YSTA, S$YACT, S$YRPT, S$YQUI
  EXPORT QUALIFIED S$Y5CK, S$YCFG, S$YKWD, S$YPER, S$YPGS, S$YREL, SPBOT, S$YSUP, S$YTOP
  EXPORT QUALIFIED S$YLTK, S$YKTK, S$YTPB, S$YTPS, S$YTRA
  EXPORT QUALIFIED X$XPER, XX$RST

  ; Proc
  EXPORT QUALIFIED PUTCHA
  EXPORT QUALIFIED RB$CHK
  EXPORT QUALIFIED CU$CND
  EXPORT QUALIFIED CL$LOA
  EXPORT QUALIFIED EM$ENG, EM$RST
  EXPORT QUALIFIED MO$RST

.IF EQ ROOT.V-3
  EXPORT QUALIFIED CL$HL2
.ENDC

  .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

  .SBTTL Monitor structure						(data)

;;;!  MOOVL. =: ^O<1414>				; monitor overlay length

;;;!
;;;!  ; Init information block
;;;!
;;;!  ; IN.50H =: ^O<0>	;1000	; 50 hertz flag
;;;!  ; IN.AUT =: ^O<2>	;1002	; automated startup flag
;;;!

  .PSECT XXDP4

  .SBTTL XXDP CLI Engine						(CLI)

  ; 12000
  X$XPER:

  ; The area 12000:14000 is reread from disk on chain exit
  ; Thus there should be no impure data in this area

  O$VREG:			; overlay region
  O$VCLI:			; CLI overlay block

  ;
  ; CL$ABT - CLI abort routine
  ;
  PROCEDURE CL$ABT
  BEGIN
    IF R0 EQ #0 GOTO cl$eng	; if didn't get a message - just start over

  .IF EQ ROOT.V-1
    NewLin			; newline
    TypMon			; display message
  .ENDC

  .IF EQ <ROOT.V-2>*<ROOT.V-3>
    TypMon			; display message
    NewLin			; newline
  .ENDC

    $GOTO XX$RST
  END CL$ABT

  ;
  ; XX$RST - XXDP system start and restart address
  ;
  ; The init process completes by jumping to XX$RST
  ; XX$RST is the advertised system restart address
  ;
  ; RESTART ADDR: 152010
  ; THIS IS XXDP+...
  ;
  PROCEDURE XX$RST
  BEGIN

  ENTRY cl$eng

    LETR SP := #SPBOT		; restore stack relocate
    CALL EM$RST			; restore EMT vector

    ; Calls CL$CMD immediately below with a dummy RTI set PR7

    PUSH #PR7			; build dummy int. frame
    .ADDR -(SP) := #CL$CMD	; 12040 below
    RTI				; rti-as-call
  END XX$RST

  ;
  ; CLI engine command loop
  ;
  ; Image exit path
  ; Command prompt/parse
  ;
  PROCEDURE CL$CMD
  BEGIN
    .ADDR R0 := #CL$ABT		; abort restarts XXDP
    SetAbt			; CL$ABT ; generic CLI abort
    CALL MO$RST			; restore monitor
    TerMod			; cancel LPT mode
    NewLin
    LET R0 :B= #'.		; command prompt "."
    PutChk			; say so
    LET R0 := #0		; reset the line buffer
    SetLin
    IF C$LAUT EQ #0		; has copy of @#I$NAUT from the boot
      GetLin			; get a command line
    END
    CALL CL$DIS			; dispatch command
    GOTO cl$eng			; and get another
  END CL$CMD

  ; The boot value at @#I$NAUT is copied here

  C$LAUT:
    .WORD 0			;@#I$NAUT flag

  ;
  ; CL$DIS - CLI command dispatch
  ;
  PROCEDURE CL$DIS
  BEGIN
    IF C$LAUT NE #0 THEN	; if automated startup

      LET C$LAUT := #0		; yep (but once-only)
      .ADDR R4 := #C$LTST	; point at TEST command entry and dispatch that directly

    ELSE
      ParFld			; get a command name
        NOP			; test below suffices

      IFB (R0) EQ #0 GOTO 80$	; got a command? - not this time

      .ADDR2 R4 := #C$LDIS	; R4 -> dispatch table
      .ADDR2 R2 := #C$LLOO	; R2 -> command table

      ; Command lookup loop
      REPEAT
        LET R3 := R0		; R0/R3 -> command name field

        REPEAT				       ; when the same - you're on a good thing...
        UNTILB R1 EQ -1(R3) ORB (R3)+ NE (R2)+ ; just passed the terminator (in R1) or not same

        IFB -1(R2) EQ #0 THEN	; if end of the command entry?

          IFB -1(R3) EQ #0     GOTO 70$ ; matched to end of input? - got a command - dispatch it
          IFB -1(R3) EQ #SPACE GOTO 70$ ; SPACE?                   - that's a match too
          IFB -1(R3) EQ #'/    GOTO 70$ ; a switch?                - likewise good

        END

        REPEAT
        UNTILB (R2)+ EQ #0	; didn't match this entry - skip to the end of this entry

      UNTIL (R4)+ EQ #0		; pop the dispatch list until nothing more to dispatch

      LET R0 := #M$SCMD		; invalid command
      TypMon			; "? INVALID COMMAND";
      GOTO 80$			; return
    END

  70$:
    LETR R4 := (R4)		; R4 = command address and relocate
				
    ; Call CLI command routine
    CALL (R4)			; command dispatch

  80$:
    RETURN			; good
  END CL$DIS

  PROCEDURE CL$IFN
  BEGIN
    LET R0 := #M$SFNM		; invalid filename
    TypMon			; "? INVALID FILENAME"
    RETURN
  END CL$IFN

  M$SCMD:
    .ASCIZ "? INVALID COMMAND"

  M$SFNM:
    .ASCIZ "? INVALID FILENAME"

  M$SADR:
    .ASCIZ "? BAD ADDR"
    .BYTE -1			; why not .even?			(note)

  ; CLI command lookup table

  C$LLOO:
    .ASCIZ "L"			; Load
    .ASCIZ "S"			; Start
    .ASCIZ "R"			; Run
    .ASCIZ "C"			; Chain
    .ASCIZ "F"			; Fill
    .ASCIZ "D"			; Directory
    .ASCIZ "E"			; Enable
    .ASCIZ "H"			; Help
    .ASCIZ "TEST"		; Test
    .EVEN

  ; CLI command dispatch table

  C$LDIS:
    .WORD CL$LOA		; Load
    .WORD CL$STA		; Start
    .WORD CL$RUN		; Run
    .WORD CL$CHN		; Chain
    .WORD CL$FIL		; Fill
    .WORD CL$DIR		; Directory
    .WORD CL$ENB		; Enable
    .WORD CL$HLP		; Help

  C$LTST:
    .WORD CL$TST		; TEST
    .WORD 0

  .SBTTL Test Chain Help Fill Enable Dir Load Start Run			(CLI)

  ;
  ; CLI TEST command
  ;
  ; TEST[/QV]
  ;
  ; Equivalent to "C SYSTEM.CCC"
  ;
  ; TEST is automatically invoked if location @#1002 (I$NAUT) of the monitor image is non-zero at boot time.
  ; Most of the monitor startup messages are muted. In V2 the @#1002 flag is replaced by a "QUIET" command
  ; in the startup command file BOOT.CCC.
  ;
  SYSCCC:
    .ASCIZ "SYSTEM.CCC"		; the system chain file
    E.VEN

  PROCEDURE CL$TST
  BEGIN
    CALL CU$SWI			; store switches, check /QV
    .ADDR R2 := #SYSCCC		; "SYSTEM.CCC"
    LET   R0 := C$LLIN		; current line pointer
    REPEAT
      LET (R0)+ :B= (R2)+	; copy string
    UNTIL RESULT IS EQ		; all of it
    LET R0 := C$LLIN		; R0 -> file spec
    PshBat			; start a batch level
    GOTO CU$CHN			; join Chain/TEST common code
  END CL$TST

  ; Chain /QV switch

  C$SQVS:

  .IF EQ ROOT.V-1
    .ASCIZ "/QV"		; "QV" - Quick Verify switch
  .ENDC

  .IF EQ <ROOT.V-2>*<ROOT.V-3>
    .ASCIZ "QV"			; "QV" - Quick Verify switch
  .ENDC

    E.VEN

  ;
  ; CLI CHAIN command	
  ;
  ; C filnam[/QV]
  ;
  PROCEDURE CL$CHN
  BEGIN
    ParFld			; get the field
      GOTO C$IFN		; invalid filename
    PshBat			; R0 -> end of copied file spec
    LET (R0)+ :B= #'.		; add filetype ".CCC"
    LET R2    := #3		; (see CL$LOA for file spec processing)
    REPEAT
      LET (R0)+ :B= #'C		; ".CCC"
      LET R2 := R2 - #1		; all three
    UNTIL RESULT IS EQ
    LET  (R0) :B= #0		; terminate string
    CALL CU$SWI			; parse switches, check /QV
    $GOTO CU$CHN
  END CL$CHN

  ;
  ; CU$CHN - CLI Chain/Test common
  ;
  ; CU$CHN calls MO$CHN to copy/activate the batch process
  ; This area is overwritten by the batch overlay copy			(note)
  PROCEDURE CU$CHN
  BEGIN
    LET R2 := #^O<<X$XBAT-X$XINI+1000>/1000> ; block = 6 (location 6000)
    LET R3 := S$YTRA - #2000	; 10000 -> 6000 - batch area
    PUSH R3			; save R3
      CALL MO$REA		; copy overlay
    POP R3			; source
    LET @#$JSW := @#$JSW OFF.BY #SCMAN$ ; CMI clear manual intervention
    LET R2 := S$YPER		; dest overlay area
    LET R1 := #OVLEN.		; bytes to copy
    JUMPTO MO$CHN		; safely copy and initiate overlay
  END CU$CHN

  PROCEDURE C$IFN
  BEGIN
    JUMPTO CL$IFN		; invalid filename
  END C$IFN

  ;
  ; CU$SWI - Parse/store switches, check for /QV
  ;
  ; Called by CLI Chain and TEST commands to store switches and to check for the /QV switch
  ;
  ; There's no syntax checking here. Any trailing command field acts a trigger to copy that field and
  ; the remainder of the command line to the switch buffer.
  ; 24 bytes are reserved for switches (but, again, no check is made for overflow).
  ;
  PROCEDURE CU$SWI
  BEGIN
    LETR R2 := #S$YSWI		; /switch buffer and relocate
    ParFld			; get an alphanumeric field
      GOTO 10$			; end of line - no switches
    LET R0 := R0 - #1		; blindly backup to assumed "/" terminator

  10$:
    REPEAT
      LET (R2)+ :B= (R0)+	; copy field and remaining line
    UNTIL RESULT IS EQ

    .ADDR2 R0 := #C$SQVS	; .ascii "QV"
    CALL CU$CND			; check the /QV condition

    IF RESULT IS CS GOTO CU$RET	; it wasn't "/QV"

    LET S$YQVS := S$YQVS + #1	; set /QV quick verify switch

  ENTRY CU$RET

    RETURN			; (LoaSup return path passes through here)
  END CU$SWI

  ;
  ; CLI HELP command
  ;
  ; H/L Help Lineprinter
  ;
  PROCEDURE CL$HLP
  BEGIN
    ParFld

  .IF EQ ROOT.V-3
  ENTRY CL$HL2
  .ENDC

      GOTO 10$			; is no "/L" field
    IFB (R0) EQ #'L THEN	; lineprinter out?
      LptMod			; yes - use paper
    END
				;
  10$:
    .ADDR R0 := #30$
    OpnFil			; open it (or abort)

    REPEAT
      ReaBlk			; read a block
      LET IO.BLK(R5) := F$INXT	; next block next time
      LETR R0 := #F$IREC	; R0 -> data record
      TypMsg			; display input buffer
    UNTIL F$INXT EQ #0		; until did not get more?

    RETURN

  30$:
    .ASCIZ "HELP.TXT"		; XXDP help text file
    E.VEN
  END CL$HLP

  ;
  ; CLI FILL command
  ;
  ; The Fill command first displays the prevailing fill count.
  ; The user either enters a new fill count, or just newline to leave the fill count unchanged.
  ;
  ; F
  ; 000001<enter>	The fill count is unchanged
  ;
  ; F
  ; 000001 5		The fill count is changed to five
  ;
  PROCEDURE CL$FIL
  BEGIN
    LET R0 :B= S$YPAD		; the prevaling state
    LET R1 :=  C$LLIN		; temporary buffer
    OctAsc			; octal R0 to string R1
    LET (R1) :B= #0		; terminate string
    LET R0 := C$LLIN		; get the pointer again
    TypMsg			; display it
    PutTab			; tab separator
    GetLin			; get a response
    ParOct			; ascii to octal
      GOTO 10$			; fail
    LET S$YPAD :B= R0		; set padding count

  10$:
    RETURN
  END CL$FIL

  ;
  ; CLI ENABLE command
  ;
  ; The ENABLE command allows a user to choose a particular unit of the system device.
  ;
  ; E 1	Change the unit to unit #1
  ;
  ; DR.DEV (DR$DEV) updates the device ascii unit (DV.UNI) 
  ; The batch code for this command is identical
  ;
  ; There's an assumption here that the new unit will have the same device monitor placement as the prevailing unit.
  ;
  PROCEDURE CL$ENB
  BEGIN
    ParOct			; get a number
      BR 10$			; not a number
    LET  D$RUNI :B= R0		; new unit 
    LETR R5 := #D$RIOB		; update driver and relocate
    CALL @DR.DEV(R5)		; advise driver of change
  10$:
    RETURN
  END CL$ENB

  ;
  ; CLI DIRECTORY command
  ;
  ; D[/L][/F]
  ;
  ; /L	Output to the lineprinter
  ; /F	Output a short-form "fast" directory
  ;
  ; HUDI??.SYS is loaded to perform the primitive directory operation which does not permit file specs, let alone wildcards.
  ;
  PROCEDURE CL$DIR
  BEGIN
    .ADDR R0 := #10$		; point at the file spec "HUDI??.SYS"
    LET R1 := #0		; default start address
    LoaFil			; load it
    LET S$YSTA := #1		; default start address
    GOTO CU$ACT			; setup/start

  10$:
    .ASCIZ "HUDI??.SYS"		; the XXDP directory cusp
    E.VEN
  END CL$DIR

  ;
  ; CLI LOAD command
  ;
  ; L filnam[.typ]
  ;
  ; XXDP appends the file type ".BI?" to the file specification, regardless of whether user specifies a file type or not:
  ;
  ; filnam.BI?		no file type specified
  ; filnam.typ.BIC	file type specified
  ;
  ; This works because of the parsing strategy of OpnFil which effectively ignores a second ".BI?", if present.
  ; It will fail if the user specifies a filetype with less than three characters.
  ;
  ; CL$RUN uses this routine to load an image. See CL$RUN for a workaround to the LOAFIL strategy.
  ;
  PROCEDURE CL$LOA
  BEGIN
    LET S$YLOA :B= S$YLOA + #1	; display file spec

  ENTRY cu$loa

    ParFld			; get ye field 	(cu$run EPT)
      GOTO 20$			; invalid filename (doesn't clear S$YLOA)

    PUSH R0			; R0 -> field

      REPEAT
      UNTILB (R0)+ EQ R1	; loop until same as terminator

      LET -1(R0) :B= #'.	; "."
      LET (R0)+  :B= #'B	; ".B"
      LET (R0)+  :B= #'I	; ".BI"
      LET (R0)+  :B= #'?	; ".BI?"
      LET (R0)   :B= #0		; ".BI?"<0>

    POP R0			; R0 -> "filnam.BI?"
    LET C$LNXT := C$LNXT + #4	; advance next field pointer
    LET R1     := #0		; load address default
    LoaFil			; and read another psuedo papertape
    LET S$YLOA :B= #0		; disable display
    RETURN
				;
  20$:
      JUMPTO CL$IFN		; invalid file name
  END CL$LOA

  ;
  ; CLI START command
  ;
  ; S [address]
  ;
  PROCEDURE CL$STA
  BEGIN
    CALL cu$sta			; get a start address
    IF RESULT IS CS GOTO 30$	; c=1 error - return
    GOTO CU$ACT			; activate

  ;
  ; CU$STA - Get start address for RUN and START
  ;
  ; in command field
  ;
  ; CALL cu$sta
  ; BCS	 fail			; note: bcs fail, bcc fine		(note)
  ;
  ; fine  R0     start address
  ;       S$YSTA start address or #1
  ;
  ; abort "BAD ADDR."		; for odd addresses
  ;
  ENTRY cu$sta

    LET S$YSTA := #1		; assume default start
    ParOct			; get another start address
      GOTO 20$			; fine - no address, use default

    IF #1 OFF.IN R0 THEN	; if even addresses
      LET  S$YSTA := R0		; we have a start address
      GOTO 20$			; fine
    END

    LET R0 := #M$SADR		; "BAD ADDR."
    TypMon
    SEC				; c=1 => error
    GOTO 30$

  20$:
    CLC				; c=0 => fine

  30$:
    RETURN
  END CL$STA

  ;
  ; CU$ACT - Activate CLI image
  ;
  ; Called by LoaSup, Dir, Run and Start
  ;
  PROCEDURE CU$ACT
  BEGIN
    IF #1 NE S$YSTA		; if not maintenance app?
      LET S$YACT := S$YSTA	; copy image start address
    ELSE
      IF #1 EQ S$YACT THEN	; default image start address
	LET S$YACT := #200	; yes- use standard start address
      END
    END

    GetDev			; get device info
    LET R1        :B= DV.UNI(R0) - #'0 ; pluck off the unit digit, elide ascii
    LET @#SY.DEV  :B= R1	; 40 - device unit
    LET @#SY.COD  :B= DV.MED(R0) ; 41 - device media code
    LET @#V.EMT   :=  S$YEMT	; 30 - copy saved/overwritten EMT vector
    LET @#V.EMT+2 := S$YEMT+2	; 32 -
    LET @#SY.EXI  := #0		; 42 -  no co-routine exit
    LET @#$JSW    := #SCMAN$	; 52 - set manual intervention (SMI), (all other @#$JSW references bic/bis) (note)

    ; Activate CLI image

    CALL @S$YACT		; image start address
    CALL EM$RST			; restore EMT vector
    RETURN 			; return to CLI engine
  END CU$ACT

  ;
  ; CLI RUN command
  ;
  ; R filnam [start address]
  ;
  ; RUN uses CU$LOA to parse the filename and load the image.
  ; However, the Load command does not accept a start address, and in fact overwrites the end of its filename field with
  ; the	the default file type (".BI?").
  ;
  ; So, RUN initially skips the filename field (ParFld below), and calls CU$STA to pickup the start address.
  ; It then restores the initial field and calls CU$LOA to parse and load the image.
  ;
  ; S$YRUN is checked as the high byte of S$YLOA
  ;
  PROCEDURE CL$RUN
  BEGIN
    ParFld			; get filespec
      GOTO 20$			; invalid filename
    PUSH R0			; save current field
      CALL cu$sta		; get the start address
    POP C$LNXT			; c=? so CL$LOA can reparse filename 	(note)
				; c=? (we must pop the stack in both cases)
    IF RESULT IS CC THEN	; c=0 start address was good
      LET  S$YRUN :B= S$YRUN + #1 ; set run-in-progress flag
      CALL cu$loa		; load the program
      LET  S$YRUN :B= #0	; clear run-in-progress flag
      CALL CU$ACT		; full activation
    END
    RETURN

.IF EQ ROOT.V-3
  20$:
    JUMPTO CL$IFN		; invalid file name
  END CL$RUN
.ENDC

.IF EQ <ROOT.V-1>*<ROOT.V-2>
  ; End of CLI/Batch overlay region
.ENDC

  OVLEN. = .-O$VREG

  ;.ASSUME BALEN. EQ OVLEN.

.IF EQ <ROOT.V-1>*<ROOT.V-2>
  20$:
    JUMPTO CL$IFN		; invalid file name
  END CL$RUN
.ENDC

.IF EQ ROOT.V-3
  ; End of CLI/Batch overlay region
.ENDC

  ;
  ; CU$CND - Check Batch IF and CLI CHAIN/TEST conditions
  ;
  ; CU$CND sits just outside the CLI/Batch overlay region and is called by both CLI and Batch routines.
  ;
  ; in R0 -> candidate switch "XX"
  ;
  ; CALL CU$SWI
  ;
  ; fail BCS	fail
  ; fine BCC	fine					(bcc fine)	(note)
  ;
  ; R0/R1 preserved
  ; R2/R4 burnt
  ;
  PROCEDURE CU$CND
  BEGIN
    .ADDR2 R2 := #S$YSWI	; the switch buffer

    REPEAT

      REPEAT
        IFB (R2) EQ #0 GOTO 50$	; end of switches? - fail
      UNTILB (R2)+ EQ #'/	; "/" must be found

      LET R4 := R0		; R4 -> candidate

      REPEAT
      UNTILB (R4)+ NE (R2)+	; R2 -> stored, compare until missmatch

      IFB -1(R2) EQ #'/ LEAVE LOOP ; terminated by "/" - yes - multiple switches

    UNTILB -1(R2) EQ #0		; terminated at end of string? (no - start over)

    CLC				; fine - switch found
    GOTO 60$

  50$:
    SEC				; fail - no such switch

  60$:
    RETURN
  END CU$CND

  .SBTTL EMT Engine							(EMT)

  ;
  ; EM$ENG - EMT system service dispatch engine
  ;
  ; EMT calling procedure:
  ;
  ; Registers are used to pass information to and from services as required.
  ;
  ; MOV	arg1,R0
  ; MOV	arg2,R1
  ; MOV	arg3,R2
  ; emt	xxx
  ;
  ; There are four system service return paths:
  ;
  ; NEUTRAL:
  ;   Services such as GetCom or GetDat have no error conditions.
  ;
  ; SKIP:
  ;   The service returns to the location immediately following the EMT for a "fail" condition,
  ;   but skips that location for a "fine" condition.
  ;   In the example below the "fail" path is taken for	EOL (end of line) or EOF (end of file).
  ;
  ; GetFld
  ;   BR eol	; fail
  ; ...		; fine
  ;
  ;   The fail instruction may only be a single word instruction.
  ;   It is traditionally indented by a single space to remind us of its usage.
  ;
  ;   The skip return is employed within the monitor itself. It is used systematically by IN$YMD to parse the year, month and day.
  ;   Each sub-routine ends as below. The (indented) <add #2,(SP)> creates the skip.
  ;
  ; DT$YEA:	...
  ;   SUB #70.,R0		; 1970 starts it
  ;   BLT 10$			; error - year is before 1970
  ;
  ;    ADD #2,(SP)		; fine
  ;
  ; 10$:
  ;    RETURN			; fail
  ;
  ; System service calls trigger the skip by modifying the EMT call routine return address on the stack.
  ;
  ; BCC FAIL
  ;   Some services use the carry bit to report status. Common PDP-11 usage is to report errors with the carry-set condition.
  ;   XXDP+ uses carry-clear to report failure for services and some routines.
  ;   Confusingly, a couple of routines use carry-set.
  ;
  ; GetLin	; get a command line
  ; BCC	eof	; end of file
  ; ...
  ;
  ; ABORT:
  ;   Ctrl/C, checksum errors, media read errors and file-not-found use the system SetAbt/JmpAbt mechanism to report errors.
  ;
  ; Register usage:
  ;
  ;   R0/R1  R0/R1 are the workhorse for service arguments and results. The dispatcher does not save/restore R0 or R1,
  ;          however service routines modify R0/R1 only when functionally appropriate. 
  ;
  ;   R2..R4 R2, R3 and R4 are saved/restored by the dispatcher. Two services (SpcAsc & CmpSpc) pass arguments in R2.
  ;
  ;   R5     R5 is not saved/restored by the dispatcher. R5 is reserved	exclusively for its use as a pointer to
  ;          the I/O control block. Utilities must preserve the monitor R5 setting.
  ;

  ;
  ; EM$RST - Restore EMT vector
  ;
  ; Diagnostics are free to obliterate the EMT vector (@#V.EMT/V.EMT+2)
  ; EM$RST is called CLI system restart, CLI and batch image exit, to restore the EMT vector.
  ;
  PROCEDURE EM$RST
  BEGIN
    LETR @#V.EMT :=  #EM$ENG	 	; rebuild EMT vector and relocate
    LET @#V.EMT+2 := #PR7		; PR7
    RETURN
  END EM$RST

  Stack	R2,R3,R4,PC,PS

  ;
  ; EM$ENG - The EMT dispatcher (as described above)
  ;
  PROCEDURE EM$ENG
  BEGIN
    PUSH <R4, R3, R2>			; R5 shared, R2/R3/R4 saved, R0/R1 - arguments/results

    LET SP.PS(SP) := SP.PS(SP) OFF.BY #C.BIT ; clear return c-bit

    LET R4 :=  SP.PC(SP)		; get the pc
    LET R4 :B= -2(R4)			; get the (unsigned) EMT code (sanity)
    LET R4 := R4 L.SHIFT		; make bytes, not words
    .ADDR2 R3 := #E$MDIS		; dispatch table address, relocate
    LET  R4 := R4 + R3			; add offset and table
    LETR R4 := (R4)			; get the table entry and relocate that

    ; Call EMT service

    CALL (R4)				;\call the thing
      GOTO 20$				;plain	;| fail - don't alter return address
    LET SP.PC(SP) := SP.PC(SP) + #2	;skip	;/ fine -propagate skip return
					;
  20$:
    POP <R2, R3, R4>			; restore registers
    RTI					; return to caller
  END EM$ENG

  ;
  ; EMT dispatch list
  ;
  E$MDIS:
    .WORD GETLIN	; 0  GetLin
    .WORD PARFLD	; 1  ParFld
    .WORD TYPMON	; 2  TypMon
    .WORD TYPMSG	; 3  TypMsg
    .WORD PUTCHK	; 4  PutChk
    .WORD GETAVL	; 5  GetAvl
    .WORD GETCHK	; 6  GetChk
    .WORD NEWLIN	; 7  NewLin
    .WORD PUTTAB	; 10 PutTab 
    .WORD PAROCT	; 11 ParOct
    .WORD OPNFIL	; 12 OpnFil
    .WORD CLOFIL	; 13 CloFil
    .WORD LOAFIL	; 14 LoaFil
    .WORD REAWRD	; 15 ReaWrd
    .WORD REABYT	; 16 ReaByt
    .WORD PUTCHA	; 17 PutCha
    .WORD REANXT	; 20 ReaNxt
    .WORD REABLK	; 21 ReaBlk	
    .WORD SETABT	; 22 SetAbt
    .WORD JMPABT	; 23 JmpAbt	
    .WORD CMPSPC	; 24 CmpSpc
    .WORD SPCASC	; 25 SpcAsc
    .WORD SETLIN	; 26 SetLin	
    .WORD GETDAT	; 27 GetDat
    .WORD OCTASC	; 30 OctAsc	
    .WORD GETDEV	; 31 GetDev	
    .WORD RPTFLD	; 32 RptFld
    .WORD LPTMOD	; 33 LptMod
    .WORD TERMOD	; 34 TerMod	
    .WORD LOASUP	; 35 LoaSup	
    .WORD PARDEC	; 36 ParDec	
    .WORD PADTER	; 37 PadTer
    .WORD PSHBAT	; 40 PshBat
    .WORD POPBAT	; 41 PopBat
    .WORD GETCOM	; 42 GetCom	
    .WORD GETDRV	; 43 GetDrv
    .WORD TYPBRK	; 44 TypBrk	
    ;.WORD ?		; MACROM 45 ChkAbt (not in XXDPSM???)
    ;.WORD ?		; XXDPSM 46 LoaDat (load Date command app)

  .SBTTL Monitor Restore, Overlay Read and Copy				(monitor)

  ;
  ; MO$REA restores the monitor during image exit
  ; MO$CHN completes the CLI->Batch transition and return
  ; MO$REA does the I/O for MO$REA and MO$CHN
  ;
  ; These are the monitor block numbers of the areas of interest
  ;
  ; MOBAT. 			;  (6) batch area block
  ; MOTRA.			;  (8) transient area block
  ; MOCLI. 			; (10) cli area block
  ; moLEN. = 1414		; overlay length
  ;

  ;
  ; MO$RST - Restore the monitor transient area
  ;
  ; Checksum the transient area
  ;
  PROCEDURE MO$RST
  BEGIN
    LET R0 := S$YTRA		;10000	; transient area
    LET R1 := #0		;0	; checksum

    REPEAT
      LET R1 := R1 + (R0)+	;0+n	; accumulate checksum
    UNTIL R0 EQ S$YPER		;12000	; until reached the permanent area

    IF S$Y5CK EQ R1 GOTO MO$NOM	;	; if we didn't change?

    ; Restore the transient area

    LET  R2 := #^O<<X$XTRA-X$XINI+1000>/1000> ;10/8.	; block = 8

    LET  R3 := S$YTRA		;10000	; buffer = S$YTRA
    CALL MO$REA			;	; restore 512. words
    GOTO MO$SHM			;	; go say ".5K RESTORED"
  END MO$RST

  ;
  ; MO$REA - Read 512. words from the monitor file
  ;
  ; R2 =  block
  ; R3 -> buffer
  ; 512.  fixed word count
  ;
  PROCEDURE MO$REA
  BEGIN
    LETR R5 := #D$RIOB		; system IOB
    LET IO.BLK(R5) := R2	; R2 =  block
    LET IO.BUF(R5) := R3	; R3 -> buffer

  ;
  ; overlay end, static begin
  ;
  ENTRY X$XSTA

    LET  IO.WCT(R5) := #^D<512>	; word count (2*256. words)
    CALL @DR.RST(R5)		; read
    LET F$ISCK := #0		; clear batch saved checksum
    RETURN
  END MO$REA

  PROCEDURE MO$SHM
  BEGIN
    LET R0 := #50$		; type ".5K RESTORED"
    TypMon
  	
  ENTRY MO$NOM

    RETURN

  50$:
    .ASCIZ ".5K RESTORED"<CR><LF>
    E.VEN
  END MO$SHM

  ;
  ; MO$CHN - Chain completion
  ;
  ; Copy batch region to overlay region
  ; Call the batch engine
  ; Restore monitor CLI context
  ;
  ; This CLI code must reside outside the overlay region
  ; XXDP reads 512. words to restore CLI				(note)
  ; The CLI read ends at 14000 (at x$xres, 52 bytes above)
  ;
  ; R3 -> source
  ; R2 -> dest
  ; R1 =  byte counter
  ;
  PROCEDURE MO$CHN
  BEGIN
    REPEAT
     LET (R2)+ :B= (R3)+	; copy chain area
     LET R1    := R1 - #1	; byte by byte
    UNTIL RESULT IS EQ		; leaving none out
				; 
    ; Call batch engine

    CALL BA$ENG+OVLREG		; call batch (only use of +OVLREG)		(note)

    PopBat			; restore CLI context
    LET S$YQUI :B= #0		; switch off quiet mode

    ; setup and read the CLI back in

    LET  R2 := #^O<<X$XPER-X$XINI+1000>/1000> ; R2 = block 10. (12)
    LET  R3 := S$YPER		; R3 = -> 12000/152000
    CALL MO$REA			; read monitor CLI engine overlay and more
    RETURN			; 12000-14000 / 152000-154000
  END MO$CHN

  .SBTTL System Data & Communication area				(data)

  S$YSWI:
    B.LKB <^O<30>>			;14110	;  batch/CLI switch buffer

  S$YGTO:
    .REPT 58.				;14140	;  batch GOTO buffer	(hack)	(note)
      .WORD 123456				;  stack pattern
    .ENDR					;  58. word stack
  SPBOT:
					;14324	;  system stack top

  S$YTRA:
    .WORD 0			;150000	;14324	;  -> .5k transient area	(init)

  S$YPER:
    .WORD 0			;152000	;14326	;  -> permanent memory area	(init)

  H$WLTC:
    .WORD LCCSR				;14330	;  line clock

  H$WKWP:
    .WORD PCCSR				;14332	;  KW11P programmable clock

  S$YREL:
    .WORD 0			;140000	;14334	;  relocation constant		(init)

  S$YRPT:
    .WORD 0				;14336	;  diagnostic repeat count

  S$YDEV:
    .WORD 0				;14340	;  -> D$RDEV: .ascii "DDu"<lmd>	(init)

  S$YSUP:
    .WORD 0			;137000	;14342	;  ACT supervisor load address	(init)

  S$YTPS:
    .WORD 0			;TPS	;14344	;  TPS/LPT csr pointer		(init)

  S$YTPB:
    .WORD 0			;TPB	;14346	;  TPB/LPB buffer pointer	(init)

  F$IBCT:
    .WORD 0				;14350	;  ReaByt file byte count

  S$YTOP:
    .WORD 0			;160000	;14352	;  top of memory		(init)

  F$IPTR:
    .WORD 0				;14354	;  file buffer pointer

  F$ILCK:
    .WORD 0				;14356	;  LDA load file read checksum

  C$LLIN:
    .WORD 0				;14360	;\ resident command pointer	(init)

  C$LLEN:
    .WORD 0				;14362	;/ line length			(init)

  C$LNXT:
    .WORD 0				;14364	;  points to next command field

  F$IPOS:
    .WORD 0				;14366	;  current file position

  F$ISVP:
    .WORD 0				;14370	;  saved/restored file position

  C$LFLD:
    .WORD 0				;14372	;  current field pointer
    .WORD 0				;14374	;  ???					(note)

  S$YDAT:
    .WORD 0				;14376	;  system DOSbatch date

  S$YABT:
    .WORD 0				;14400	;  SetAbt/JmpAbt address

  S$YEMT:
    .WORD 0,0				;14402	;  saved EMT vector during image load

  S$YSTA:
    .WORD 177777			;14406	;  image START command address and type

  S$YACT:
    .WORD 177777			;14410	;  image activate address

  F$IRCK:
    .WORD 177777			;14412	;  ReaBlk checksum

  F$ISCK:
    .WORD 0				;14414	;  Batch saved ReaBlk checksum

  S$Y5CK:
    .WORD 0				;14416	;  .5k area checksum		(init)

  S$YLOA:
    .BYTE 0				;14420	;\ LOAD in-progress flag
  S$YRUN:
    .BYTE 0				;14421	;/ cli RUN in-progress flag

  S$YHLT:
    .BYTE 0				;14422	;  halt after load flag

  S$YPAD:
    .BYTE 12.			;14	;14423	;  fill count (post-init reset to 1)(preset)

  S$YCOL:
    .BYTE				;14424	;  column (for tabbing)

  S$YPND:
    .BYTE 0				;14425	;  pending input character

  S$YPOP:
    .BYTE 0				;14426	;  PopBat flag (i.e. not PshBat)

  S$YQUI:
    .BYTE 0				;14427	;  negative => quiet mode
    .BYTE 0,-1				;14430	;\ command line backstop
  C$LBUF:
    B.LKB CLAVL.			;14432	;| command line buffer
    B.LKW 1				;14504	;/ command line terminator

  B$ASFN:
    B.LKW 1				;14506	;\ fil - saved batch file name
    B.LKW 1				;14510	;| nam
    B.LKW 1				;14512	;| typ
    B.LKW 1				;14514	;| buf
    B.LKW 1				;14516	;/ nxt

  B$AFNM:
    B.LKW 1				;14520	;\ fil - batch file name
    B.LKW 1				;14522	;| nam
    B.LKW 1				;14524	;| typ
    B.LKW 1				;14526	;| buf
    B.LKW 1				;14530	;/ nxt

    ;.BLKW 256.
  F$IBUF:				;14532	;\ file system block buffer
  F$INXT: B.LKW 1			;14532	;X -> to next file block
  F$IREC: B.LKW	256.-1			;14534	;| input record
				;....	;15531	;| record top

    .WORD 0				;15532	;/ buffer parse & print terminator

  ;
  ; High memory syscom area
  ;
  ; GETCOM returns a pointer to S$YCOM.
  ;

  S$YCOM:

  S$YCSR:
    .WORD 0				;15534	;\ CSR address			(init)
    .WORD 0				;15536	;| ???					(note)
  S$YUNI:
    .WORD 0				;15540	;| unit number			(init)

  S$YCFG:
    .WORD 0				;15542	;| config flags (LPT$ etc)	(init)

  S$YLPT:
    .WORD 0				;15544	;| LPT CSR if present		(init)

  S$YKWD:
    .WORD 0				;15546	;| kwords memory size		(init)

  S$YLTC:
    .WORD 0				;15550	;|\ LTC ISR and block
    .WORD 6				;15552	;|| LTC priority
    .WORD V.LTC				;15554	;|| LTC clock vector
  S$YLTK:
    .WORD ^D<60>			;15556	;|/ LTC clock-ticks    (50hz=50.)(init)

  S$YKWP:
    .WORD 0				;15560	;|\ PCCSR ISR and block
    .WORD 6				;15562	;|| PCCSR priority
    .WORD V.PTC				;15564	;|| PCCSR vector
  S$YKTK:
    .WORD 60.				;15566	;|/ KWP clock-ticks    (50hz=50.)(init)

  S$YQVS:
    .WORD 0				;15570	;| /QV quick verify switch

  S$YBAT:
    .WORD 0				;15572	;| 1+=batch mode and level

  S$YPGS:
    .WORD ^D<512-1>			;15574	;| MMU 32w-pages-1 (777=16kw-1pg)(init)

  S$YERR:
    .WORD 0				;15576	;/ apps report errors to batch here

  ; Driver area

  D$RCOM:
    .WORD 0				;15600	;752	;\ DR.BUF
    .WORD 0				;15602	;754	;| DR.ENT - entry number in segment

  D$RFNM:
    .RAD50 /   /			;15604	;756 	;| DR.FNM - .RAD50 /filnamtyp/
    .RAD50 /   /			;15606	;760 	;|          copied here by DR$OPN
    .RAD50 /   /			;15610	;762 	;|          along with DR.SBL below
    .WORD  0				;15612	;764	;| DR.SBL - first file block

					;  begin GetDrv copy area
  D$RDIS:
    .WORD DR$OPN			;15614	;766	;\ DR.OPN - open file	    (init)
    .WORD DR$RST			;15616	;770	;| DR.RST - restore monitor (init)
    .WORD DR$TRA			;15620	;772	;| DR.TRA - transfer	    (init)
    .WORD DR$DEV			;15622	;774	;| DR.DEV - device name	    (init)

  D$RUNI:
    .BYTE 0				;15624/	;776 	;| DR.UNI - device unit	    (boot)
    .BYTE 0				;15625	;777 	;| DR.STS - operation status

  IOB:
  D$RIOB:

  D$RCSR:
    .WORD SYCSR.			;15626	; 00	;| CSR 			    (boot)
    .WORD 0				;15630	; 02	;| IO.WCT
    .WORD 0				;15632	; 04	;| IO.BUF
    .WORD 0				;15634	; 06	;| IO.BLK 
    .WORD D$PUFD			;15636	; 10	;| IO.UFD - relocated	    (init)

  D$REND:						;/ end GetDrv copy area

  I$OSPC:
    B.LKB 12				;15640	; 12	;  IO.SPC  .ASCIZ "filnam.typ"<0>
    .BYTE 0
    E.VEN

  .SBTTL LoaFil								(EMT)

  ;
  ; LOAFIL - Load file service						(EMT 14)
  ;
  ; in R0 -> ascii filespec
  ;    R1 =  load base address
  ;
  ; LoaFil
  ;
  ; fine  R1 -> activate address
  ;
  ; abort R0 -> "? CKERR" (or "? RD ERR")
  ;
  PROCEDURE LOAFIL
  BEGIN
    LET R3     :=  R1		; R3 = base address
    LET S$YHLT :B= #0		; clear halt flag

    LETPR R2 := #S$YEMT, idx=7	; EMT vector can't be modified during loading

    LET (R2)+ := @#V.EMT	; so we save it to a temp buffer
    LET (R2)+ := @#V.EMT+2	; which is later copied into place

    LET @#DEFSTRT   := #JMP+^O<37> ; setup a default start address
    LET @#DEFSTRT+2 := #^O<2100>   ; 200: jmp @#2100; what is this?	(note)

    OpnFil			; look for the file

    IF S$YLOA NE #0 THEN        ; not batch/cli LOAD and not cli RUN command?

      ; display filespec

      LETPR R1 := #D$RFNM, idx=6 ; rad50 filename
      LETPR R2 := #I$OSPC, idx=8 ; to ascii filespec

      SpcAsc			; ascify rad50 filename
      LET R0 := R2		; point to ascii
      TypMsg			; display the name
      NewLin
    END

    ; R0 incoming byte
    ; R1 store address
    ; R2 record size
    ; R3  load base address (from caller R1)

    REPEAT

      REPEAT
        REPEAT
          LET F$ILCK := #0	; zap load checksum
          ReaByt		; looking for start-of-record
        UNTILB R0 EQ #1		; until which is a one
        ReaByt			; which is followed by a null
      UNTIL R0 EQ #0		; until got a null

      ReaWrd			; next comes the record byte count
      LET R2 := R0		; R2 = record size
      ReaWrd			; now we want an address
      LET R1 := R0 + R3		; which goes into R1 plus the load base address
      LET R2 := R2 - #6		; subtract header size from byte count

      IF RESULT IS EQ GOTO 80$	; zero means we have a transfer record
      IF RESULT IS LE GOTO 70$	; strange choice of branch 		(note)

      ; Read LDA record

      REPEAT
        ReaByt			; read the next byte

        ; Force console start if LOAD overwrites transient area		(note)
        ; (because we can't return there for normal completion)
        ; (it's not a problem for RUN because it doesn't return)

        IF R1 HIS S$YTRA ANDB S$YLOA NE #0 THEN ; if overwriting transient area and this a LOAD command
          LET R0 := #M$SCON0	; yes - and that has console consequences
          TypMon		; "USE CPU CONSOLE TO START"
          LET S$YLOA :B= #0	; once-only flag (don't repeat message)
          LET S$YHLT :B= S$YHLT + #1 ; flag halt after load (below)
        END

        ; Handle EMT vector overwrite
        LETPR R4 := #S$YEMT-1, idx=9 ; save app emt vector in S$YEMT

        PUSH #V.EMT-1		; which run/load copies into place

      40$:
	LET TOP := TOP + #1	; first inc points at V.EMT (@#V.EMT)
        LET R4  := R4  + #1	; and S$YEMT, a temporary copy area

        IF (SP) LO #V.EMT+4 THEN ; passed emt vector pair?
          IF R1 NE (SP) GOTO 40$ ; is the V.EMT area 30,31,32,33? no - keep going
          LET  (R4) :B= R0	; yes - squirrel it away
          TSTB (R1)+		; skip it and proceed as if nothing had happened
        ELSE
          ; Store a byte and loop
          LET (R1)+ :B= R0	; wow - actually store a byte
        END

	TST	(SP)+		; pop the (SP) temp

        LET R2 := R2 - #1	; more bytes in record?
      UNTIL RESULT IS EQ	; until no

      ; End of record, handle checksum error

    70$:
      ReaByt			; read checksum byte

    UNTILB F$ILCK NE #0		; until the load checksum is non zero

    LET R0 := #M$SCHK		; "CKERR" (abort routine relocates)
    JmpAbt			; we are finished

    ;
    ; End of load
    ;
    ; Halt if Load overwrites transient area
    ;

  80$:
    LET S$YACT := R1		; store activate address
    IFB S$YHLT NE #0 THEN	; forced halt? no - caller completes activation
      HALT			; HALT for user to run program manually
    END
    RETURN			; CONTINUE returns to activate
  END LOAFIL

  M$SCHK:
    .ASCIZ "? CKERR"		; checksum error
  M$SCON:
    .ASCIZ "USE CPU CONSOLE TO START"<HT>
    .EVEN

  .SBTTL REAWRD REABYT PUTCHA REANXT REABLK				(EMT)

  ;
  ; REAWRD - Read word service						(EMT 15)
  ;
  ; Read two bytes, replacing missing bytes with zero
  ;
  ; in R5 -> file IOB
  ;
  ; ReaWrd
  ; BCS fine
  ; BCC fail
  ;
  ; fine R0 word
  ; fail R0 undefined
  ;
  PROCEDURE REAWRD
  BEGIN
    ReaByt			; get another byte 
      BCC REABAD		; end of file - return
    LET R4 := R0		; save first byte
    ReaByt			; read another
      BCC REABAD		; oops - end of file
    SWAB R0			; new byte to high byte
    LET  R0 := R0 SET.BY R4	; combine
    GOTO REAGUD			; propagate good C.BIT return
  END REAWRD

  ;
  ; REABYT - Read byte service						(EMT 16)
  ;
  ; in R5 -> file IOB
  ;
  ; ReaByt
  ; fail  BCC eof
  ; fine  R0 = byte
  ;
  ; abort "Rd Er" from ReaBlk
  ;
  PROCEDURE REABYT
  BEGIN
    IF F$IBCT LE #0 THEN	; if no more bytes to eat

      IF IO.BLK(R5) EQ #0 GOTO REABAD ; fail got a real block? - return

      CALL REABLK 		; ReaBlk
      LET IO.BLK(R5) := F$INXT	; link file forward
      LET F$IBCT := #^D<512-2>	; 512 - 2 for the header word
      LETPR F$IPTR := #F$IREC, idx=2; relocated
    END

    ; Get next byte

    LET R0 :B= @F$IPTR		; actually get a character
    LET R0 :=  R0 OFF.BY #^C377	; clean up to 8-bit ascii
    LET F$ILCK := F$ILCK + R0	; add to  to the LOAFIL checksum
    LET F$IPTR := F$IPTR + #1	; buffer pointer
    LET	F$IBCT := F$IBCT - #1	; count down
    $GOTO REAGUD
  END REABYT

  PROCEDURE REAGUD
  BEGIN
    LET SP.PS+2(SP) := SP.PS+2(SP) SET.BY #C.BIT ; fine			(note)
    $GOTO REABAD	 
  END REAGUD

  PROCEDURE REABAD
  BEGIN
    RETURN
  END REABAD

  ;
  ; PUTCHA - Put character service					(EMT 17)
  ;
  ; in  R0 output character
  ;
  ; out R0 available input character or zero
  ;
  PROCEDURE PUTCHA
  BEGIN
    IFB R0 EQ #LF THEN		; linefeed?
      LET S$YCOL :B= #0		; column zero
    END

    IFB	R0 EQ #HT THEN		; tab?
      CALL PutTab		; go tab
    ELSE
      CALL TE$PUT		; out to TPS
      LET S$YCOL :B= S$YCOL + #1 ; up column count
      IFB R0 EQ #CR THEN	; carriage return?
        CALL PADTER		; some mechanical time
      END
    END
    GetAvl			; returns available character
    RETURN
  END PUTCHA

  ;
  ; REANXT - Read next block service					(EMT 20)
  ;
  ; in F$INXT next block
  ;
  ; ReaNxt
  ;   BR eof	fail
  ; ...
  ;
  ; abort "Rd Er"
  ;
  PROCEDURE REANXT
  BEGIN
    LET IO.BLK(R5) := F$INXT	; advance to next block
    IF RESULT IS NE THEN	; if there is next block
      ReaBlk			; read it
      LET TOP := TOP + #2	; we're good
    END
    RETURN			; we ain't
  END REANXT

  ;
  ; REABLK - Read Block service						(EMT 21)
  ;
  ; Read block and compute block checksum
  ;
  ; in R5 -> IOB
  ;            IO.BLK block number
  ;
  ; ReaBlk
  ; ...	 fine
  ;      fail abort "? RD ERR"
  ;
  ; CALL RB$CHK
  ;   out R2:R4 burnt
  ;   F$IRCK    block checksum
  ;
  PROCEDURE REABLK
  BEGIN
    LET  IO.BUF(R5) := DR.BUF(R5) ; buffer
    LET  IO.WCT(R5) := #^D<256>	; word count
    CALL @DR.TRA(R5)		; transfer 
    $GOTO RB$CHK
  END REABLK

  ;
  ; The checksum includes the block-chain header word which helps differentiate data blocks that are entirely composed of zeroes.
  ;
  PROCEDURE RB$CHK		; GetLin entry point
  BEGIN
    LET R2 := DR.BUF(R5)	; point to buffer
    LET R3 := #^D<256>		; our counter
    LET R4 := #0		; our checksum
    REPEAT
      LET R4 := R4 + (R2)+	; accumulate
      LET R3 := R3 - #1		; count
    UNTIL RESULT IS EQ
    LET R4     := R4 + #1	; avoid matching zero checksum		(note)
    LET F$IRCK := R4		; new file read checksum
    RETURN
  END RB$CHK

  .SBTTL SETABT JMPABT GETDEV RPTFLD GETDRV CMPSPC SPCASC		(EMT)

  ;
  ; SETABT - Set abort address service					(EMT 22)
  ;
  ; in R0 -> abort function
  ;
  ; SetAbt
  ;
  ; out S$YABT->abort function
  ;
  PROCEDURE SETABT
  BEGIN
    LET S$YABT := R0		; save address
    RETURN
  END SETABT

  ;
  ; JMPABT - Jump to abort routine service				(EMT 23)
  ;
  ; in R0 -> (unrelocated)abort message
  ;    R0=0  no message
  ;
  ; JmpAbt
  ;
  ; The abort routine is responsible for relocating monitor messages.
  ;  
  PROCEDURE JMPABT
  BEGIN
    JUMPTO @S$YABT		; jump to abort
  END JMPABT

  ;
  ; GETDEV - Get device information service				(EMT 31)
  ;
  ; out R0 -> device info block
  ;
  ; DV.NAM  = 0		; .ASCII "XX"	; driver name
  ; DV.UNI  = 2		; .BYTE	"0"	; device unit
  ; DV.MED  = 3		; .BYTE	XXMED.	; media code
  ;  DVRK5. = 2	  	;  DK: disk
  ;  DVRL1. = 14	;  DL: disk
  ;
  PROCEDURE GETDEV
  BEGIN
    LET R0 := S$YDEV	; R0 -> "DD"
    RETURN
  END GETDEV

  ;
  ; RPTFLD Repeat command field service					(EMT 32)
  ;
  ; Repeat field supports command line look-ahead parsing
  ; See IN$PDT (init parse date) for an example
  ;
  PROCEDURE RPTFLD
  BEGIN
    LET C$LNXT := C$LFLD	; next field is current field
    RETURN
  END RPTFLD

  ;
  ; GETDRV - Get driver service						(EMT 43)
  ;
  ; in R0 -> driver output area
  ;    R1 -> driver dispatch table output area
  ;
  ; GetDrv
  ;
  ; out R0 -> monitor driver area
  ;     R1 -> past Monitor dispatch table
  ;
  ; GetDrv is deprecated in XXDPV2
  ;
  PROCEDURE GETDRV
  BEGIN

    LETPR R4 := #X$XDRV, idx=13	; R4 -> X$XDRV driver region
    LET R2 := R4		; R2 -> ditto

    LET R3 := S$YTOP - R4 R.SHIFT 1 ; R3 -> X$XTOP - top of memory, length of driver, as words
    REPEAT
      LET (R0)+ := (R2)+	; R0 -> copy area
      LET R3 := R3 - #1		; count them
    UNTIL RESULT IS LE

    LETPR R2 := #D$RDIS, idx=14	; R2 -> driver dispatch interface base

    LET R0 := #12		; 10.? ; R0 =  copy count
    REPEAT
      LET (R1)+ := (R2)+	; R1 -> copy output
      LET R0 := R0 - #1		; count
    UNTIL RESULT IS LT

    LET R0 := R4		; R0 -> monitor driver area
    RETURN			; R1 -> past monitor dispatch table
  END GETDRV

  ;
  ; CMPSPC  - Compare file specs service				(EMT 24)
  ;
  ; in R0 -> wildcard spec   (e.g. "filnam.bi?")
  ;    R2 -> candidate space (e.g. "mydiag.bic" or ".bin")
  ;
  ; CmpSpc
  ;   BR fail  fail
  ; ...        fine
  ;
  ; out R0 burnt
  ;
  PROCEDURE CMPSPC
  BEGIN
    LET R4 := #^D<10>		; counter

    REPEAT
      IFB #'? EQ (R0) ORB #'% EQ (R0) THEN ; if "?" or "%"
        CMPB (R0)+, (R2)+	; match anything
      ELSE
        IFB (R0)+ NE (R2)+ GOTO 50$ ; if specific does not match - fail
      END

      LET R4 := R4 - #1
    UNTIL RESULT IS EQ		; until no more

    LET TOP := TOP + #2		; fine

  50$:
    RETURN
  END CMPSPC

  ;
  ; SPCASC - Convert rad50 spec to ascii service			(EMT 25)
  ;
  ; in R1 -> .RAD50	/filnamtyp/
  ;    R2 -> output buffer
  ;
  ; SpcAsc
  ;
  ; out	R0/R1 burnt
  ;
  PROCEDURE SPCASC
  BEGIN
    LET  R0 := (R1)+		; "fil"
    CALL SU$UNP			; unpack rad50 word
    LET  R0 := (R1)+		; "filnam"
    CALL SU$UNP
    LET  (R2)+ :B= #'.		; "filnam."
    LET  R0 := (R1)+		; "filnam.typ"
    CALL SU$UNP
    RETURN
  END SPCASC

END HMROOT

.END