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

MODULE NAME=<DTMON>, VER=<001>, COMM=<DDP1-V001>, TYPE=<NOSECT>

  .NLIST
    .INCLUDE /DDPCM.MAC/
  .LIST

  EXPORT QUALIFIED DTBEG$, DTEND$, START

  ZERO =: ^O<0>

  .ASECT
  .=^O<0>

  DTBEG$:

  V.0:
    .WORD V.0+2
    HALT

  V.4:
    .WORD V.4+2
    HALT

  V.10:
    .WORD V.10+2
    HALT

  V.BPT:
    .WORD V.BPT+2
    HALT

  V.IOT:
    .WORD V.IOT+2
    HALT

  V.PWFL:
    .WORD V.PWFL+2
    HALT

  V.EMT:
    .WORD V.EMT+2
    HALT

  PROCEDURE START
  BEGIN
    RESET
    LET   SP := #^O<1000>
    $GOTO GMEMSZ
  END START

  PROCEDURE GMEMSZ
  BEGIN
    LET V.4 := #PV4
    LET R0  := #^O<20000-400>
    LET R1  := #0
    LET R2  := #7				; 160000/20000

    REPEAT
      LET R0   := R0   + #20000			; 37400, 57400, 77400, 117400, 137400, 157400, 177400
      LET (R0) := (R0) + #ZERO

      LET R1 := R1 + #1
      LET R2 := R2 - #1
    UNTIL RESULT IS EQ

    LET R1 := R1 - #1

    $GOTO CHKMEM
  END GMEMSZ

  PROCEDURE CHKMEM
  BEGIN
    LET V.4 := #V.4+2

    IF R1 NE #0 GOTO STMSIZ

    CALL MES
      .WORD ANOMEM

    LOOP
      HALT
    END
  END CHKMEM

  PROCEDURE PV4
  BEGIN
    LET TOP := #CHKMEM
    RTI
  END PV4

  PROCEDURE STMSIZ
  BEGIN
    LET R1     := R1 L.SHIFT 1
    LET AMEMSZ := ACMEM(R1)
    $GOTO MRELOC
  END STMSIZ

  PROCEDURE MRELOC
  BEGIN
    LET R0 := R0 - #20000 - #DTTOP-DTMON	; (177400-20000-> 157400 (MonitorTop))-MonitorSize -> Monitor Buttom
    LET R1 := R0 - #DTMON			; Relocation base

    LET P1INBF := P1INBF + R1
    LET PSPTOP := PSPTOP + R1
    LET PDSKBF := PDSKBF + R1
    LET PDTMON := PDTMON + R1
    LET P2INBF := P2INBF + R1
    LET P3INBF := P3INBF + R1

    $GOTO MMOVE
  END MRELOC

  PROCEDURE MMOVE
  BEGIN
    LET R1 := #DTMON
    LET R2 := #DTTOP-DTMON

    REPEAT
      LET (R0)+ :B= (R1)+
      LET R2    :=  R2 - #1
    UNTIL RESULT IS EQ

    $GOTO ADVERT
  END MMOVE

  PROCEDURE ADVERT
  BEGIN
    LET R0 := PDTMON				; Entry and restart point
    LET R1 := #ARSTRT				; Buffer for address

    LET R2 := #^O<6>				; Number of digits

    LET R1 := R1 + R2				; At buffer and

    REPEAT
      LET R3 := R0 OFF.BY #^C<^O<7>> + #'0
      LET -(R1) :B= R3
      LET R0 := R0 OFF.BY #^O<7> R.ROTATE 3
      LET R2 := R2 - #1
    UNTIL RESULT IS EQ

    CALL MES
      .WORD ATITLE

    JMP @PDTMON
  END ADVERT

  ACMEM:
    .ASCII | 4|
    .ASCII | 8|
    .ASCII |12|
    .ASCII |16|
    .ASCII |20|
    .ASCII |24|
    .ASCII |28|

  ATITLE:
    .ASCII |%%DDP1-V001 |

  AMEMSZ:
    .ASCII |  K RSTRT: |

  ARSTRT:
    .ASCII |      @|

  ANOMEM:
    .ASCII |%INSUFFICIENT CORE@|

    E.VEN

  Stack R0 R1 R2 R3 R4 R5 PC PS

  PROCEDURE MES
  BEGIN
    JSR R5, SAV05
    LET R5 := SP.PC(SP)				; Argument pointer
    LET R0 := (R5)+

    LOOP
      LET R1 :B= (R0)+

      IFB #'@ EQ R1 THEN
        LET  SP.PC(SP) := R5
        CALL RST05
        RETURN
      END

      IFB #'% EQ R1 GOTO CRLF

  ENTRY CHOUT1

      CALL CHROUT

    END
  END MES

  PROCEDURE CHROUT
  BEGIN
    LET @#TPB :B= R1
    REPEAT
    UNTILB @#TPS MI #0
    RETURN
  END CHROUT

  PROCEDURE CRLF
  BEGIN
    LET  R1 :B= #CR
    CALL CHROUT
    LET  R1 :B= #LF
    GOTO CHOUT1
  END CRLF

  SPTOP:

  BLKNUM:
    .WORD 0

  DSKBUF:
    B.LKW <^O<1000>/2>

  INBUF:
    .BYTE 0, 0, 0, 0, 0, 0

  PROCEDURE DTMON
  BEGIN
    RESET
    LET SP := PSPTOP
    $GOTO GETCMD
  END DTMON

  PROCEDURE GETCMD
  BEGIN
    LOOP
      LET R0 := P1INBF				; -> INBUF
      LET R1 := #6,

      REPEAT
        LET (R0)+ :B= #SPACE
        LET R1    :=  R1 - #1
      UNTIL RESULT IS EQ

      CALL SHODOT

      LET R0 := P1INBF
      LET R1 := #7

      LOOP
        REPEAT
        UNTILB @#TKS MI #0

        LET R2 :B= @#TKB OFF.BY #^C<^O<177>>

        IFB #del EQ R2 LEAVE LOOP

        IFB #CR EQ R2 GOTO 20$

        CALL SHOCHR

        LET R1 := R1 - #1
        IF RESULT IS EQ LEAVE LOOP

        LET (R0)+ :B= R2
      END

    10$:

      CALL SHOQUE
    END

  20$:

    LET R2 := #LF*^O<400>+CR

    CALL SHO2CH
    IF P1INBF EQ R0 GOTO 10$

    $GOTO INTERP
  END GETCMD

  PROCEDURE INTERP
  BEGIN
    JSR R5, TRAD50

  P2INBF:
    .WORD INBUF

    LET R3 := R4

    JSR R5, TRAD50

  P3INBF:
    .WORD INBUF+3

    LET  BLKNUM := #^D<66>

    CALL DTREAD
    CALL FNDUFD

    LET  BLKNUM := #^D<67>

    CALL DTREAD
    CALL FNDUFD

    LET R2 := #"E4

    $GOTO SHERR
  END INTERP

  PROCEDURE SHERR
  BEGIN
    CALL SHNLCH
    GOTO GETCMD
  END SHERR

  PROCEDURE SHOQUE
  BEGIN
    LET   R2 := #'?
    GOTO SHNLCH
  END SHOQUE

  PROCEDURE SHODOT
  BEGIN
    LET R2 := #'.
    $GOTO SHNLCH
  END SHODOT

  PROCEDURE SHNLCH
  BEGIN
    PUSH R2

      LET  R2 := #LF*^O<400>+CR
      CALL SHO2CH

    POP  R2
    CALL SHO2CH

    RETURN
  END SHNLCH

  PROCEDURE SHO2CH
  BEGIN
    LET @#TPB :B= R2
    REPEAT
    UNTILB @#TPS MI #0

    SWAB R2
    $GOTO SHOCHR
  END SHO2CH

  PROCEDURE SHOCHR
  BEGIN
    LET @#TPB :B= R2
    REPEAT
    UNTILB @#TPS MI #0

    RETURN
  END SHOCHR

  ;
  ; Convert 3 ASCII chart to Radix-50
  ; Input:  R5 - pointer to pointer to buf
  ; Output: R4 - result
  ; On error - go to SHERR
  ;
  PROCEDURE TRAD50
  BEGIN
    LET R1 := (R5)+
    LET R2 := #3
    LET R4 := #0

    REPEAT
      LET R0 :B= (R1)+ - #'0

      IF R0 HI #<'9-'0> AND R0 NE #-2 THEN

        LET R0 := R0 - #21
        IF R0 LOS #31 GOTO 10$

        LET R0 := R0 - #-41
        IF RESULT IS EQ GOTO 20$

        LET R0 := R0 - #4
        IF RESULT IS NE THEN
          LET    R2 := #"E6
          JUMPTO SHERR
        END

        LET R0 := #-3
      END

      LET R0 := R0 + #35

  10$:
      LET R0 := R0 + #1

  20$:
      LET R4 := R4 L.SHIFT 3			; x8
      LET R0 := R0 + R4				; + x8
      LET R4 := R4 L.SHIFT 2			; x32
      LET R4 := R4 + R0				; + x8 + x32 -> + x40
      LET R2 := R2 - #1

    UNTIL RESULT IS EQ
    RTS R5
  END TRAD50

  PROCEDURE FNDUFD
  BEGIN
    LET R0 := PDSKBF
    LET R1 := #UFDFLC				; 28 file entries per UFD block for 512 bytes block

    LOOP
      IF R3 EQ (R0) AND R4 EQ EN.NAM(R0) AND #<^RBIN> EQ EN.TYP(R0) THEN ; EN.FIL
        LET  BLKNUM := EN.STA(R0)		; Start block
        GOTO LOAD
      END

      LET R1 := R1 - #1
      IF RESULT IS EQ LEAVE LOOP
      LET R0 := R0 + #EN.BBS
    END

    RETURN
  END FNDUFD

  RWORD:
    .WORD 0					; Readed word

  LDABLN:
    .WORD 0

  PROCEDURE LOAD
  BEGIN
    CALL READ					; Read first block

  10$:

    REPEAT
      LET R2 := #0				; Ckeck sum
      CALL GTBYTE
      LET R3 :B= R3 - #1
    UNTIL RESULT IS EQ

    CALL GTBYTE					; Check for zero second byte!!

    CALL GTWORD
    LET  LDABLN := RWORD - #4			; Length of current block minus length field minus address field

    IF #2 EQ LDABLN GOTO SBLK			; If Start Block

    CALL GTWORD					; Load address
    LET  R5 := RWORD

    LOOP
      CALL GTBYTE

      IF  RESULT IS LT THEN			; If block is over..
        IFB R2 EQ #0 GOTO 10$			; And checksum is correct - to next block
    CKSERR:					; Checksum error
        LET    R2 := #"E5
        JUMPTO SHERR
      END

      LET (R5)+ :B= R3				; Next byte
    END						; Repeat
  END LOAD

  PROCEDURE GTWORD
  BEGIN
    CALL GTBYTE
    LET  RWORD := R3
    CALL GTBYTE
    SWAB R3
    LET  RWORD := RWORD SET.BY R3
    RETURN
  END GTWORD

  PROCEDURE SBLK
  BEGIN
    CALL GTWORD					; Start addres
    CALL GTBYTE					; Checksum byte
    IFB R2 NE #0 GOTO CKSERR			; If ckecksum error

    CALL SHODOT

    LET RWORD := RWORD R.SHIFT 1		; Check for odd start address
    IF RESULT IS CS THEN
      JUMPTO GETCMD
    END
    LET RWORD := RWORD L.SHIFT 1

    PUSH   PDTMON				; Return address to monitor
    JUMPTO @RWORD				; Start program
  END SBLK

  PROCEDURE GTBYTE
  BEGIN
    IF R1 HIS #776 THEN				; End of block?
      CALL READ					; Yes - get next
    END

    LET R3 :B= (R0)+				; Next byte
    LET R1 :=  R1 + #1				; Readed bytes count
    LET R2 :=  R2 + R3
    LET R3 := R3 OFF.BY #^C<^O<377>> ; 177400, R3

    LET LDABLN := LDABLN - #1

    RETURN
  END GTBYTE

  PROCEDURE READ
  BEGIN
    CALL DTREAD
    LET  R0 := PDSKBF				; Pointer to second word (first - linked word - pointer to next block)
    LET  R1 := #0				; Readed bytes count
    RETURN
  END READ

  PROCEDURE SAV05
  BEGIN
    PUSH <R4, R3, R2, R1, R0>			; Save R4-R0
    LET PC := R5				; R5 is already saved
  END SAV05

  PROCEDURE RST05
  BEGIN
    POP <R5, R0, R1, R2, R3, R4>		; Return address, restore R0-R4
    RTS R5					; Restore R5 and return
  END RST05

  ;
  ; TC-11 driver
  ;

  ISOPRD:					; Is operation - read?
    .BYTE 0

  RSRCHC:					; Retry count for search
    .BYTE 0

  RREADC:					; Retry count for read
    .BYTE 0

  E.VEN

  ;
  ; Read block
  ; Input : PSPTOP - pointer to pointer to block number
  ; Output: PSPTOP - pointer to pointer to buf
  ;
  PROCEDURE DTREAD
  BEGIN
    JSR R5, SAV05

  RETRY:

    LET R5 := PSPTOP				; Pointer to Block num
    LET R1 := (R5)				; Block num
    LET R4 := #0
    LET (R5) := (R5) L.SHIFT 1			; Block num * 2
    IF RESULT IS CS THEN
      LET R4 := NOT R4				; Reverse move
      CLC
    END

    LET (R5) := (R5) R.SHIFT 1			; Block num

    LET R3 := #CM.REV				; Reverse

    LET @#TCBA := R5				; Buffer address (and link word at readed block)
    LET @#TCWC := #-400				; One block

    LET RSRCHC :B= #6				; Initial retry count for search
    LET RREADC :B= #3
    LET ISOPRD :B= #0				; Operation is block search

    LET R0 := #TCRNU$!TCDO$			; Read block number

    REPEAT						; on error retry cycle

      LOOP						; loop for search and read

        LOOP						; loop for read

          REPEAT					; loop for search and read

            LOOP					; loop for +3 block on forward moving
            
              REPEAT					; one time repeat on forward moving, many time repeat on reverse moving

                LOOP					; loop for -3 block on reverse moving

                  REPEAT				; one time repeat on reading and reverse moving, many time repeat on forward moving

                    LET @#TCCM := R0			; command

                    REPEAT				; wait for ready
                    UNTIL #TAERR$!TATRQ$ SET.IN @#TCCM

                    IFB ISOPRD NE #0  GOTO DTCERR	; If op is read - check on error and complete call, if success

                    ; No read - block searching

                    IF @#TCCM MI #0   GOTO CHKEZ	; If TAERR$ - check End Zone and others error

                    IF @#TCDT EQ (R5) GOTO BPFND	; If desired block - possible found

                    IF RESULT IS GT   GOTO POSAFT	; Current > desired

                  UNTIL R3 SET.IN @#TCCM		; Current < desired - repeat, if forward moving

                  LET @#TCDT := @#TCDT + #3		; +3 sectors for change to forward

                  IF @#TCDT LOS (R5) GOTO FDIR 		; If moved backward enough, change the direction to forward

                END

                ;
                ; Current > desired - reverse direction after block number "desired+3"
                ;
            POSAFT:
              UNTIL R3 OFF.IN @#TCCM			; repeat, if reverse moving

              LET @#TCDT := @#TCDT - #3			; +3 sectors for change to reverse

              IF (R5) LE @#TCDT GOTO RDIR	 	; If moved forward enough, change the direction to reverse

            END

          ;
          ; Desired block found, checking move and read direction
          ;
          BPFND:
            IF R3 SET.IN @#TCCM GOTO BPFRVR		; If reverse move - check read on reverse op

          UNTIL R4 EQ #0				; Forward move, if reverse read - repeat search, else - go to read

      ;
      ; Desired block found and move and read match in direction - switch to read
      ;
      BLKFND:
          LET ISOPRD :B= NOT ISOPRD			; Set read as current op flag
          LET R0     :B= #TCRDA$!TCDO$			; Set read as current op

        END

      ;
      ; Desired block found, reverse move. Is reverse read?
      ;
      BPFRVR:
        IF R4 NE #0 GOTO BLKFND				; If reverse read - block is founded - switch to read
							; Else - reverse move, forward read - repeat search
      END

    CHKEZ:

      IF @#TCST MI #0 GOTO INVDIR			; If TCEZ$ (End Zone of tape) - invert direction

    RRERR:						; Repeat on read error

      IF #TCPE$!TCMTE$!TCBME$!TCDME$ SET.IN @#TCST THEN	; Parity error, mark track error, block missed or data was missed
        LET RREADC :B= RREADC - #1			; Retry count for read

        IF RESULT IS NE THEN				; Once more try
          LET (R5) := R1
          GOTO RETRY
        END

        LET R2 := #"E2					; Read error

      ELSE
        LET R2 := #"E1					; Block search error
      END

    DTERR:						; Exit with error

      LET @#TCCM := @#TCCM OFF.BY #TCIE$!TCMSK$
      JUMPTO SHERR

    INVDIR:						; Invert direction

      IF R3 SET.IN @#TCCM THEN

    FDIR:						; Set forward direction
        LET R0 := R0 OFF.BY R3
      ELSE

    RDIR:						; Set reverse direction
        LET R0 := R0 SET.BY R3
      END

      LET RSRCHC :B= RSRCHC - #1			; Retry count for search

    UNTIL RESULT IS EQ

    LET  R2 := #"E3
    GOTO DTERR ; Exit with error

  DTCERR:						; Check on error and completed, if success

    IF @#TCCM MI #0 GOTO RRERR				; If error (on read) - repeat

    LET  @#TCCM := @#TCCM OFF.BY #TCIE$!TCMSK$

    CALL RST05

    RETURN
  END DTREAD

  P1INBF:
    .WORD INBUF

  PSPTOP:
    .WORD SPTOP

  PDSKBF:
    .WORD DSKBUF

  PDTMON:
    .WORD DTMON

  DTTOP:
    .WORD 0

  DTEND$:

  ; ??????????

  .REPT <<<.+^O<777>&^C<^O<777>>>-.>/4>
    .WORD DTMON
    .WORD 0
  .ENDR
  .NLIST ME

END DTMON

.END START