 
*  EE5/DIREC   40 Col   May / 15 / 92
 
 
 
*------------------------------------------------------------
*  PGDIS  Display on screen a 10 line page of catalog entries
*         Line # in R3 - selects page containing that line
*------------------------------------------------------------
 
FLSTT  EQU  SPN10
 
 
*  Locate Top of Page in buffer
*------------------------------
 
TOPOPG EQU  $
       MOV  R3,R15            Copy current file pointer
       CLR  R14               Set up MSW for division
       DIV  @W10,R14          # of files per page
       MOV  R14,R9            Page # for immediate use
       MOV  R15,@CSRFIL       Copy # files down on page
       MPY  @W10,R14          Calculate file # at top of page
       MOV  R15,@PGFTOP       Save for use
       MOV  R15,R14           Get ready for next MPY
CPOINT MPY  @W0D,R14          Offset to file entry in CATBF
       AI   R15,CATBF         Set up CATBF first page pointer
       RT
 
*  Display page
*--------------
 
PGDIS  EQU  $
       MOV  R11,R5            Save return
       BL   @BEEPL
       BL   @TOPOPG
       BL   @PGC              Page # already in R9
       CLR  R4                Start counter for 20 files per page
       LI   R13,FLSTT         One line up from screen address at top
 
PDS1   BL   @UNPACJ           Decompress entry
       MOV  R13,R9            Copy pointer for use
       BL   @VMBWE            Write entry to screen
       DATA DRBF+1,32
       C    R4,@CSRFIL        Is it the one with the cursor
       JNE  PDS2              No
 
*  Construct MAIL-MIRROR entry and clear to length
 
       LI   R8,MFBUF          At FAC for temp use
       LI   R6,DSNAM+1
       MOVB *R6+,*R8+
       MOVB *R6+,*R8+
       MOVB *R6,*R8+
       MOVB @DR#,*R8
       AB   @H30,*R8+
       MOVB @PERIOD,*R8+      Then write in "."
       LI   R11,DRBF+2        Fetch name from packed entry
NMENT1 MOVB *R11+,*R8+        Copy to target after DSKx.
       CI   R11,DRBF+12       All 10 chrs max. done ?
       JL   NMENT1            Not yet
 
NMENT2 MOVB @DSPACE,*R8+      Fill with blanks
       CI   R8,MFBUF+36       End of mailbox ?
       JL   NMENT2            Not yet
 
       MOV  @TEMPF,@DVF80
       MOV  R13,R9
       BL   @VSTRM            Write in front of entry
       MOV  R13,R9            Copy  name screen pointer
       AI   R9,11             At end of name
       BL   @VSTRM            Write up mark
PDS2   MOV  @FILMRK,R11       Copy marked file pointer
       S    @PGFTOP,R11       Offset from top of page
       C    R4,R11            Is this the one ?
       JNE  PDS3              No
 
       MOV  R13,R9            Write file marker for last marked
       LI   R8,MARKED
       BL   @VSTRW
 
PDS3   INC  R4                Count one done
       AI   R15,>0D           Update buffer pointer
W0D    EQU  $-2
       AI   R13,40            Update screen pointer
       CI   R4,10             Page's worth ?
W10    EQU  $-2
       JL   PDS1              Repeat if more to go
 
       B    *R5               Restore return address
 
 
 
*  PGC/PGM  Display page #
*  -----------------------
 
PGC    EQU  $
       LI   R0,SP16
       JMP  PGN
PGM    LI   R0,SP17
PGN    MOV  R11,R7       Save return
       INC  R9           Make into actual page count
       BL   @RJNUM       Convert to string
       LI   R8,RJF#+1
       MOVB @TWO,*R8     Two digits at most
       MOV  R0,R9
       BL   @VSTRW       Write to screen
       B    *R7
 
*  INSTR  Write up command line
*  ----------------------------
 
INSTR  EQU  $
       MOV  R11,R14
       LI   R6,>26       Underline
       MOVB @UNDLN,R8
       BL   @VFILK
       DATA SPU20
       BL   @VSTRU       Commands
       DATA FWBK,SPM10
       BL   @VSTRU       <keys>
       DATA KEYS,SPM20
       BL   @VFILI
       DATA 40,920
       B    *R14
 
 
 
*  RJNUM  Takes integer in R9 and puts STR$
*         in RJF# with leading zeros suppressed.
*         Uses R6,R8,9,10,12,14
*  ------------------------------------------------------
 
RJNUM  EQU  $
       LI   R12,8
RJNUMA MOV  R11,R6       Save return
       MOV  R10,R14
       LI   R10,RJF#     Buffer
       BL   @NXDIG       TI-Wr routine
 
       LI   R10,RJF#     Suppress
RJ3    CB   *R10,@AZERO   leading
       JNE  RJ4          zeros
       CI   R10,RJF#+3   except
       JEQ  RJ4          for
       MOVB @DSPACE,*R10+ last.
       JMP  RJ3
RJ4    MOV  R14,R10
       LI   R8,RJN
       B    *R6
 
*  Write up headers for Directory screen
*---------------------------------------
 
HEADRS EQU  $
       MOV  R11,R14
       MOVB @UNDLN,R8
       LI   R12,VFILJ
       BL   *R12
       DATA 35,SPU10
       BL   *R12
       DATA 35,SP20
       BL   *R12
       DATA 38,SPU20
       LI   R12,VSTRU
       BL   *R12
       DATA PAGNO,SP15-1
       BL   *R12
       DATA USED,SP30
       BL   *R12
       DATA AVAIL,SP35
       BL   *R12
       DATA BYTES,SP36
       BL   *R12
       DATA FLCAP,SP40
       BL   *R12
       DATA ULN2,SP45
       BL   *R12
       DATA FLCT,SP50
       B    *R14
 
 
*  DRENT  Directory entry routine
*         Forms entry in DRBF from sector in PBF1
*  ----------------------------------------------
 
DRENT  EQU  $
       MOV  R11,R10
       BL   @MOVE             Fetch filename and flag bytes
       DATA PBF1,DRBF+2,>12   Fetch enough of record for now
       MOVB @DRBF+14,R8       To MSB with file flags
       MOV  @DRBF+16,R7       Copy file length
       MOVB @DRBF+19,R6       To MSB with Reclen
       MOVB R8,R14            Make a copy of file flags
       SRL  R14,9             Check LSBit of MSB
       JNC  DRT10             Not a Program file
 
       LI   R14,>8000         Program
       CLR  R6                Make sure Reclen is stored as zero
       JMP  DRT20             Don't worry about rest
 
DRT10  MOV  R8,R14            Copy file flags
       ANDI R14,>8200         Isolate F/V and D/I bits
       MOV  R14,R11           Copy masked out bits
       SRL  R11,7             F/V bit to LSB in byte
       SOCB R11,R14           0-3 in byte
       SLA  R14,5             Shift to bits 1-2
       ANDI R14,>E000
DRT20  MOVB R6,@DRBF+14       Write Reclen in compressed record
       SLA  R8,5              Check protection bit
       JNC  DRT30             Not set
 
       SOCB @H10,R14          Indicate protected in bit 3
DRT30  INC  R7                Include FDR
       ANDI R7,>0FFF          Only allow up to 4095 sectors
       SOC  R7,R14            Combine
       MOV  R14,@DRBF+12      Write to compressed record
       BL   @MOVE             Fetch 2 bytes of 2nd cluster
       DATA PBF1+>1F          28+3 offset
       DATA DREGS+14,2        Write to R7
       ABS  R7                Check it
       JEQ  DRT40             Null -->> no fractures
       SOCB @B80,@DRBF+2      Set hi-bit on 1st char of name
DRT40  B    *R10              Update Sec #1 pointer in PBF2
 
 
*---------------------
*  Unpack Buffer entry
*---------------------
 
UNPACJ EQU  $
       MOV  R11,R10           Save return - alternate entry
       MOV  R15,R9            Copy catalog buffer pointer
       BL   @MOVF             Fetch from VDP
       DATA DRBF+2,>0D        13 bytes into DRBF
       JMP  UNPC10
 
UNPACK EQU  $
       MOV  R11,R10           Save return
UNPC10 LI   R11,>2020         Set length byte
       LI   R14,DRBF          Coincidentally an ASCII space
       MOV  R11,*R14+         At start of buffer area
       C    *R14,R11          Spaces ?
       JNE  UNPC30            Entry exists
 
*  Clear line and quit
 
UNPC20 MOV  R11,*R14+
       CI   R14,DRBF+36
       JL   UNPC20
       JMP  UNPKEX            Return immediately
 
*  Process entry
 
UNPC30 LI   R8,DRBF+15        Blank out buffer
UNPC40 MOVB R11,*R8+
       CI   R8,DRBF+36
       JL   UNPC40
 
       MOVB *R14,*R14         Check first byte of name
       JGT  UNPC50            Normal ->> unfractured
       MOVB @ASTRIX,@DRBF+17  Indicate fracture then
       SZCB @B80,*R14         Clear fracture indicator
UNPC50 MOV  @DRBF+12,R14      Type(3)+Prt(1)+File(12)
       SRL  R14,13            Protected ?
       JNC  UNPC60            No
 
       MOVB @ASCP,@DRBF+30    Write in indicator
UNPC60 SLA  R14,3             x 8 again on Type
       CLR  @TEMPF            Use as temp flag
       CI   R14,4*8           Check offset value
       JNE  UNPC65            Not a program file
       CLR  R9                Make sure for program
       JMP  UNPC70
 
UNPC65 MOVB @DRBF+14,R9       Get Reclen
       CI   R14,1*8           D/I or D/F ?
       JH   UNPC70            No
 
       CB   R9,@B50           Reclen = 80 ?
       JNE  UNPC70            No
 
       SETO @TEMPF            OK for <V>iew
UNPC70 AI   R14,TYPTBL        Index into list
       LI   R0,DRBF+18        Move Type into buffer
       MOV  *R14+,*R0+        Write 8 bytes
       MOV  *R14+,*R0+        Even to even
       MOV  *R14+,*R0+
       MOV  *R14,*R0+
       SRL  R9,8              Word value for Reclen
       JEQ  UNPC80            Must have been program file
       BL   @RJNUM            Convert to string
       INCT R8                Write to buffer
       MOVB *R8+,*R0+         Byte address unfortunately
       MOVB *R8+,*R0+
       MOVB *R8,*R0
UNPC80 LI   R0,DRBF+12
       MOV  *R0,R9            Fetch Size again
       ANDI R9,>0FFF          Mask to size
       MOVB @DSPACE,*R0+
       BL   @RJNUM
       INC  R8
       MOVB *R8+,*R0+
       MOVB *R8+,*R0+
       MOVB *R8+,*R0+
       MOVB *R8,*R0
UNPKEX B    *R10
 
 
 
*  Sector reading routine, setup VDP buffer first
*  Expects sector # in R7, uses R9,10
*  ----------------------------------------------
 
SECRD  EQU  $
       MOV  R11,R10      Save return
       INCT @DSRTYP
SECRN  LI   R9,VDPPAB    Point to PAB
       MOV  R9,@SCNAME
       LI   R8,PN
       BL   @VSTRW
       LI   R11,FAC+2    Byte saver
       MOVB @DR#,*R11+   Disk drive selected
       MOVB @READ,*R11+  Set for read op
       MOV  @PBF,*R11+   Point to sector buffer
       MOV  R7,*R11      Sector #
       BLWP @TWDSLK      Find & execute DSR
       JEQ  DSERR
       MOVB *R11,R12     Check if error returned
       JEQ  DSREX
 
       A    @CRUINC,@CRUSTT    Next DSR
       C    @CRUSTT,@CRUEND    Last ?
       JL   SECRN             Try it
 
DSERR  BL   @VSTRU            Error message
       DATA ERMSG,SPM30+1
HOLD   BL   @KWAIT            Wait for key
       JMP  HOLD
 
 
HLD10  LI   R10,EXIT
DSREX  DECT @DSRTYP
       B    *R10
 
 
*  Form catalog printline
*------------------------
 
CATLIN MOV  R11,R0       Save return
       BL   @CPOINT      Absolute buffer pointer
       MOV  R15,R9       Copy VDP pointer
       BL   @MOVF        VMBR
       DATA DRBF+2,>0D
       MOV  R0,R11
       B    @UNPACK      Form screen entry and return
 
*  Draw line
*-----------
 
LINDRW MOV  R11,R15      Save return
       LI   R8,'--'      Dash line
       BL   @VFILJ       Fill it
       DATA 64,PABBUF+8
       BL   *R5          To buffer
       LI   R14,LINBUF   Now clear line bufer
       MOV  R15,R11      Restore return
       B    @MFILL       Go back this way
 
 
*-------------
*  Delete file
*-------------
 
DELETE EQU  $
       MOV  R11,R13      Save return
       BL   @VFILI
       DATA 160,800
       BL   @VSTRU       Cautionary message
       DATA RUSURE,808
       BL   @VMBWD
       DATA 889,MFBUF,15
 
       BL   @BEEP        Audible feedback
DELT20 BL   @KWAIT       Check key
       NOP
       CB   *R8,@ASCY
       JEQ  DELT30
       CB   *R8,@ASCN
       JNE  DELT20
       B    @LEAV10      Yes - don't do it
 
DELT30 BL   @FILPRP      File preparation
       DATA >0700        Delete
       DATA MFBUF        Name in mailbox
       B    @ONCEMO      Done
 
 
*  Setup PAB and open file
*-------------------------
 
FILPRP EQU  $
       MOV  *R11+,@PABOC File op data
       MOV  *R11+,R8     Name location
       MOV  R8,R14       Copy
       AI   R14,>4E      End of buffer
       MOV  R11,R10      Save return
       MOVB @H0F,@CRUSTT Reset DSRLNK
       CLR  @LFLAG       For TI-Wr routine
 
       CLR  R0           Initialize counter
       LI   R9,VDPPAB+10 Name start in PAB
       BL   @SETWDA      VDP write address
SKIP10 C    R8,R14       At end ?
       JHE  NOPDEV       Yes
       CB   @DSPACE,*R8+      Space ?
       JEQ  SKIP10       Yes - try next
       DEC  R8           Back off for first nonspace
SKIP20 CB   @DSPACE,*R8  Look for space after name
       JEQ  SKIP30       Found
       INC  R0           Count length
       MOVB *R8+,@VDPWD  Write to PAB
       JMP  SKIP20       Get next
SKIP30 MOV  R0,@PABSO    PAB name length
       LI   R5,WRITEP    Byte savers
       LI   R1,MOVE
       LI   R4,VINIT
SKIP40 BL   @IO          Calls TI-Wr
       JMP  NOPDEV       Failure
       B    *R10         Normal return
 
*  Write to printer
*------------------
 
WRITEP MOVB @WRITE,@PABOC Set write op
       MOV  @SLRL,@PABLRL
READIT MOV  R11,R10      Save return
       JMP  SKIP40
 
 
*  Error trapping for View/PDir
*------------------------------
 
NOPDEV BL   @VSTRU       Error message
       DATA ERMSG,SPM30+1
       BL   @HONK        Noise
       BL   @KWAIT       Wait for <esc>
       JMP  $-4
       B    @CLOSIT      Go restore status quo
 
 
*  Print directory
*-----------------
 
PRINTD EQU  $
       MOV  R11,R13      Save return
       BL   @FILPRP      File preparation
       DATA >0016        Append
       DATA DEVNAM       SD-Print device in Editor
       BL   *R4
       BL   @LINDRW
       BL   *R1
       DATA SP10+8,LINBUF+8,10
       BL   *R1
       DATA SP50,LINBUF+19,14
       BL   *R1
       DATA SP30,LINBUF+36,19
       BL   *R1
       DATA SP35,LINBUF+57,12          1 54
       BL   @C2V
       BL   *R5
 
       BL   @LINDRW
 
       BL   *R1
       DATA SP40,LINBUF+9,29
       BL   *R1
       DATA SP40,LINBUF+44,29
       BL   @C2V
       BL   *R5
       BL   *R1
       DATA SP45,LINBUF+8,29
       BL   *R1
       DATA SP45,LINBUF+43,29
       BL   @C2V
       BL   *R5
 
       MOV  @MAXCNT,R2  # pages-1
       INC  R2
       SRL  R2,1
 
       CLR  R7
PRT10  C    R7,R2
       JHE  PRT40
 
       BL   *R4
       MOV  R7,R14
       BL   @CATLIN
       BL   @VSTRU
       DATA DRBF,PABBUF+7
       MOV  R7,R14
       A    R2,R14
       BL   @CATLIN
       BL   @VSTRU
       DATA DRBF,PABBUF+42
 
       BL   *R5
       INC  R7
       JMP  PRT10
 
PRT40  BL   @LINDRW
       BL   *R4
       BL   *R5               Drop through to Close File
 
 
*  Close file
*------------
 
CLOSIT BL   @CLOSE            Close file
       NOP                    IGNORE close error
LEAVE  BL   @VFILI            Clear screen
       DATA 960,0
       BL   @HEADRS           Rewrite screen header
       BL   @VMBWD            Retrieve top 4 lines & disk info
       DATA 0
       DATA SDTMBV,>A0
LEAV10 BL   @INSTR            Rewrite prompt lines
       B    *R13              Final return
 
*  Read error
 
RDERRA CI   R9,5              End of file ?
       JNE  NOPDEV            Much worse
       BL   @VSTRU            EOF to screen
       DATA EOFM,923
       BL   @BEEPL            Beep it
       BL   @KWAIT
       NOP
       JMP  CLOSIT            <esc>
 
 
*  Readout file to screen
*------------------------
 
TYPEFL EQU  $
       MOV  R11,R13           Save return
       BL   @VFILI            Clear screen
       DATA 960,0
       BL   @VMBWD            Write filename from mailbox
       DATA 929,MFBUF,15
       BL   @FILPRP           File prep
DVFOP  DATA >0014             Open
       DATA MFBUF             From mailbox
       CLR  R2                Line counter
READFL BL   @VFILI            Clear screen
       DATA 920,0             But not last line
       MOV  R2,R9             Copy last count
       INC  R9                Next at top
       BL   @RJNUM            Decimal
       BL   @VSTRU            Display
       DATA RJN,950
 
       CLR  R15               Start of screen
RDFL05 CI   R15,840           End of "Type" area
       JL   RDFL20            No
 
RDFL10 BL   @KWAIT            Check key
       JMP  READFL            Any key - continue
       JMP  CLOSIT            Back - shut off
 
RDFL20 MOVB @READ,@PABOC      Read opcode
       MOV  R15,@PABBAD
       BL   @IOREC            Read record
       JMP  RDERRA            Error
 
       INC  R2                Line count
       MOV  R2,R9             Copy
       BL   @RJNUM            To decimal #
       BL   @VSTRU            Display
       DATA RJN,955
 
       LI   R8,40
       A    R8,R15
       MOV  R15,R9
       BL   @SETRDA
RDFL25 CB   @VDPRD,@DSPACE
       JNE  RDFL27
       DEC  R8
       JGT  RDFL25
       JMP  RDFL05
 
RDFL27 AI   R15,40
       JMP  RDFL05
 
 
SVPRTN DATA >BBBB
 
*  End in main file
 
