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

MODULE NAME=<HMBTCH>, VER=<2.2PL>, COMM=<XXDP+ OS Monitor - Batch engine>, TYPE=<NOSECT>

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

  FROM HMTERM IMPORT T$ENEW
  FROM HMTERM IMPORT TE$CTC
  ; Data
  FROM HMROOT IMPORT C$LNXT
  FROM HMROOT IMPORT D$RUNI, D$RIOB
  FROM HMROOT IMPORT F$IPOS, F$ISCK
  FROM HMROOT IMPORT S$YDEV
  FROM HMROOT IMPORT S$YEMT
  FROM HMROOT IMPORT S$YERR
  FROM HMROOT IMPORT S$YGTO
  FROM HMROOT IMPORT S$YPND, S$YQVS
  FROM HMROOT IMPORT S$YLOA, S$YSTA, S$YACT, S$YRPT, S$YQUI
  FROM HMROOT IMPORT S$YREL
  ; Proc
  FROM HMROOT IMPORT CU$CND
  FROM HMROOT IMPORT EM$RST
  FROM HMROOT IMPORT MO$RST

  EXPORT QUALIFIED X$XBAT, BALEN.
  EXPORT QUALIFIED BA$ENG

  .PSECT XXDP2

  .SBTTL Batch engine							(batch)

  ; 06000 (6000-7414 - batch region)
  X$XBAT:

  ;
  ; Start of batch area
  ;
  ; The batch engine is copied to the overlay region for execution.
  ; Because of this all relative addresses that access the monitor outside its overlay area need to be offset,
  ; along with the addresses in the batch command dispatch table.
  ;

  ;
  ; BA$ENG - Batch engine
  ;
  ; The stack pointer below is used for abort/restart
  ; And to switch context between batch/interactive modes
  ;
  B$AREG:

  B$ASTK:
    .WORD 0			;\ batch stack

  PROCEDURE BA$ENG
  BEGIN
    LET B$ASTK    := SP		;/+batch over EPT
    LET	F$ISCK-OVLREG := #0	; invalidate batch file checksum
    $GOTO BA$CMD
  END BA$ENG

  ; Command loop

  PROCEDURE BA$CMD
  BEGIN
    .ADDR R0 :=	#BA$ABT
    SetAbt			; BA$ABT ; generic batch command abort

  .IF EQ BTCH.V-2
    LET   R0 := #0
    SetLin
  .ENDC

    GetLin			; get something

    IF RESULT IS CC GOTO BA$EXI	; end of chain file

    GOTO BA$DIS			; dispatch command
  END BA$CMD

  ;
  ; Batch QUIT command and BA$EXI
  ;
  ; Cancels batch file and returns to CLI
  ; BA$CMD and BA$ABT branch here for batch EOF and abort
  ;
  PROCEDURE BA$EXI
  BEGIN

  ENTRY BC$QIT

    LET SP := B$ASTK		; nix - restore stack

    RETURN
  END BA$EXI

  ;
  ; BA$ABT - Batch abort
  ;
  ; Abort routine (from set abort above)
  ;
  PROCEDURE BA$ABT
  BEGIN
    IF R0 NE #0 THEN		; got an abort message?
      .ADDR3 R0 := R0		; relocate
      TypBrk			; breakthrough message
    END
    GOTO BA$EXI			; quit batch
  END BA$ABT

  ;
  ; Batch dispatch table
  ;
  ; Batch command routine pointers
  ; The dispatcher adds the constant 6250 to form addresses
  ;
  ; SMI CMI L S R E C
  ; GOTO WAIT QUIET PRINT
  ; END QUIT IFLMD IFERR IF
  ;
  B$ADIS:
    .WORD BC$SMI+OVLREG  ; SMI
    .WORD BC$CMI+OVLREG  ; CMI
    .WORD BC$LOA+OVLREG  ; Load
    .WORD BC$STA+OVLREG  ; Start
    .WORD BC$RUN+OVLREG  ; Run
    .WORD BC$ENB+OVLREG  ; Enable
    .WORD BC$CHN+OVLREG  ; Chain
    .WORD BC$GTO+OVLREG  ; Goto 
    .WORD BC$WAI+OVLREG  ; Wait
    .WORD BC$QUI+OVLREG  ; Quiet
    .WORD BC$PRT+OVLREG  ; Print
    .WORD BC$END+OVLREG  ; End
    .WORD BC$QIT+OVLREG  ; Quit
    .WORD BC$ILM+OVLREG  ; Iflmd 
    .WORD BC$IER+OVLREG  ; Iferr
    .WORD BC$IFT+OVLREG  ; If
    .WORD 0

  B$ALOO:
    .ASCIZ "SMI"
    .ASCIZ "CMI"
    .ASCIZ "L"
    .ASCIZ "S"
    .ASCIZ "R"
    .ASCIZ "E"
    .ASCIZ "C"
    .ASCIZ "GOTO"
    .ASCIZ "WAIT"
    .ASCIZ "QUIET"
    .ASCIZ "PRINT"
    .ASCIZ "END"
    .ASCIZ "QUIT"
    .ASCIZ "IFLMD"
    .ASCIZ "IFERR"
    .ASCIZ "IF"
    .EVEN

  ;
  ; BA$DIS - Dispatch batch command
  ;
  ; R0/R1 are carefully preserved by the dispatcher.
  ; They are used (redundantly) by the batch END command.
  ;
  PROCEDURE BA$DIS
  BEGIN
    ParFld			; get a command name
      NOP			; ignore errors

    IFB (R0) NE #0 ANDB (R0) NE #SCOLON ANDB R1 NE #': THEN ; non empty line, non comment and non label: ?

      ; R0 ->	field
      ; R1 =	terminator
      ; R2 ->	B$ALOO
      ; R4 ->	B$ADIS 

      .ADDR2 R4 := #B$ADIS	; R4 -> dispatch table

      .ADDR2 R2 := #B$ALOO	; R2 -> lookup table

    10$:

      LET R3 := R0		; R0/R3 -> field

      REPEAT
      UNTILB R1 EQ -1(R3) ORB (R3)+ NE (R2)+ ; skip until hit terminator or we do

      IFB -1(R2) EQ #0 THEN	; end of lookup table entry? if no - do the next

        IFB -1(R3) EQ #0     GOTO 50$ ; also the end of the field? yes - we have a command
        IFB -1(R3) EQ #SPACE GOTO 50$ ; space is also field end - we have a command

      END

      REPEAT			; skip remainder of name
      UNTILB (R2)+ EQ #0

      IF (R4)+ NE #0 GOTO 10$	; more lookup entries to come? - go to if yep

      LET R0 := #M$SBER		; no - Batch "?ER"
      TypMon
      GOTO 60$			; wind back to batch engine

      ;
      ; Call batch command
      ;
      ; R0 ->	command field
      ; R1 =	terminator
      ;

    50$:

      LETOR R4 := (R4)		; R4 -> dispatch entry and relocate
      CALL (R4)			; call command
      CALL MO$RST-OVLREG 	; restore monitor
    END

  60$:
    GOTO BA$CMD			; get another command (again)
  END BA$DIS

  M$SBER:
    .ASCIZ "?ER"<CR><LF>	; Batch "?ER" (the only batch error message)

  .SBTTL Load Start Run Chain Goto Wait Quiet Print			(batch)

  ;
  ; Batch LOAD file command
  ;
  ; L filespec
  ;
  ; BC$LOA	Batch Load command EPT
  ; BU$LOA	Batch Run command EPT
  ;
  ; CL$RUN has a description of the filename parsing strategy.
  ;
  PROCEDURE BC$LOA
  BEGIN
    LET   S$YLOA-OVLREG :B= S$YLOA-OVLREG + #1 ; LOAD in-progress (not RUN)
    $GOTO BU$LOA
  END BC$LOA

  PROCEDURE BU$LOA
  BEGIN
    ParFld			; get "FILNAM"
      GOTO 20$			; error

    PUSH R0			; save field start

    REPEAT			; hunt for terminator in R1
    UNTILB (R0)+ EQ R1		; until end of string

    LET -1(R0) :B= #'.		; replace with "."
    LET	(R0)+  :B= #'B		; add "BIC"
    LET (R0)+  :B= #'I
    LET (R0)+  :B= #'C
    LET (R0)   :B= #0		; terminate string

    LET R0 := (SP)+		; get field address back

    LET C$LNXT-OVLREG := C$LNXT-OVLREG + #4 ; add four to the line end pointer to accommodate the added ".BIC"

    ; R0 -> filespec

    LET R1 := #0		; R1 = base address
    LoaFil			; load image
    LET S$YLOA-OVLREG :B= #0	; clear LOAD in-progress flag

  20$:
    RETURN
  END BU$LOA

  ;
  ; Batch START program command
  ;
  ; S[/repeat] [address]
  ;
  PROCEDURE BC$STA
  BEGIN
    CALL BU$STA			; get the start address
    GOTO BU$ACT			; activate
  END BC$STA

  ;
  ; BU$STA - Get batch Run/Start start address or repeat count
  ;
  ; in R1 = command field terminator
  ;
  ; S 200	start at 200
  ; S/5		repeat five times
  ; S/5 200	start 200, repeat five times
  ;
  ; Odd start addresses are silently rejected				(note)
  ;
  PROCEDURE BU$STA
  BEGIN
    LET S$YSTA-OVLREG := #1	; default start state
    LET S$YRPT-OVLREG := #1	; default repeat count

    IF R1 EQ #'/ THEN		; decimal switch? (if no - octal address)
      ParDec			; translate decimal
        GOTO 20$		; oops
      LET S$YRPT-OVLREG := R0	; store repeat count, check for address
    END

    ParOct			; get the octal start address
      GOTO 20$			; no such luck
    IF #1 OFF.IN R0 THEN	; even address? (we're not all LSI's you know)
      LET S$YSTA-OVLREG := R0	; start/load address
    END

  20$:
    RETURN
  END BU$STA

  ;
  ; BU$ACT - Batch Start/Run program common
  ;
  PROCEDURE BU$ACT
  BEGIN
    IF #1 NE S$YSTA-OVLREG THEN	; No LDA?
      LET S$YACT-OVLREG := S$YSTA-OVLREG ; image activate address
    ELSE
      IF #1 EQ S$YACT-OVLREG THEN	; activate address likewise #1 (no - has something real)
	LET S$YACT-OVLREG := #200	; yes - default to @#200 activation address
      END
    END

    ; Configure low-memory syscom

    GetDev			; R0 -> 

    LET R1        :B= DV.UNI(R0) - #'0	; get the ascii unit number, make a digit
    LET @#SY.DEV  :B= R1		; 40: unit number
    LET @#SY.COD  :B= DV.MED(R0)	; 41: device media code
    LET @#V.EMT   := S$YEMT-OVLREG	; 30: emt vector
    LET @#V.EMT+2 := S$YEMT+2-OVLREG	; 32: ditto

    .ADDR -(SP) := #BU$RET	; image return path
    POP @#SY.EXI		; SY.EXI: -> app return path
    LET 30$ := SP		; save stack

    ; Activate batch program

    CALL @S$YACT-OVLREG		; call ye app

  ENTRY BU$EXI

    LET  SP :=  30$		; restore stack
    CALL BU$PR7			; back to PR7
    CALL EM$RST-OVLREG 		; rebuild emt vector
    LET  R0 := #0		; R0=0 status

    RETURN

  30$:
    .WORD 0
  END BU$ACT

  ;
  ; Batch RUN command
  ;
  ; R file[/repeat][address]
  ;
  ; CL$RUN has a description of the filename parsing strategy.
  ;
  PROCEDURE BC$RUN
  BEGIN
    ParFld			; get a filespec
      RETURN			; filename error
    PUSH R0			; save field 
    CALL BU$STA			; get a start address or repeat count	
    POP  C$LNXT-OVLREG		; restore field
    CALL BU$LOA			; load image
    GOTO BU$ACT			; activate
  END BC$RUN

  ;
  ; Batch CHAIN command
  ;
  ; C filnam.typ
  ;
  ; The batch chain command does not accept switches			(note)
  ; The batch chain command must have an explicit file type		(note)
  ;
  ; Batch officially supports one level of chain nesting.		(note)
  ; However, no checks are made to see if additional nesting  takes place.
  ; More accurately, batch allows a single return level.
  ;
  PROCEDURE BC$CHN
  BEGIN
    ParFld 			; get a filespec
      GOTO 10$			; fail

    ; Invoke the batch engine recursively

    PshBat 			; up chain level and open batch file
    PUSH B$ASTK			; save the current batch stack

      CALL BA$ENG		; call the batch engine

    POP  B$ASTK			; restore our stack
    PopBat			; pop nest chain file, return to prior

  10$:
    RETURN
  END BC$CHN

  ;
  ; Batch GOTO command
  ;
  ; GOTO label
  ;  ...
  ; label:
  ;
  ; Batch first searches forward through the file. It rewinds to the beginning of the file if the forward search fails. (note)
  ; If that forward search fails, it again rewinds, and so on, forever. It may be yet another code space saving device.
  ;
  ; There's an omitted branch just before 40$ that saves another word, relying on the ParFld that follows to fail and	(note)
  ; branch back to 30$.
  ;
  PROCEDURE BC$GTO
  BEGIN
    LETOR R2 := #S$YGTO		; batch goto buffer and relocate
    LET R4 := R2		; R2/R4 -> buffer
    ParFld 			; get the goto label
      GOTO 70$			; wrong - just return

    REPEAT
      LET (R4)+ :B= (R0)+	; copy field to buffer
    UNTILB (R0) EQ R1		; until we see the terminator

    LET (R4) :B= #0		; zero the end of the buffer string

    LET S$YQUI-OVLREG :B= S$YQUI-OVLREG - #1 ; mute quiet mode for messages

  30$:

    REPEAT
      GetLin			; search forward for the label
      IF RESULT IS CC THEN	; got a good line

        LET F$IPOS-OVLREG := #0	; hit EOF - rewind batch file
        LET F$ISCK-OVLREG := #0	; clear save checksum to force read

        ;GOTO 30$		; ParFld fails back to 30$ for us   	(note)
      END

      ParFld			; get the first field on the line
        GOTO 30$		; no field 

      IFB R1 NE #': GOTO 30$	; LABEL: ?

      LET R4 := R2		; R4 -> target label

      REPEAT
      UNTILB (R4)+ NE (R0)+	; R0 -> candidate label, until not fits

    ; did candidate end with ":" and not end with "/"? Or did target hit end of line? no - try the next chain file line
    UNTILB -1(R0) EQ R1 ANDB -1(R4) EQ #'/ ORB -1(R4) EQ #0

    LET S$YQUI-OVLREG :B= S$YQUI-OVLREG + #1 ; put that back how we found it

  70$:
    RETURN			; we are located at the label
  END BC$GTO

  ;
  ; Batch WAIT command
  ;
  ; WAIT
  ;   ...
  ; [ctrl/x]
  ;
  PROCEDURE BC$WAI
  BEGIN
    REPEAT
      GetAvl			; wait for operator ^X
      LET  S$YPND-OVLREG :B= #0	; no pending character
      CALL TE$CTC-OVLREG	; check ctrl/c
    UNTILB R0 EQ #a.can		; Ctrl/X? repea if nope
    GOTO BU$NEW			; newline and out
  END BC$WAI

  ;
  ; Batch QUIET command
  ;
  PROCEDURE BC$QUI
  BEGIN
    LET S$YQUI-OVLREG :B= NOT S$YQUI-OVLREG	; flip the quiet flop
    RETURN
  END BC$QUI

  ;
  ; Batch PRINT command
  ;
  ; PRINT some-message...
  ;
  ; ParFld returns a pointer to "some-message..."
  ;
  PROCEDURE BC$PRT
  BEGIN
    ParFld			; parse anything into the field
      GOTO BU$NEW		; nothing - so just newline
    TypBrk			; R0 -> display message 
    $GOTO BU$NEW		; add newline
  END BC$PRT

  ;
  ; BU$NEW - Display newline utility
  ;
  PROCEDURE BU$NEW
  BEGIN
    .ADDR3 R0 := #T$ENEW-OVLREG	; .BYTE CR,LF,0 and double relocation
    TypBrk			; display message
    RETURN
  END BU$NEW

  .SBTTL If IfLMD IfERR CMI SMI Enable					(batch)

  ;
  ; No terminator separates "THEN" from "END"				(note)
  ; Were they were trying to find yet another free word?
  ;
  B$ATHN:
    .ASCII "THEN"

  B$AEND:
    .ASCII "END"<377>

  ;
  ; BATCH IF command
  ;
  ; IF <switch> THEN
  ;   ...
  ; END
  ;
  PROCEDURE BC$IFT
  BEGIN
    ParFld			; R0 -> condition switch
      GOTO BU$NOP		; no hope
    CALL CU$CND-OVLREG		; parse chain condition
    IF RESULT IS CS GOTO BU$FAL	; false
    $GOTO BU$TRU
  END BC$IFT

  ;
  ; BU$TRU - Condition true utility
  ;
  ; For a true condition we need to parse our way past the THEN token.
  ;
  ; IFx <true condition> THEN
  ;   ...
  ; END
  ;
  ; B$ATHN actually points to "THENEND"					(note)
  ;
  PROCEDURE BU$TRU
  BEGIN
    ParFld			; get yet another field
      GOTO BU$ERR		; bummer

    .ADDR2 R2 := #B$ATHN	; THEN

    REPEAT
    UNTILB (R0)+ NE (R2)+	; shall I compare thee? to a summer's "THENEND"
    IFB -1(R0) NE #0 GOTO BU$ERR ; did we complete? nope - bummer
    GOTO BU$NOP			; yep
  END BU$TRU

  ;
  ; BU$FAL - Condition false utility
  ;
  ; IF <false-condition> THEN
  ;   ...
  ; END
  ;
  ; For a false condition we need to search for the next END statement (there is no nesting of IF-END).
  ;
  PROCEDURE BU$FAL
  BEGIN
    GetLin			; search chain file for "END"
    IF RESULT IS CC GOTO BU$NOP	; EOF - we're all done
    $GOTO BC$END
  END BU$FAL

  ;
  ; Batch END command
  ;
  ; I don't know why the batch END command comes here.					(note)
  ; The batch command dispatcher has already parsed "END". It looks like orphan code.
  ;
  PROCEDURE BC$END
  BEGIN
    .ADDR2 R2 := #B$AEND	; END
    REPEAT
    UNTILB (R0)+ NE (R2)+	; compare strings while they match
    IFB -1(R0) NE #0 GOTO BU$FAL ; source completed? no - keep searching
    GOTO BU$NOP			; found - return
  END BC$END

  PROCEDURE BU$ERR
  BEGIN
    LET R0 := #M$SBER		; batch "?ER"
    TypMon
    $GOTO BU$NOP
  END BU$ERR

  PROCEDURE BU$NOP
  BEGIN
    RETURN			; True
  END BU$NOP

  ;
  ; Batch IFLMD (If Low Media) command
  ;
  ; IFLMD <media code> THEN
  ;   ...
  ; END
  ;
  PROCEDURE BC$ILM
  BEGIN
    ParOct			; get the media code
      GOTO BU$NOP		; just return for error
    LET R1 := S$YDEV-OVLREG	; R1 -> device info

    IFB R0 EQ DV.MED(R1) GOTO BU$TRU ; media match?

    GOTO BU$FAL			; false
  END BC$ILM

  ;
  ; Batch IFERR (If Error) command
  ;
  ; IFERR THEN
  ;   ...
  ; END
  ;
  PROCEDURE BC$IER
  BEGIN
    IF S$YERR-OVLREG NE #0 GOTO BU$TRU ; has a program reported an error?
    GOTO BU$FAL			; false
  END BC$IER

  ;
  ; Batch SMI (Set Manual Intervention) command
  ;
  PROCEDURE BC$SMI
  BEGIN
    LET @#$JSW := @#$JSW SET.BY #SCMAN$	; SMI - Set manual
    RETURN
  END BC$SMI

  ;
  ; Batch CMI (Clear Manual Intervention) command
  ;
  PROCEDURE BC$CMI
  BEGIN
    LET @#$JSW := @#$JSW OFF.BY #SCMAN$	; CMI - Clear manual
    RETURN
  END BC$CMI

  ;
  ; BU$RET - Batch managed image exit
  ;
  ; BU$RET has two cases and three paths:
  ;
  ; SY.EXI =  0	Utility exit 
  ; SY.EXI != 0	Diagnostic exit
  ;
  ; Batch apps return here via @#SY.EXI with the protocol below:
  ; In the initialization section @#SY.EXI is set to $ENDAD. 
  ;
  ; .=SY.EXI	.WORD	$ENDAD	;; set loc.46(??) to address of $ENDAD in .$eop
  ; .=$JSW	.WORD	0
  ;
  ; ENDPAS:
  ;   LET R0 := @#SY.EXI	;; get monitor address
  ;
  ;   IF RESULT IS NE THEN	;; branch if no monitor
  ;    	RESET			;; clear the world
  ;
  ;   $ENDAD:
  ;
  ;     CALL (R0)		;; goto monitor (or loop forever)
  ;     NOP			;; save room
  ;     NOP			;; for
  ;     NOP			;;  act11
  ;
  ;   END
  ;
  ; $DOAGN:
  ;   JUNTO @(PC)+		;; return
  ;
  ; $RTNAD:
  ;   .WORD RSTART
  ;
  PROCEDURE BU$RET
  BEGIN
    CALL BU$PR7			; PR7
 
    LET S$YRPT-OVLREG := S$YRPT-OVLREG - #1 ; all iterations done (usually just one)?

    ; if not all iterations done and diagnostic and not /QV quick verify switch?

    IF RESULT IS NE AND @#SY.EXI NE #0 AND S$YQVS-OVLREG EQ #0 THEN ; Return for another pass
      RETURN			; repeat app
    END

    ; if all iterations done or utility or /QV quick verify switch

    JUMPTO BU$EXI		; exit image
  END BU$RET

  ;
  ; BU$PR7 - Set PR7 with RTI
  ;
  ; Classic kernel-mode SPL 7 routine
  ;
  PROCEDURE BU$PR7
  BEGIN
    PUSH   #PR7			; the PS to be and the PC to be
    .ADDR2 -(SP) := #20$	; and the PC to be
    RTI				; I now prounounce thee...
  20$:
    RETURN			; what! where'd they go?
  END BU$PR7

  ;
  ; Batch ENABLE command
  ;
  ; E <unit number>
  ;
  ; @DR.DEV (DR$DEV) updates the device ascii unit (DV.UNI) 
  ; The CLI code for this command is identical
  ;
  PROCEDURE BC$ENB
  BEGIN
    ParOct			; get a unit number
      GOTO 10$			; failed
    LET  D$RUNI :B=  R0		; store new unit number
    LETR R5 := #D$RIOB
    CALL @DR.DEV(R5)		; update driver 
  10$:
    RETURN
  END BC$ENB

  BALEN. =: .-B$AREG		; length of batch overlay

  B.LKB <<.-X$XBAT+^O<777>>&^C<^O<777>>-<.-X$XBAT>>

END HMBTCH

.END