;*****************************************************************************
; SHRINK.M68    -       "Shrinks" a random file
;
; by Dave Heyliger - AMUS Staff
;
; Purpose: to shrink a random file without copying block-by-block. The blocks
;          that are "chopped off" are gone to the wind - it is up to you to
;          make sure that these blocks are not important.
;
; NOTE: the program requires a DSKANA after execution - SHRINK informs you of
;       this requirement upon completion.
;*****************************************************************************

       AUTOEXTERN                              ;must "lnklit shrink"

       SEARCH  SYS                             ;get the normals
       SEARCH  SYSSYM
       SEARCH  TRM

       VMAJOR=1                                ;define a version number
       VMINOR=0                                ;original by Dave Heyliger

       PHDR    -1,0,PH$REE!PH$REU!PH$OPR       ;must be in the OPR: account

       .OFINI                                  ;define variables
       .OFDEF  PPNDDB,D.DDB                    ;DDB for PPN reads
       .OFDEF  RNDDDB,D.DDB                    ;DDB for the random file
       .OFDEF  PPNPTR,4                        ;DIR block link pointer
       .OFSIZ  IMPSIZ                          ;IMPSIZ has total byte count

       ;start of program
       GETIMP  IMPSIZ,A5                       ;A5 points to user memory vars

       ;process the input line
       BYP                                     ;bypass BS
       LIN                                     ;just a CR?
       BNE     10$                             ;nope, get the filespec
       TYPE    <Usage: SHRINK {dev:filespec[PPN]}>
       TYPECR  < - filespec must be a random file.>
       EXIT

       ;get the filespec
10$:    LEA     A4,RNDDDB(A5)                   ;point to the random DDB
       FSPEC   @A4                             ;filespec the input file
       INIT    @A4                             ;initialize the filespec
       LOOKUP  @A4                             ;find it?
       BEQ     20$                             ;yup
       CRLF                                    ;nope,
       MOV     #7,D1                           ;get a bell
       TTY                                     ;beep!
       TYPE    <?Cannot locate >               ;error message
       PFILE   @A4
       CRLF
       EXIT                                    ;and quit

       ;see if the file is random...
20$:    CMPW    D.WRK+6(A4),#-1                 ;random file?
       BEQ     30$                             ;yup
       CRLF                                    ;nope
       MOV     #7,D1                           ;get a bell
       TTY                                     ;beep!
       PFILE   @A4                             ;error message
       TYPECR  < is not a random file.>
       EXIT                                    ;and quit

       ;inform user of the consequences
30$:    MOV     #7,D1                           ;get a bell
       TTY                                     ;beep!
       CRLF                                    ;crlf
       TYPECR  <       WARNING: you are about to "chop off" some blocks.>
       TYPECR  <       These blocks will be "lost" if you continue.>
       CRLF
       TYPE    <       Enter "Y" to continue....  >
       KBD                                     ;get the "Y"
       CTRLC   EXIT                            ;here on ^C
       CMPB    @A2,#'Y                         ;yes, continue???
       BEQ     CONT                            ;yup
EXIT:   EXIT

       ;get the original block size, ask for new size
CONT:   MOV     D.WRK(A4),D1                    ;D1 holds number of blocks
       MOV     D1,D2                           ;D2 holds a copy
       CRLF                                    ;crlf
       TYPE    <Original size of >             ;user message...
       PFILE   @A4                             ;type out filespec
       TYPE    < is: >
       DCVT    0,OT$TRM                        ;here is original size
       CRLF                                    ;crlf down two lines
       CRLF                                    ;crlf
       TYPE    <New desired size: >            ;ask for new size
       KBD                                     ;wait for input
       GTDEC                                   ;get the input
       MOV     D1,D3                           ;D3 holds copy
       SUB     D1,D2                           ;sub "larger" from "smaller"
       BPL     10$                             ;if positive, continue
       CRLF                                    ;crlf
       MOV     #7,D1                           ;get a bell
       TTY                                     ;beep!
       TYPECR  <?New desired size must be LESS than Original size.>
       CRLF
       EXIT

       ;now find the file in the DIR
10$:    LEA     A2,PPNDDB(A5)                   ;point to PPNDDB
       CLR     D1                              ;fussy data registers
       MOVW    D.PPN(A4),D1                    ;D1 holds the PPN
       MOVW    D.PPN(A4),D.PPN(A2)             ;move in DEV:[PPN]
       MOVW    D.DEV(A4),D.DEV(A2)
       MOVW    D.DRV(A4),D.DRV(A2)
       INIT    @A2                             ;initialize the DDB
       CALL    $FNPPN                          ;find the PPN
       CMP     D0,#0                           ;find it?
       BEQ     20$                             ;yup
       MOV     #7,D1                           ;get a bell
       TTY                                     ;beep!
       TYPECR  <?PPN not found.>
       CRLF
       EXIT

       ;now find the DIR blocks and begin to look (A1 points to MFD entry)
20$:    MOVW    2(A1),D.REC+2(A2)               ;set block number
25$:    READ    @A2                             ;read in the block
       MOV     D.BUF(A2),A0                    ;A0 points to block read in
       MOVW    (A0)+,PPNPTR(A5)                ;save block link

       ;for each DIR block, look for the file 42. times until end of DIR
30$:    MOV     #42.,D4                         ;D4 counter
35$:    CMM     @A0,D.FIL(A4)                   ;filename match?
       BNE     40$                             ;nope
       CMMW    4(A0),D.EXT(A4)                 ;extension match?
       BNE     40$                             ;nope
       BR      50$                             ;yup, found file, A0 pointer

       ;come here on non-match
40$:    DEC     D4                              ;one less slot to examine
       BEQ     45$                             ;if done w/ block, get next
       ADD     #12.,A0                         ;else point to next slot
       BR      35$                             ;and look again

       ;come here when time for next block
45$:    MOVW    PPNPTR(A5),D.REC+2(A2)          ;set new block number
       BR      25$                             ;and scan the DIR some more

       ;come here when A0 points to file entry in block
50$:    MOVW    D3,6(A0)                        ;"write" new block size
       WRITE   @A2                             ;write changes to disk
       CRLF                                    ;crlf
       MOV     #7,D1                           ;get a bell
       TTY                                     ;beep!
       TYPECR  <       SHRINKing complete...  %Run DSKANA immediately!>
       EXIT

       END