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

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

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

  FROM HMTERM IMPORT X$XTRA
  FROM HMROOT IMPORT D$RUNI
  FROM HMROOT IMPORT C$LAUT, C$LBUF, C$LLIN, C$LLEN
  FROM HMROOT IMPORT D$RUNI, D$RCSR, D$RIOB, D$RDIS
  FROM HMROOT IMPORT EM$ENG, EM$RST
  FROM HMROOT IMPORT F$IBUF
  FROM HMROOT IMPORT H$WLTC, H$WKWP
  FROM HMROOT IMPORT I$NR2,  I$NR6,  I$NR7,  I$NR8,  I$NR9,  I$NR13, I$NR14
  FROM HMROOT IMPORT S$YDEV, S$YCSR, S$YUNI
  FROM HMROOT IMPORT S$YPAD, S$YDAT, S$YLTC, S$YKWP, S$YLPT
  FROM HMROOT IMPORT S$Y5CK, S$YCFG, S$YKWD, S$YPER, S$YPGS, S$YREL, SPBOT, S$YSUP, S$YTOP
  FROM HMROOT IMPORT S$YLTK, S$YKTK, S$YTPB, S$YTPS, S$YTRA
  FROM HMROOT IMPORT X$XPER, XX$RST

  EXPORT QUALIFIED X$XINI
  EXPORT QUALIFIED IN$ENG

  .SBTTL Monitor structure						(data)

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

  ZERO =: ^O<0>

  .SBTTL Init engine (low memory)

  .PSECT XXDP0

  .PSECT XXDP1

  X$XBEG:

  ;
  ; IN$ENG - Initialization engine
  ;    
  ; Stack, terminal and EMT vector 
  ;
  PROCEDURE IN$ENG
  BEGIN
    LET SP     := #SPBOT	; stack
    LET S$YTPS := #TPS		; tps
    LET S$YTPB := #TPB		; tpb

    LET @#V.EMT   := #EM$ENG	; low memory EM$ENG			(note)
    LET @#V.EMT+2 := #PR7	; (is never invoked)

    ; Size memory

    LET @#V.TR4   := #20$	; trap to 20$
    LET	@#V.TR4+2 := #PR7

    LET R1 := #4000		; 1kw counter
    LET R3 := #4		; kw accumulator
    LET R0 := #20000		; start address (4kw)
				;
    REPEAT
      LET  (R0) := #ZERO	; this test is repeated at IN$SIZ
      CALL IN$SIZ		; count 1kw 
      LET R3 := R3 + #1		; kw counter up
      LET R0 := R0 + R1		; advance address
    UNTIL R0 HIS #160000	; end of universe?

    GOTO 30$			; yep

    ;
    ; Sizer trap
    ;
    ; R0 -> memory top - typically 160000

  20$:

    LET SP := SP + #4		; dump SetAbt PC/PS stack frame

				;memory image
  30$:

    LET S$YREL := R0 - #20000	;160000 20000 -> 140000 20000 relocation constant
    LET S$YTRA := R0 - #10000	;160000 10000 -> 150000 10000 transient area
    LET S$YPER := R0 - #6000	;160000  6000 -> 152000 12000 permanent area

    ; Checksum the transient .5k area 

    LET R2 := #X$XTRA			;10000	; from 10000 to 12000

    REPEAT
      LET S$Y5CK := S$Y5CK + (R2)+	;	; aka S$YTRA to S$YPER
    UNTIL R2 EQ #X$XPER			;12000	; done? repeat if not bloodly likely
						;
    LET S$YSUP := R0 - #37000		;01000	; supervisor load address

    ; Calculate MMU page count

    LET S$YKWD := R3			;#28.	; memory kiloword size
    LET R2 := R3 L.SHIFT 5 - #1		;	; calculate number of MMU pages, there are 32 per kiloword (2^5 is 32)
					;	; -> (n*32)-1 (to make it tangible)
    LET S$YPGS := R2			;511.	; 32w pages in system - 1

    ; Copy the kword digits for later display

    LET R3 := R3 L.SHIFT 1		;	; kwords * 2
    LET I$NKWD   :B= I$NKWS(R3) 		; first
    LET I$NKWD+1 :B= I$NKWS+1(R3) 		; second
    GOTO IN$CON					; skip to init continuation
  END IN$ENG

  ;
  ; Test 1kw of memory at a time
  ;
  PROCEDURE IN$SIZ
  BEGIN
    LET R2 := R0		; address

    REPEAT
      LET (R2)+ := #ZERO	; test location with write 
    UNTIL #3777 OFF.IN R2	; until we wrap 

    RETURN			; one kw more
  END IN$SIZ

  ;
  ; Process the monitor relocation list
  ;
  ; We relocate the low memory copy of the monitor just before copying the monitor to high memory.
  ;
  PROCEDURE IN$CON
  BEGIN
    LET R3 := S$YREL		; R3 = relocation constant
    LET R2 := #$LITTB		; R2 -> relocation list

    WHILE (R2) PL #0 DO		; while not end of table
      LET @(R2)+ := @(R2)+ + R3	; relocate another brother
    END				; more

    ; Copy up monitor and jump to high copy

    LET R1     := #20000	; top of low memory monitor
    LET S$YTOP := R0		; top of memory

    REPEAT
      LET -(R0) := -(R1)	; copy monitor up
    UNTIL R1 LOS #IN$HGH

    JUMPTO (R0)			; transfer to X$XHGH:
  END IN$CON

  ;
  ; Relocation list
  ;
  ; For a binary exact restoration of XXDP+ we need to follow the random order of entries in the table below.
  ;
  ; Each entry is created by a "LETPR dst, equ, src, idx" macro, where "idx" is the table index
  ;   (which can be elided for for a non-exact clone).
  ;
  $LITTB:
    .WORD I$NR1   ;  1
    .WORD I$NR2   ;  2 
    .WORD I$NR3   ;  3 
    .WORD I$NR4   ;  4 
    .WORD I$NR5   ;  5 
    .WORD I$NR6   ;  6 
    .WORD I$NR7   ;  7 
    .WORD I$NR8   ;  8 
    .WORD I$NR9   ;  9 
    .WORD I$NR10  ; 10 
    .WORD I$NR11  ; 11 
    .WORD I$NR12  ; 12 
    .WORD I$NR13  ; 13 
    .WORD I$NR14  ; 14 
    .WORD -1      ; stopper

  ;
  ; memory size table
  ;
  I$NKWS:
    .ASCII  " 0 1 2 3 4 5 6 7 8 910111213141516171819202122232425262728"

  I$NKWD:
    .ASCII "  K "		; "28K "	; memory size filled in
    .BYTE  0,0			; disassembly				(note)
;    .BYTE  0,12		; 10. ; XXDP+ live	(savm?)	(slip?)	(note)
    .EVEN

  .SBTTL Init engine (high memory)					(init)

  ;
  ; Beginning of high area
  ;
  PROCEDURE IN$HGH
  BEGIN
    LET SP := #SPBOT		; use the (unrelocated) system stack

    .ADDR R0 := #IN$HGH		; abort restarts us
    SetAbt			; IN$HGH ; (EMT vector-> low memory EM$ENG) (note)

    LET R2 := #0		; 0:1000 trap catchers
    LET R3 := #2		; 

    REPEAT
      LET (R2)+ := R3		; 000000: .WORD	.+2	; trap to @#2
      LET (R2)+ := #0		; 000002: .WORD	0	; aka HALT
      LET R3 := R3 + #4		; and so on
    UNTIL R2 EQ #1000		; upto 1000

    CALL EM$RST			; relocate EMT vector
    CALL IN$IOB			; relocate the IOB

    CALL @DR.DEV(R5)		; get ye device name "DD"
    LET  S$YDEV :=  R0		; S$YDEV -> D$RDEV: .ASCII "DDu"<med>
    LET  S$YUNI :B= D$RUNI	; S$YUNI
    LET  S$YCSR :=  D$RCSR	; S$YCSR

    LETPR C$LLIN := #C$LBUF, idx=12 ; C$OLIN - relocated

    LET   C$LLEN := #CLAVL.	; line available length
    LET   C$LAUT := @#I$NAUT	; copy automated startup flag

    .ADDR R0 := #50$		; 
    SetAbt			; 50$ ; abort skips messages

    TerMod			;
    NewLin			; new line even in quiet mode

    IF @#I$NAUT EQ #0 THEN	; quiet mode?

      LETPR R0 := #I$MMON, idx=1
      TypMsg			; Identify self
      LET R0 := #I$MBOO
      TypMon			; BOOTED VIA UNIT

      LET R0 :B= D$RUNI		; isolate unit number and make it readable
      LET R0 :=  R0 OFF.BY #^C7 + #'0
      PutChk
      NewLin
      LET R0 := #I$NKWD		; "28K" (#I$NKWD is unrelocated)
      TypMsg			;       (should be TypMon)	(bug)	(note)
    END

  50$:

    .ADDR -(SP) := #80$		; cpu traps to 80$
    POP	  @#V.TR10
    LET   @#V.TR10+2 := #PR7

    .ADDR -(SP) := #60$
    POP   @#V.TR4		; bus traps to 60$
    LET   @#V.TR4+2 := #PR7

    LET @#PS := #PR7		; check PS 	     (trap to 60$)
    MFPT			; get processor type (trap to 80$) 

.IF EQ <INIT.V-1>*<INIT.V-2>
    IF #3 NE R0 GOTO 90$	; F11: qbus 11/23, unibus 11/24, but if not 3 - not F11
.ENDC

.IF EQ INIT.V-3
    IF #1 EQ R0 GOTO 90$	; if non 11/44
    IF #3 NE R0 THEN		; if non F11

      IF #5 NE R0 GOTO 20$	; if non J11 - ask

      IF #1000 SET.IN @#CPUMR GOTO 90$ ; Maintenance register - Unibus system?
      GOTO 70$		    	 ; nonUnibus

    END

    MOV -(SP), @#V.TR10	;60$ ???
    LET R0 := #0
    LET @#SWREG := R0
    GOTO 90$

  ; ask
  20$:
.ENDC

    NewLin			; F11 can be unibus or qbus
    LET R0 := #I$MUBQ		; unibus question
    TypMon			; DOES THIS SYSTEM HAVE A UNIBUS (Y/N CR=Y)
    GetLin			; get response
    ParFld			; parse it
      NOP			; ignore errors

    IFB	(R0) EQ #'N GOTO 70$	; only recognized response is "N", if "N" - not a unibus system

    GOTO 90$			; anything else - a unibus system

  60$:
    CMP (SP)+, (SP)+		; PS bus trap - not unibus

  ; nonUnibus
  70$:
    LET S$YCFG := S$YCFG SET.BY #SYNUB$ ; no unibus

    IF @#I$NAUT EQ #0 THEN	; quiet?
      LET R0 := #I$MNON
      TypMon			; "NON"
      GOTO 90$			; then "UNIBUS"

  80$:
      CMP (SP)+, (SP)+		; MFPT cpu trap

  90$:
    AND @#I$NAUT EQ #0		; quiet?
      LET R0 := #I$MUBS
      TypMon			; "UNIBUS SYSTEM"
    END

    IF @#I$N50H NE #0 THEN	; 50 hertz time zone?
      LET S$YLTK := #50.	; setup LTC line clock tick counters
      LET S$YKTK := #50.	; setup KWP programmable clock counters
      LET S$YCFG := S$YCFG SET.BY #SY50H$ ; flag 50hz present
    END

    .ADDR R0 := #105$		; abort address
    SetAbt			; 105$ ; abort repeats test

  105$:

    IF @#I$NAUT NE #0 GOTO IN$HDW ; boot auto mode? Ifyes - skip date prompt and idents

    ; Get the date

    CALL  IN$DAT		; get the date
    LETPR R0 := #IN$HDW, idx=10	; relocated
    SetAbt			; abort skips messages
    LET R0 := #I$MRAD
    TypMon			; "RESTART ADDR: "
    LETPR R0 := #XX$RST, idx=3 	; XXDP system restart address
    LET R1 := C$LLIN		; a buffer
    OctAsc			; ascify it
    LET (R1) :B= #0		; terminate string
    LET R0 := C$LLIN		; get the buffer again
    TypMsg			; display restart address

    $GOTO IN$HDW		; get hardware configuration
  END IN$HGH

  ;
  ; Hardware, Config, System launch
  ;
  ; KW11P, line clock, line printer
  ;
  PROCEDURE IN$HDW
  BEGIN
    LETR @#V.TR4 := #10$	; trap to 10$

    TST @#PCCSR			; KW11P

    LET S$YKWP := H$WKWP
    LET S$YCFG := S$YCFG SET.BY #SYKWP$ ; PCCSR$ flag

  10$:
    LETR @#V.TR4 := #20$

    TST	@#LCCSR			; line clock

    LET S$YLTC := H$WLTC
    LET S$YCFG := S$YCFG SET.BY #SYLTC$	; LTC$ flag

  20$:
    LETR @#V.TR4 := #30$

    TST	@#LPS			; test line printer

    LET S$YCFG := S$YCFG SET.BY	#SYLPT$ ; LPT$ flag
    LET S$YLPT := #LPS		; line printer

  30$:
    $GOTO IN$FIN
  END IN$HDW

  PROCEDURE IN$FIN
  BEGIN
    IF @#I$NAUT EQ #0 THEN	; automated?
      .ADDR R0 := #10$
      SetAbt			; 10$ ; abort skips message
      NewLin
      LET R0 := #I$MXDP		; THIS IS XXDP+ ...
      TypMon
    END				

    ; Reset S$YPAD because it had preset boot-time info			(note)
  10$:

    LET S$YPAD :B= #1		; reset line padding

    ; Fill in missing trap catchers between 0..20

    LET R0 := #20		; R0 -> top of the area
    LET R1 := #16		; R1 -> a word below

    REPEAT
      LET -(R0) := #0		; 016: .WORD  0
      LET -(R0) := R1		; 014: .WORD  16 ...
      LET R1 := R1 - #4		; 002: .WORD  0
    UNTIL RESULT IS LE

    ; Launch XXDP monitor	;

    JUMPTO XX$RST		; system start and restart
  END IN$FIN

  .SBTTL Init date, messages, relocation				(init)

  ;
  ; IN$DAT - Date input 
  ;
  PROCEDURE IN$DAT
  BEGIN
    LOOP
      LET R0 := #I$MENT		; ENTER DATE..
      TypMon
      CALL IN$YMD		; parse year, month, day
        GOTO 10$		; failed
      RETURN			; fine

    10$:

      LET R0 := #I$MDAT		; INVALID DATE
      TypMon
    END				; try, try again
  END IN$DAT

  ;
  ; I$M... - Init messages
  ;
  I$MRAD:
    .ASCIZ <CR><LF>"RESTART ADDR: "

  I$MBOO:
    .ASCIZ <CR><LF>"BOOTED VIA UNIT "

  I$MENT:
    .ASCIZ <CR><LF>"ENTER DATE (DD-MMM-YY): "

  I$MDAT:
    .ASCIZ "? INVALID DATE"

  I$MNON:
    .ASCIZ "NON-"

  I$MUBS:
    .ASCIZ "UNIBUS SYSTEM"<CR><LF>

  I$MUBQ:
    .ASCIZ "DOES THIS SYSTEM HAVE A UNIBUS? (Y/N CR=Y) "

  I$MXDP:
    .ASCIZ |THIS IS XXDP+.  TYPE "H" OR "H/L" FOR HELP.|<CR><LF>

    E.VEN

  .WORD 0	;5242	; (savm)(slip)				(note)
  ; .WORD 0	;5242	; ??

  ;
  ; IN$YMD - Parse date year-month-day
  ;
  ;   Convert DD-MON-YY to DOSbatch date format
  ;
  ;   date = day-of-year + (year * 1000.)
  ;
  ;   day-of-year begins with 1, not 0
  ;
  PROCEDURE IN$YMD
  BEGIN
    LET S$YDAT := #0		; clear result
    GetLin			; get a response
    ParFld			; parse the first field
      NOP
    IFB (R0) NE #0 THEN		; got a response? if no - set the default date
      RptFld			; repeat the field
      CALL DT$DAY		; and parse it as a day
        GOTO 50$		;   errors return without a date setup
      LET  S$YDAT := R0		; S$YDAT = day (1..31)
      CALL DT$MON		; month
        GOTO 50$		;   error
      LET  R4 := R0		; R4 = month (0..11)
      CALL DT$YEA		; year
        BR 50$			;   error
      LET R2 := R0		; R2 = year

      ; Calculate the number of days since 1-Jan-70
    10$:

    .IF EQ INIT.V-1
      IF #3 OFF.IN R0 THEN
        LET S$YDAT := S$YDAT + #1
      END
    .ENDC

  .IF EQ INIT.V-3
      LET R0 := R0 OFF.BY #^C<^O<777>>
      LET R3 := #2
      WHILE R0 NE R3 DO
        LET R3 := R3 + #4
        IF R3 EQ #^D<30> GOTO 20$
      END
      LET S$YDAT := S$YDAT + #1
    20$:
  .ENDC

      LETR R0 := #DAYS 		; cumulative days in month, R0 -> table
      LET R4 := R4 L.SHIFT 1 + R0 ; make month word offset and relocate
      LET R0 := (R4)		; R0 = days in year
      LET S$YDAT := S$YDAT + R0	; add to the date
				; ??? dec R2|bmi 40$|etc

      LOOP
	IF R2 EQ #0 GOTO 40$	; any more years? go, if no more
        LET S$YDAT := S$YDAT + #1000. ; yes, add another thousand (^o1750)
        LET R2 := R2 - #1	; loop control
      END

    END

    ; default date

    LET S$YDAT := #1		; day = 1
    LET R4     := #0		; month = 0
    LET R2     := #0		; year = 0
    LET R0     := #0		; redundant: R0 is set at 10$		(note)

    GOTO 10$

  40$:
    LET TOP := TOP + #2		; was a good date

  50$:
    RETURN			; wasn't a fun evening

  END  IN$YMD

  ; Data area

  DAYS:
    .WORD 0
    .WORD 31.		; days in january
    .WORD 31.+28.	; january + february
    .WORD 31.+28.+31.	; etc
    .WORD 31.+28.+31.+30.
    .WORD 31.+28.+31.+30.+31.
    .WORD 31.+28.+31.+30.+31.+30.
    .WORD 31.+28.+31.+30.+31.+30.+31.
    .WORD 31.+28.+31.+30.+31.+30.+31.+31.
    .WORD 31.+28.+31.+30.+31.+30.+31.+31.+30.
    .WORD 31.+28.+31.+30.+31.+30.+31.+31.+30.+31.
    .WORD 31.+28.+31.+30.+31.+30.+31.+31.+30.+31.+30.

  ;
  ; Parse Day
  ;
  ; out R0 day (1:31)
  ;
  ; The <br 10$> following ParDec should be <br 20$> as is the analogous case for DT$MON and DT$YEA. (bug) (note)
  ; Because of this bug XXDP+ will accept almost anything in the day field (e.g. "XX-APR-70").
  ;
  PROCEDURE DT$DAY
  BEGIN
    ParDec			; get day-in-month
      GOTO 10$			; errors are aren't errors here! (bug)	(note)

    IFB	R1 NE #'- GOTO 20$	; must be dd-mmm-yy
    IF  R0 LE #0  GOTO 20$	; can't be zero
    IF R0 GT #31. GOTO 20$	; cant exceed 31.

  10$:
    LET TOP := TOP + #2		; good 

  20$:
    RETURN			; not good
  END DT$DAY

  ;
  ; Parse month
  ;
  ; out	R0 month (0:11)
  ;
  PROCEDURE DT$MON
  BEGIN
    ParFld			; get something
      GOTO 50$			; that was too much to ask

    IFB R1 EQ #'- THEN		; must have "-" separator, also too much to ask
      LET   R2 := R0		; R0 -> user input
      LETPR R1 := #MONTHS, idx=4 ; month names relocated
      LET   R0 := #0		; month-in-year result

      REPEAT
        IFB (R1) EQ (R2) ANDB 1(R1) EQ 1(R2) ANDB 2(R1) EQ 2(R2) GOTO 40$ ; wow - we found it
        LET R0 := R0 + #1	; doh - next month, perhaps
        LET R1 := R1 + #3	; skip month name
      UNTIL R0 GT #11.		; more months to come? less or equile to 11. - yep

      GOTO 50$			; way too much to ask

  40$:
      LET TOP := TOP + #2	; fine
    END

  50$:
    RETURN			; fail
  END DT$MON

  ;
  ; Month table
  ;
  MONTHS:
    .ASCII "JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC"
    .EVEN

  ;
  ; Parse year
  ;
  ; out	R0 	year-1970
  ;
  PROCEDURE DT$YEA
  BEGIN
    ParDec			; get a year
      GOTO	10$		;  out of joint

    ; terminator must EOL - oh cursed spite, can't be negative (that I was born), 1999 ends our world (to set it right)

    IF R1 EQ #0 AND R0 GE #0 AND R0 LE #99. THEN
      LET R0 := R0 - #70.	; 1970 starts it
    AND RESULT IS GE THEN	; and greather or equile - year is after 1970, else error
      LET TOP := TOP + #2	; fine
    END

  10$:
    RETURN			; fail
  END DT$YEA

  ; IO$IOB - Relocate IOB						(init)

  PROCEDURE IN$IOB
  BEGIN
    LETPR R5 := #D$RIOB, idx=5	; IOB
				; driver header in R5?
    LETR R2 :=  #D$RDIS		; driver function dispatch table + relocation constant
    LET R4 := #4		; counter
    REPEAT
      .ADDR3 R0 := (R2)		; get a pointer, 2-step relocation
      LET    (R2)+ := R0	; put it back
      LET    R4 := R4 - #1	; do more
    UNTIL RESULT IS EQ

    ; Relocate driver IO.UFD and IO.BUF

    .ADDR3 R0          := IO.UFD(R5) ; relocate 10(R5), 2-step relocation
    LET    IO.UFD(R5) := R0	     ; put it back

    LETPR DR.BUF(R5) := #F$IBUF, idx=11 ; relocated

    RETURN
  END IN$IOB

  I$MMON:
    $IDENT

  X$XEND:

  .PSECT XXDP0

  ; 01000
  X$XINI:

  ; Init prologue

  I$N50H:
    .WORD 0			;1000	; 60/50 hertz clock 	  (patch point)

  I$NAUT:
    .WORD 0			;1002	; automated startup flag  (patch point)

  X$XGAP:

  $GAP$ = ^O<5000> - X$XEND + X$XBEG - 4

  B.LKB $GAP$

END HMINIT

.END IN$ENG