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

MODULE NAME=<DIR>, VER=<001>, COMM=<DIR Utility>, TYPE=<NOSECT>

  .NLIST
    .INCLUDE /DDPCM.MAC/
  .LIST

  .ASECT
  .=^O<0>

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

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

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

  .=^O<60>

  V.TKB:
    .WORD VKB
    .WORD PR4

  .PSECT

  PROCEDURE DIR
  BEGIN
    POP MRET
    LET SP := #DIR

    LET TKS := TKS SET.BY #^O<100>		; Enable interrupt from keyboard
    LET PS  := #^O<0>				; Lower priority

    LET RFCNT := #^O<0>				; Reverse file count

    LET  BLKNUM := #^D<66>			; Read UFD block #0
    CALL DTREAD					; Read
    CALL CNFILS					; Count the number of files
    IF RFCNT NE #0 THEN				; Reverse file count - if at least one file is found
      CALL UBDIR				; UFD block directory listing
    END

    LET  BLKNUM := #^D<67>			; Read UFD block #1
    CALL DTREAD					; Read
    CALL CNFILS					; Count the number of files
    CALL UBDIR					; UFD block directory listing

    LET RFCNT := RFCNT + #<UFDFLC*2>		; + Max files for two UFD block -> Free file descriptors count

    JSR R5, DECASC
      .WORD RFCNT				; Reverse file count
      .WORD AFCNT				; Buffer
      .WORD 2					; Digits count (2 UFD blocks - 56 files max)

    CALL MES					; Show free files count
      .WORD AFFILS

    JUMPTO @MRET
  END DIR

  ;
  ; Count the number of files
  ;
  PROCEDURE CNFILS
  BEGIN
    JSR R5, SAV05

    LET R0 := #^O<BUF+2>			; Buffer addres (skip link word)
    LET R1 := #UFDFLC				; UFD block File count

    REPEAT
      IF (R0) NE #0 THEN			; If file record valid
        LET RFCNT := RFCNT - #1
      END
      LET R0 := R0 + #EN.BBS			; Pointer to next file descriptor
      LET R1 := R1 - #1				; One file less
    UNTIL RESULT IS EQ				; Until UFD block completed

    CALL RST05
    RETURN
  END CNFILS

  ;
  ; UFD block directory listing
  ;
  PROCEDURE UBDIR
  BEGIN
    JSR R5, SAV05

    LET R0 := #^O<BUF+2>
    LET R1 := #UFDFLC				; UFD block File count

    REPEAT
      IF (R0) NE #0 THEN
        LET FILNAM        := (R0)		; EN.FIL
        LET FILNAM+EN.NAM := EN.NAM(R0)
        LET FILNAM+EN.TYP := EN.TYP(R0)
        LET FILLEN        := EN.LEN(R0)
        LET FILDAT        := EN.DAT(R0)

	JSR	R5, R50ASC
	.WORD	FILNAM
	.WORD	AFILNM

	JSR	R5, R50ASC
	.WORD	FILNAM+EN.NAM
	.WORD	^O<AFILNM+3>			; Skip first three chars

	JSR	R5, R50ASC
	.WORD	FILNAM+EN.TYP
	.WORD	^O<AFILNM+3+3+1+1>		; Skip file name chars, one space ana point

	JSR	R5, DECASC
	.WORD	FILLEN
	.WORD	AFLEN
	.WORD	3

	CALL	DATASC				; DOS-11 File date to Ascii

	CALL	MES				; Show next file info
	.WORD	AFDESC

      END

      LET R0 := R0 + #EN.BBS			; Pointer to next file descriptor
      LET R1 := R1 - #1				; One file less
    UNTIL RESULT IS EQ				; Until UFD block completed

    CALL RST05
    RETURN
  END UBDIR

  Stack R0 R1 R2 R3 R4 R5 PC PS

  ;
  ; Show Ascii string (with % as CRLF and @ as terminator char)
  ;
  PROCEDURE MES
  BEGIN
    JSR R5, SAV05
    LET R5 := SP.PC(SP)				; Argument pointer
    LET R0 := (R5)+

    LOOP
      LET R1 :B= (R0)+				; Next char

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

      IFB #'% EQ R1 GOTO CRLF			; If CRLF special char

  ENTRY CHOUT1

      CALL CHROUT				; Out char to TV

    END
  END MES

  ;
  ; Out char to TV
  ;
  PROCEDURE CHROUT
  BEGIN
    LET @#TPB :B= R1
    REPEAT
    UNTILB @#TPS MI #0
    RETURN
  END CHROUT

  ;
  ; CRLF for directory list
  ;
  PROCEDURE CRLF
  BEGIN
    LET  R1 :B= #CR
    CALL CHROUT					; Out char to TV
    LET  R1 :B= #LF
    GOTO CHOUT1					; Out char to TV
  END CRLF

  PROCEDURE EXIT
  BEGIN
    CALL   SHNLCH				; Show two chars on new line
    JUMPTO @MRET
  END EXIT

  ;
  ; Show two chars on new line
  ;
  PROCEDURE SHNLCH
  BEGIN
    PUSH R2

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

    POP  R2
    CALL SHO2CH					; Show two chars

    RETURN
  END SHNLCH

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

    SWAB R2
    $GOTO SHOCHR				; Show char
  END SHO2CH

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

    RETURN
  END SHOCHR

  PROCEDURE R50ASC
  BEGIN
    JSR R4, SAV04

    LET R4 := @(R5)+
    LET R3 := (R5)+

    LET R1 := #2
    PUSH #-1

    REPEAT
      PUSH R4
      LET R4 := #0

      ;
      ; Divide by 50??
      ;
      REPEAT
        LET R0 :=  (SP)
        LET R0 :B= R0 SET.BY (PC)		; 2 (010002)

        LET R2 := R0 R.ROTATE 1 R.SHIFT 1
        LET R0 := R0 - R2 OFF.BY #^O<37>
        LET TOP := TOP - R0

        LET R0 := R0 R.ROTATE 1 R.SHIFT 1
        LET TOP := TOP - R0

        LET R4 := R4 + R0
      UNTIL (SP) LOS #^O<47>

      LET R4 := R4 R.SHIFT 3
      LET R1 := R1 - #1
    UNTIL RESULT IS EQ

    IFB R4 HI #^O<47> GOTO 10$

    REPEAT
      IFB R4 NE #0 THEN

        IFB R4 EQ #^O<35> THEN
    10$:
          LET    R2 := #"E6
          JUMPTO EXIT
        END

        IFB R4    EQ #33 GOTO 30$
        IF RESULT IS HI  GOTO 20$

        LET R4 := R4 + #^O<40>

      END

      LET R4 := R4 + #^O<16>

    20$:
      LET R4 := R4 + #^O<11>

    30$:
      LET R4 := R4 + #^O<11>

      LET (R3)+ :B= R4

      POP R4

    UNTIL RESULT IS MI

    CALL RST04
    RTS  R5
  END R50ASC

  PROCEDURE DECASC
  BEGIN
    JSR R4, SAV04

    LET R0     := #DECBUF
    LET R1     := @(R5)+			; Num
    LET OBUF := (R5)+				; Buf
    LET NDIG := (R5)+				; Digit count

    LET R2     := #DECTAB
    LET DPCNT := #5

    REPEAT
      LET  DECP := (R2)+
      CALL N10DIG
      LET  DPCNT := DPCNT - #1
    UNTIL RESULT IS EQ

    LET R0     := R0 - NDIG
    LET K02006 := R0

    JSR R5, CPYBYT
      K02006:
        .WORD 0
      OBUF:
        .WORD 0
      NDIG:
        .WORD 0

    CALL RST04
    RTS  R5
  END DECASC

  PROCEDURE N10DIG
  BEGIN
    LET NXTDIG := #0

    LOOP
      LET R1 := R1 - DECP
      IF RESULT IS LO LEAVE LOOP
      LET NXTDIG := NXTDIG + #1
    END

    LET R1     :=  R1 + DECP
    LET NXTDIG :=  NXTDIG + #'0
    LET (R0)+  :B= NXTDIG
    RETURN
  END N10DIG

  DPCNT:
    .WORD 0					; Ten powers count

  NXTDIG:					; Next digit
    .WORD 0

  DECP:						; Current ten power
    .WORD 0

  DECTAB:					; Ten powers
    .WORD ^D<10000>
    .WORD ^D<1000>
    .WORD ^D<100>
    .WORD ^D<10>
    .WORD ^D<1>

  DECBUF:
    .ASCII |      |

  PROCEDURE CPYBYT
  BEGIN
    JSR R4, SAV04
    LET R0 := (R5)+
    LET R1 := (R5)+
    LET R2 := (R5)+
    REPEAT
      LET (R1)+ :B= (R0)+
      LET R2    :=  R2 - #1
    UNTIL RESULT IS EQ
    CALL RST04
    RTS R5
  END CPYBYT

  ;
  ; DOS-11 File date to Ascii
  ;
  PROCEDURE DATASC
  BEGIN
    JSR R5, SAV05

    LET R3 := #MONTHS				; <232><2>|DEC|<36>|NOV|...

    LET R2 := #12

    LET R4 := #AFDATE				; |  -   -  @|

    LET R5 := #^D<69>

    LET R0 := FILDAT

    REPEAT
      LET R5 := R5 + #1
      LET R0 := R0 - #^D<1000>
    UNTIL RESULT IS LO

    IF #3 OFF.IN R5 THEN
      LET AFEB :B= AFEB + #1
      LET R0   :=  R0 - #1
    END

    LET R1 := (R3)+

    REPEAT
      LET R0 := R0 + R1
      IF RESULT IS GT GOTO 10$

      LET R3 :=  R3 + #3
      LET R1 :B= (R3)+
    UNTIL RESULT IS EQ

    LET R0 := #0

  10$:

    LET R1 := #^O<<'9+1>*400+<'0-1>>

    REPEAT
      LET R1 := R1 + #1
      LET R0 := R0 - R2
    UNTIL RESULT IS LO

    IFB R1 GE #^O<'9+1>

      LET R1 := R1 - R2
    END

    CALL SBYTE					; Save byte
    SWAB R1
    LET  R1 := R1 + R0
    CALL SBYTE					; Save byte

    LET R0 := R5
    IF RESULT IS EQ GOTO SETFEB			; Set february day count

    LET R5 := #4000

  20$:

    LET R1 := #55
    LOOP
      CALL SBYTE				; Save byte

      LET R5 := R5 L.SHIFT 1
      IF RESULT IS CS GOTO 10$
      IF RESULT IS MI GOTO 20$

      LET R1 :B= (R3)+
    END

  END DATASC

  ;
  ; Save byte
  ;
  PROCEDURE SBYTE
  BEGIN
    LET (R4)+ :B= R1
    RETURN
  END SBYTE

  ;
  ; Set february day count
  ;
  PROCEDURE SETFEB
  BEGIN
    IFB #^D<28> NE AFEB THEN
      DECB AFEB
    END

    CALL RST05
    RETURN
  END SETFEB

  PROCEDURE VKB
  BEGIN
    LET INCHR := TKB
    LET INCHR := INCHR OFF.BY #^C<^O<177>>
    IF #3 NE INCHR THEN
      RTI
    END
    JUMPTO @MRET
  END VKB

  INCHR:
    .WORD 000000

  PROCEDURE SAV05
  BEGIN
    JSR R4, SAV04
    LET PC := R5
  END SAV05

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

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

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

  ISOPRD:
    .BYTE 0

  RSRCHC:
    .BYTE 0

  RREADC:
    .BYTE 0

  .EVEN

  ;
  ; 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 := #BUF				; 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 EXIT

    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

  AFDESC:
    .ASCII |%|						; CR LF

  AFILNM:						; File name and extension
    .ASCII |       .      |

  AFLEN:						; File length
    .ASCII |      |

  AFDATE:
    .ASCII |  -   -  @|

  AFFILS:
    .ASCII |%%FREE FILES: |

  AFCNT:
    .ASCII |  @|

  MONTHS:
    .WORD ^D<666>
    .ASCII |DEC|<^D<30>>|NOV|<^D<31>>|OCT|<^D<30>>|SEP|<^D<31>>|AUG|<^D<31>>|JUL|<^D<30>>
    .ASCII |JUN|<^D<31>>|MAY|<^D<30>>|APR|<^D<31>>|MAR|
  AFEB:
    .ASCII <^D<28>>|FEB|
    .ASCII <^D<31>>|JAN|<0>|XXX |

  ;
  ; Reverse file count
  ;
  RFCNT:
    .WORD 0

  FILNAM:
    .WORD 0, 0, 0

  FILLEN:
    .WORD 0

  FILDAT:
    .WORD 0

  MRET:						; Monitor return address
    .WORD 0

  BUF:
  BLKNUM:
    .WORD 0

END DIR

.END DIR