home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / utils / squsq / crnch24s.lbr / COMMON.LZB / COMMON.LIB
Text File  |  1988-02-18  |  63KB  |  2,141 lines
  1. ;***********************************************************************
  2. ;*                                       *
  3. ;*               COMMON.LIB v2.4                   *
  4. ;*                                       *
  5. ;*    This is an "include" file used in both CRUNCH and UNCRunch.    *
  6. ;*    Occasional differences are handled by conditional assembly.    *
  7. ;*    (ie "CRUNCH" is TRUE if CRUNCH is being assembled, not UNCR)   *
  8. ;*                                       *
  9. ;***********************************************************************
  10. ;
  11. ; Copy (pip) routine. All files are assumed closed on entry. The name
  12. ; of the input file should be in place in INFCB. No other assumptions
  13. ; are made. This is a no frills byte by byte copy; the main objective
  14. ; was to keep this simple by using existing routines.
  15. ;
  16. COPY:    CALL    INTRAM        ; Mostly to init the i/o pointers
  17.     LD    A,(DIFDU)    ; Do not copy a file onto itself
  18.     ADD    A,0FFH
  19.     CCF
  20.     RET    C        ; If input du: = output du:, rtn w/ c set
  21.  
  22.     LD    DE,MSGCPY    ; "Copying..."
  23.     CALL    MESAG2
  24.     LD    HL,INFCB
  25.     CALL    PRNFIL        ; Type the filename being copied
  26.  
  27.     LD    DE,INFCB+12    ; Zero out the input fcb except d: & filename
  28.     CALL    CLRFC2
  29.     CALL    OPNIN        ; Open the input file
  30.     RET    C        ; Failed to open, forget it (** add msg why?)
  31.  
  32.     LD    DE,OUTFCB    ; Set up the output fcb
  33.     CALL    CLRFCB        ; First clr it
  34.     CALL    CPYNAM        ; Now copy the name from the input fcb
  35.     CALL    OPNOUT        ; Open the output file
  36.     JR    NC,IOOK        ; Br if all's ok so far
  37.     CALL    CLSIN        ; Else close the input file and return
  38.     SCF            ; (indicates no copy took place)
  39.     RET
  40.  
  41. IOOK:    LD    A,'$'        ; Set this flag to "$" (convenient later)
  42.     LD    (DIRFLG),A    ; (non-zero val indicates doing "direct" copy)
  43.     LD    A,(QUIFM)
  44.     OR    A
  45.     CALL    Z,CRLF        ; Do an extra CRLF in "quiet" mode here
  46.  
  47. XFERLP:    CALL    GETBYT        ; }
  48.     JR    C,XFRDUN    ; } Main copying loop.
  49.     CALL    OUTB        ; } Get bytes and output them till done.
  50.     JR    XFERLP        ; }
  51.  
  52. XFRDUN:    CALL    DONE        ; Flush the output buffer
  53.     CALL    CLSOUT        ; Close input and output files
  54.     CALL    CLSIN        ;
  55.  
  56.      IF    CRUNCH        ; Uncr never deals with archive bits
  57.     CALL    ARCIT        ; Flag as archived, if requested
  58.      ENDIF            ;
  59.  
  60.     AND    A        ; Guarantee clr carry for successful return
  61.     RET
  62. ;
  63. ;................................
  64. ;
  65. CPYNAM:    LD    HL,INFCB+1    ; Copies filename from input fcb to output fcb
  66.     LD    DE,OUTFCB+1
  67.     LD    B,11        ; Char count
  68.  
  69. LDRLP2:    LD    A,(HL)        ; }
  70.     AND    7FH        ; }
  71.     LD    (DE),A        ; } Like LDIR, but strip hi-bit
  72.     INC    HL        ; }
  73.     INC    DE        ; }
  74.     DJNZ    LDRLP2        ; }
  75.  
  76.     RET
  77. ;...............................
  78. ;
  79. ;-----------------------------------------------------------------------
  80. ;
  81. ; Tag (sweep) mode code. Go thru the expanded wildcard filname list,l
  82. ; allowing the user to tag individual files.
  83. ;
  84. TAG:    LD    DE,MSGTAG    ; Instructions for tagging files
  85.  
  86. RESTRT:    CALL    MESAGE        ; Come back here if he wants to try again
  87.  
  88.     LD    HL,FNBUFF    ; Buffer containing all the filenames
  89.     XOR    A
  90.     LD    (FILNUM),A    ; Which file number we're on. Init to zero.
  91.  
  92. TAGLP:    LD    A,(FILNUM)    ; Incr file number each time thru loop
  93.     INC    A
  94.     LD    (FILNUM),A    ; (a maximum of 255 filnames are allowed)
  95.  
  96.     LD    D,H        ; Keep a copy of ptr to this filename in DE
  97.     LD    E,L
  98.     LD    A,(HL)        ; The first byte is a flag, next 11 are chars
  99.     OR    A        ; Get the files status (tagged / untagged)
  100.     JP    M,TDUN        ; If msb set, must be "FF" (end of list flag)
  101.     PUSH    AF        ; Else save zero / non-zero status
  102. ;
  103. ;...............................
  104. ;
  105.     PUSH    BC        ; Type out the filename's number,
  106.     PUSH    DE        ; Followed by a period & space.
  107.     PUSH    HL
  108.     LD    A,(FILNUM)
  109.     LD    L,A
  110.     LD    H,0
  111.     CALL    DECOUT
  112.     LD    A,'.'
  113.     CALL    TYPE
  114.     LD    A,' '
  115.     CALL    TYPE
  116.     POP    HL        ; (DECOUT wrecks all the registers)
  117.     POP    DE
  118.     POP    BC
  119. ;
  120. ;...............................
  121. ;
  122.     INC    HL        ; Move to first filename char position
  123.     LD    B,8        ; Spec 8 chars to be typed
  124.     CALL    PCHRS        ; Do that
  125.     LD    A,'.'        ; Follow that w/ a period
  126.     CALL    TYPE
  127.     LD    B,3
  128.     CALL    PCHRS        ; Now type the three ext chars of the filename
  129.     LD    A,":"        ; Follow that with a colon.
  130.     CALL    TYPE
  131.     POP    AF        ; Get stat back
  132.     JR    Z,NOSTAR    ; Br if not already tagged
  133. ;
  134. ;.......................................................................
  135. ;
  136. ; Get user response. This code for a filename which is already tagged
  137. ;
  138.     LD    A,'*'        ; Already tagged, so type a "*"
  139.     CALL    TYPE
  140.     CALL    RESPT        ; Get user's response
  141.     CP    'U'        ; Untag?
  142.     JR    NZ,CKBACK    ; If not, leave it alone (but go check for 'b')
  143.  
  144. ;................................
  145.                 ; "Untag" a filename. Overwrite the "*",
  146.     LD    A,BS        ; Already on the screen, with
  147.     CALL    TYPE        ; Destructive backspace.
  148.     LD    A,' '
  149.     CALL    TYPE
  150.     XOR    A
  151.     JR    PUTTAG        ; And go zero out the tag
  152. ;
  153. ;...............................
  154. ;
  155. ;.......................................................................
  156. ;
  157. ; Get user response. This code for a filename which is NOT already tagged
  158. ;
  159. NOSTAR:    CALL    RESPT        ; Get user response
  160.     CP    'T'        ; Tag it?
  161.     JR    NZ,CKBACK    ; No, leave it (but go check for 'b')
  162.     LD    A,'*'        ; Yes, tag the file
  163.     CALL    TYPE
  164.     LD    A,01H        ; "01" for tagged files ("00" = untagged)
  165.  
  166. PUTTAG:    LD    (DE),A        ; Set the flag byte as "tagged" or "untagged"
  167. LEAVIT:    CALL    CRLF        ; (entry here leaves it the way it was)
  168.     JR    TAGLP        ; Loop to next file
  169. ;
  170. ;.......................................................................
  171. ;
  172. ; Check if user issued the "B" ("back one file") command and process it
  173. ; if so
  174. ;
  175. CKBACK:    CP    'B'        ; Did he type "B"?
  176.     JR    NZ,LEAVIT    ; No, leave file the way it was and move on
  177.  
  178.     LD    A,(FILNUM)    ; Yes, move back one file
  179.     DEC    A        ; Decrement the file number counter
  180.     JR    NZ,BKUPOK    ; We will not allow backing up past file #1
  181.     LD    DE,MSGBEL    ; So beep if he tries that
  182.     JP    RESTRT
  183.  
  184. BKUPOK:    DEC    A        ; Decr again to make up for the upcoming incr
  185.     LD    (FILNUM),A
  186.     LD    DE,-24        ; Also decr the filname pointer "twice"
  187.     ADD    HL,DE        ; (ie 2 x 12 bytes per filename w/ flag byte)
  188.     CALL    CRLF
  189.     JR    LEAVIT        ; And continue...
  190. ;
  191. ;.......................................................................
  192. ;
  193. ; Done with tagging process for all files (hopefully, but we will allow the
  194. ; user to reconsider). If he's happy, then return.
  195. ;
  196. TDUN:    LD    DE,MSGOK    ; "Selections OK? (Y/N):"
  197.     CALL    MESAGE
  198.  
  199. TRYAGN:    CALL    RESPT        ; Get his response
  200.     LD    DE,MSGCLF    ; CR/LF/LF
  201.     CP    'N'        ; Was it "no"?
  202.     JP    Z,RESTRT    ; If so, restart
  203.     CP    'Y'        ; Was it "Yes"?
  204.     JR    Z,ALRITE    ; Br if so.
  205.     LD    A,BELL        ; He must answer "Y "or "N" to this; no default
  206.     CALL    TYPE        ; So beep at him and let him answer again
  207.     JR    TRYAGN
  208.  
  209. ALRITE:    LD    A,'Y'        ; Simulated "Y" echo
  210.     CALL    TYPE        ; That's all. Return to main code with "flag"
  211.     RET            ; Bytes for filenames appropriately set.
  212. ;
  213. ;...............................
  214. ;
  215. PCHRS:    LD    A,(HL)        ; Aux routine to type "B" chars from (HL)
  216.     AND    7FH
  217.     INC    HL
  218.     CALL    TYPE
  219.     DJNZ    PCHRS
  220.     RET
  221. ;
  222. ;...............................
  223. ;
  224. ;-----------------------------------------------------------------------
  225. ;
  226. ; Get a user response using direct BIOS to avoid echoing the character.
  227. ; Check for and process a ^C if one is detected.
  228. ;
  229. RESPT:    CALL    DIRCIO        ; Direct console i/o via bios, no echo
  230.     AND    7FH        ; Just in case
  231.     CP    CTRLC        ; ^C ?
  232.     JR    NZ,NCTC        ; Br if not
  233.     LD    DE,ABORT    ; If so, det up "aborted" message
  234.     JP    FATAL        ; And abort
  235.  
  236. NCTC:    AND    0DFH        ; Else perform a cheap and dirty upcase
  237.     RET            ; On his response and return it in A.
  238.  
  239. ;-----------------------------------------------------------------------
  240. ;
  241. ;...............................
  242. ;
  243. DIRCIO:    PUSH    BC        ; Routine does a direct BIOS console input
  244.     PUSH    DE        ; Call, and returns w/ registers intact.
  245.     PUSH    HL
  246.     LD    HL,(0001)    ; Get addr of bios jump table (+3)
  247.     LD    DE,6        ; Additional offset to function 3, conin
  248.     ADD    HL,DE
  249.     CALL    JPHL
  250.     POP    HL
  251.     POP    DE
  252.     POP    BC
  253.     RET
  254.  
  255. JPHL:    JP    (HL)        ; Jump to it, return direct from there to
  256.                 ; The POP HL instruction above.
  257. ;...............................
  258. ;
  259. ;-----------------------------------------------------------------------
  260. ;    Command tail parsing, Wildcard expansion, other startup stuff
  261. ;-----------------------------------------------------------------------
  262. ;
  263. STRTUP:    LD    A,(BDOS+2)    ; Size up the tpa
  264.     SUB    ENDHI+11    ; (includes 2k+ for the ccp)
  265.     JR    C,INSUFF    ; Not enough memory at all
  266.     CP    4        ; Chk if reasonable additional amt for out bfr
  267.     JR    NC,ENOUGH    ; Ok, go compute an output buffer size
  268. INSUFF:    LD    DE,LAKMEM    ; "not enough memory..."
  269.     JP    FATAL        ; (fatal error)
  270. ;
  271. ;.......................................................................
  272. ;
  273. ENOUGH:    CP    64        ; Clamp output bfr size to 64 page (16k) max
  274.     JR    C,NOCLMP
  275.     LD    A,64        ;
  276. NOCLMP:    LD    (OBSZ),A    ; Output buffer size, in pages
  277.     ADD    A,OBUFHI    ; Add ofset to beg of output bfr, hi
  278.     LD    (EOBHI),A    ; And save that here
  279. ;
  280. ;.......................................................................
  281. ;
  282.     LD    A,(QUIFL)    ; Move patches to data area for flag use
  283.     LD    (QUIFM),A    ; (allows the program to be re-executable
  284.     LD    A,(NPROFL)    ; - even if the patch corresponds to a
  285.     LD    (NPROFM),A    ; - command line option)
  286.     LD    A,(TRBOFL)
  287.     LD    (NOMSFM),A
  288.     LD    A,(CNFRFL)
  289.     LD    (CNFRFM),A
  290.  
  291.      IF    CRUNCH        ; (this patch / flag only applicable to CRUNCH)
  292.     LD    A,(ARCHIV)
  293.     LD    (ARCHVM),A
  294.      ENDIF
  295.  
  296.     XOR    A        ; Make sure the "stamp" defaults to a leading 0
  297.     LD    (STAMP+0),A
  298.     LD    (NFP),A        ; Init #of files processed to zero
  299. ;
  300. ;.......................................................................
  301. ;
  302. ; Four user# variables are used:  USERNO is the original, saved for re-
  303. ; storation before exit.  CURUSR is the currently "logged" user, INUSR
  304. ; contains the input file's user code; OUTUSR is the output's.    Both are
  305. ; defaulted to USERNO.    Routines LOGIN and LOGOUTlog to appropriate user
  306. ; areas when called.  Unnecessary BDOS 'set user area' calls are inhibi-
  307. ; ted at all times, for what it's worth.
  308. ;
  309.     CALL    GETUSR        ; Get user# guy started with
  310.     LD    A,(USERNO)    ; (above routine put the number here)
  311.     LD    (CURUSR),A    ; Define this as the "current" user#
  312.     LD    (INUSR),A    ; And the default user for both input & output
  313.     LD    (OUTUSR),A
  314. ;
  315. ; If the ZCPR "environment descriptor" is non-zero OR if Z3FLG is non-
  316. ; zero, go use ZCPR-specific command tail processing, else use regular
  317. ; CP/M.
  318. ;
  319.     LD    HL,(Z3ED)    ; Get the environment descriptor
  320.     LD    A,H
  321.     OR    L        ; If 0000, program was not installed by z3ins
  322.     JR    NZ,ZCPR        ; Non-zero; program is z3
  323.  
  324.     LD    A,(Z3FLG)    ; Else see if Z3 patch byte has been set
  325.     OR    A
  326.     JR    NZ,ZCPR        ; If so, go use z3 code also
  327. ;
  328. ;.......................................................................
  329. ;
  330. ; Non-ZCPR command tail processing.
  331. ;
  332.     CALL    GTOPTS        ; Get & process any "slash" options
  333.  
  334.     LD    HL,2000H    ; Init outfcb to default drive & 1 blank char
  335.     LD    (OUTFCB+0),HL
  336.  
  337.     LD    DE,DDMA+1    ; Beg of string to be parsed
  338.     LD    HL,INFCB    ; 37 byte fcb, where fcb-1 will have user#
  339.     CALL    PARSEU        ; Parse. (note- 'fcb'-1 is 'inusr')
  340.  
  341.     PUSH    HL        ; Save command line pointer
  342.     LD    IX,INFCB    ; Spec fcb for "CHKVLD" call below.
  343.     CALL    CHKVLD        ; Check validity of drive / user (saves HL)
  344.     LD    A,(INFCB+1)    ; Make sure we have a non-blank filename
  345.     CP    ' '
  346.     JP    Z,GIVUSG    ; Give usage & exit
  347.     CALL    AUX1        ; Aux processing handles special delimiters
  348.     POP    DE        ; Get back command line pointer, pushed as HL
  349.     JR    C,DONE1        ; Aux1 rtns w/ carry set if cmnd tail is dun
  350.  
  351.     LD    HL,OUTFCB    ; New fcb to be filled
  352.     CALL    PARSEU        ; Do it.
  353.     LD    IX,OUTFCB    ; Spec for "chkvld"
  354.     CALL    CHKVLD        ; Check validity of "OUTFCB"
  355.     CALL    AUX1        ; As above
  356.  
  357.     LD    A,(OUTFCB+1)    ; Additional check- 2nd filename should be blnk
  358.     CP    ' '
  359.     JR    Z,DONE1
  360.  
  361.     LD    DE,PRSER5    ; Error if not
  362.     JP    FATALU
  363. ;
  364. ;.......................................................................
  365. ;
  366. ; ZCPR3 command tail processing.
  367. ;
  368. ZCPR:    LD    HL,DFCB+1    ; Input file spec will come from default fcb1
  369.     LD    A,(HL)        ; But first check for zcpr help invocation
  370.     CP    '/'
  371.     JP    Z,GIVUSG    ; If so, give usage and exit
  372.     CP    ' '        ; No filename spec'd req's help also
  373.     JP    Z,GIVUSG
  374.  
  375.     DEC    HL        ; Else set to beg of dfcb1
  376.     LD    DE,INFCB    ; The input fcb
  377.     CALL    CLRFCB        ; Init it to blanks and zeroes
  378.     LD    BC,16        ; Copy drive, filename, user, et al
  379.     LDIR            ; Now the input fcb is set up, but...
  380.  
  381.     LD    A,(DFCB+13)    ; Get the system supplied user# into the
  382.     LD    (INUSR),A    ; - byte where the program expects it
  383.  
  384.     LD    A,(DFCB2+13)    ; Similarly for the output file
  385.     LD    (OUTUSR),A    ; Goes there
  386.  
  387.     LD    A,(DFCB2+0)    ; Output drive spec stays here.
  388.     LD    (OUTFCB+0),A    ; Rest of fcb filled in later, for each file.
  389.  
  390.     LD    HL,DDMA        ; Look for "[...]" stamp
  391.     LD    C,(HL)
  392.     LD    B,0        ; #of chars to search
  393.     LD    A,'['        ; Char to search for
  394.     CPIR
  395.     DEC    HL        ; Move back to match point, if any
  396.     LD    A,B        ; Was there a match?
  397.     OR    C
  398.     CALL    NZ,PRCSTM    ; (misses if "[" was last char, but that's ok)
  399.  
  400.     CALL    GTOPTS        ; Get and process any "slash options"
  401.  
  402. ; Continue w/ "DONE1" below...
  403. ;
  404. ;.......................................................................
  405. ;
  406. ; More preliminaries. Set the "difdu" flag (clear IFF input drive AND
  407. ; user are identical, else set).  Determine if multi-sector I/O is in-
  408. ; dicated; type program intro to console; expand ambiguous wildcard
  409. ; filespecs.
  410. ;
  411. DONE1:    LD    A,(INFCB+0)    ; Input drive
  412.     OR    A
  413.     JR    NZ,NTDEF1    ; Br if not default
  414.     LD    A,(DEFDRV)    ; If default, use the default drive spec
  415. NTDEF1:    LD    (IDSPEC),A    ; Actual input drive spec, for later ref
  416.     LD    B,A        ; Put that there
  417.     LD    A,(OUTFCB+0)    ; As above for output drive
  418.     OR    A
  419.     JR    NZ,NTDEF2
  420.     LD    A,(DEFDRV)
  421. NTDEF2:    LD    (ODSPEC),A
  422.     CALL    CNVEC        ; (cnv to a vec, in "odrvec"  for later use)
  423.     XOR    B        ; B now non-zero if drives are different
  424.     LD    (DIFD),A    ; Save that flag for possible later use
  425.     LD    B,A        ; Put a copy aside for a sec
  426.     LD    A,(INUSR)    ; Input user#
  427.     LD    C,A
  428.     LD    A,(OUTUSR)    ; Output user#
  429.     XOR    C        ; Non zero if different
  430.     OR    B        ; A now zero iff drives and user#'s identical
  431.     LD    (DIFDU),A    ; Goes there for possible future reference
  432.  
  433.     LD    A,'?'        ; Set wldflg if prgm invoked w/ any wildcards
  434.     LD    HL,INFCB+1
  435.     LD    BC,11
  436.     CPIR
  437.     JR    Z,YESWLD    ; Br if "?" found in any of the filename chars
  438.     XOR    A        ; Else zero A
  439. YESWLD:    LD    (WLDFLG),A    ; Flag now either 0 or '?' (arbitrary non-0 #)
  440.  
  441.     XOR    A        ; Default the multi-sec i/o flag to false
  442.     LD    (CPM3FL),A
  443.  
  444.     LD    A,(NOMSFM)    ; If multi-sec i/o not desired, skip below tst
  445.     OR    A
  446.     JR    NZ,NOSMS
  447.  
  448.     LD    C,GETVER    ; Get CP/M version#
  449.     CALL    BDOS        ; Will return result in l
  450.     LD    A,30H-1
  451.     CP    L        ; 3.0 or greater?
  452.     JR    NC,NOSMS    ; No, don't set flag
  453.     LD    (CPM3FL),A    ; Else set it with this convenient non-o #
  454.  
  455. NOSMS:    LD    DE,INTRO    ; Version#, etc.
  456.     CALL    MESAGE        ; Type that to console
  457.  
  458.     CALL    LOGIN        ; Log to the input files's user area
  459.  
  460.      IF    NOT CRUNCH
  461.     CALL    FIXFCB        ; Uncr may convert ? in middle of ext to "Z"
  462.      ENDIF
  463.  
  464.     LD    DE,INFCB    ; Spec input fcb for below call
  465.     CALL    WILDEX        ; Perform wildcard expansion
  466.     JR    NZ,SOME        ; Br if any matches at all (subr set z flag)
  467.  
  468.     LD    DE,ERR1        ; No matches- "Input file not found"
  469.     JP    FATAL
  470.  
  471. SOME:    CALL    SORT        ; Sort the file list
  472.     LD    A,(CNFRFM)    ; Confirm flag set?
  473.     OR    A
  474.     CALL    NZ,TAG        ; If so, go thru the tagging procedure
  475.     CALL    EXCLUD        ; In any event, "exclude" designated filetypes
  476.  
  477.     LD    HL,FNBUFF    ; Init this pointer to 1st matching filename
  478.     LD    (BUFPTR),HL    ; (advances as we work on each file)
  479.     RET            ; This completes all the common preliminaries
  480. ;
  481. ;-----------------------------------------------------------------------
  482. ;    Support subroutines for above
  483. ;-----------------------------------------------------------------------
  484. ;
  485. ;.......................................................................
  486. ;
  487. ; Get and process one or two options.  The options are the last item in
  488. ; the command tail, and must be preceded by a space and slash i.e., al-
  489. ; low slashes in filenames.  If found, zero out the slash so it becomes
  490. ; the effective end of the command tail before doing the real parsing.
  491. ;
  492. GTOPTS:    LD    A,(DDMA)    ; Get #of chars in command tail
  493.     OR    A        ; None?
  494.     RET    Z        ; Return if so
  495.  
  496.     LD    B,A        ; (will be used as loop limiter below)
  497.     ADD    A,DDMA        ; Add offset to beg of command tail
  498.     LD    L,A        ; Put result in HL
  499.     LD    H,0        ;
  500.     LD    A,' '        ; Now eliminate trailing blanks
  501.  
  502. BLNKLP:    CP    (HL)        ; Blank?
  503.     JR    NZ,LSTCHR    ; Br out at last real char
  504.     DEC    HL        ;
  505.     DJNZ    BLNKLP        ; ("B" still has length of cmnd tail)
  506.     RET            ;
  507.  
  508. LSTCHR:    LD    C,1        ; #of options to process counter (increments)
  509. ;
  510. ;...............................
  511. ;
  512. SLSHLP:    DEC    HL        ; Next to last char (1st loop)
  513.     LD    A,(HL)
  514.     CP    '/'        ; Slash?
  515.     JR    NZ,NSLASH    ; Br if not
  516.  
  517.     DEC    HL
  518.     LD    A,(HL)
  519.     CP    ' '
  520.     INC    HL
  521.     JR    Z,DOWOPS
  522.  
  523. NSLASH:    INC    C        ; Incr #of options counter
  524.     LD    A,C
  525.     CP    4+1        ; Past max #of options supported?
  526.     RET    NC        ; If so, forget it
  527.     DJNZ    SLSHLP        ; Else keep checking, if there's still chars
  528. ;
  529. ;...............................
  530. ;
  531.     RET            ; Return on loop fall thru
  532.  
  533. DOWOPS:    LD    B,C        ; #of options to process
  534.     LD    (HL),0        ; First, zero out the slash
  535.  
  536. WOPLP:    INC    HL        ; Now pointing to first (or only) option
  537.     CALL    PRCOPT        ; Process it
  538.     DJNZ    WOPLP        ; Possibly process more options
  539.     RET
  540. ;
  541. ;.......................................................................
  542. ;
  543. ; Process a single letter option pointed to by HL.  The existance of a
  544. ; switch on the command always toggles the user defined default for that
  545. ; option.  In the distribution version of the program, all default to
  546. ; zero.
  547. ;
  548. PRCOPT:    LD    A,(HL)        ; Get the letter
  549.     EX    DE,HL        ; Save HL in DE
  550.     AND    0DFH        ; Upcase it
  551.     CP    'Q'
  552.     JR    Z,QUIET        ; Flip quiet mode
  553.     CP    'C'
  554.     JR    Z,CNFRM        ; Flip tag mode
  555.     CP    'T'        ; Allow "T" in lieu of "C" for "tag" mode
  556.     JR    Z,CNFRM
  557.     CP    'O'        ; Flip overwrite without prompt mode
  558.     JR    Z,OVRWRT
  559.  
  560.      IF    CRUNCH        ; Archive mode option only supported by CRUNCH
  561.     CP    'A'
  562.     JR    Z,ARCH        ; Flip archive bit mode
  563.      ENDIF
  564.  
  565.     LD    DE,PRSER4    ; Else option is bad, guy needs help
  566.     JP    FATALU
  567.  
  568. QUIET:    LD    HL,QUIFM    ; Point to quiet mode flag
  569.     JR    FLPOPT        ; Go flip option
  570.  
  571. CNFRM:    LD    HL,CNFRFM    ; Likewise, confirm (tag) mode flag
  572.     JR    FLPOPT
  573.  
  574.      IF    CRUNCH
  575. ARCH:    LD    HL,ARCHVM    ; Likewise, confirm (tag) mode flag
  576.     JR    FLPOPT
  577.      ENDIF
  578.  
  579. OVRWRT:    LD    HL,NPROFM    ; Prompt before overwrite flag
  580. ;
  581. ;...............................
  582.                 ; Toggle the option pointed to by HL and rtn
  583. FLPOPT:    XOR    A        ; (does not assume the non-zero vals are FF)
  584.     OR    (HL)        ; Is flag now zero?
  585.     JR    Z,FIS0        ; Br if so
  586.     LD    (HL),0        ; Else zero it now
  587.     EX    DE,HL        ; Restore HL from DE (was saved there on entry)
  588.     RET            ; (HL points to option letter again)
  589.  
  590. FIS0:    LD    (HL),0FFH    ; Put ff in it if it was zero
  591.     EX    DE,HL        ; Restore HL from DE (points to option letter)
  592.     RET
  593. ;
  594. ;.......................................................................
  595. ;
  596. ; Check the validity of the drive and user specified.  This routine also
  597. ; a user code of "FF", returned by "PARSEFCB" when none is specified, to
  598. ; the actual value of the current user area.  Called with IX pointing to
  599. ; the FCB in question.
  600. ;
  601. CHKVLD:    PUSH    HL        ; Don't clobber command line pointer
  602.     LD    A,H        ; First check for HL=ffff, the generic error
  603.     AND    L        ; - return from parsefcb
  604.     INC    A        ;
  605.     JR    Z,RETER1    ; Br if that is the case
  606.  
  607.     LD    A,(IX-1)    ; Else get the user# generated by parsefcb
  608.     CP    0FFH        ; (at fcb-1). "FF" means current user
  609.     JR    NZ,NTDEFU    ; Br if user is not "default"
  610.  
  611.     LD    A,(USERNO)    ; Else convert "FF" to actual current user#
  612.     LD    (IX-1),A    ; And stick it
  613.  
  614. NTDEFU:    LD    HL,MAXUSR    ; Compare user code against "max user +1"
  615.     CP    (HL)
  616.     JR    NC,RETER2    ; Br if invalid
  617.  
  618.     LD    A,(IX+0)    ; User# ok, now get the drive spec
  619.     LD    HL,MAXDRV
  620.     CP    (HL)        ; Compare against max drive+1
  621.  
  622.     POP    HL        ; Restore command line pointer & rtn if drv ok
  623.     RET    C
  624.  
  625.     LD    DE,PRSER3    ; "invalid drive" (fatal error)
  626.     JP    FATALU
  627.  
  628. RETER2:    LD    DE,PRSER2    ; "invalid user" (nothing personal..)
  629.     JP    FATALU
  630.  
  631. RETER1:    LD    DE,PRSER1    ; "invalid argument" (illogical...)
  632.     JP    FATALU
  633. ;
  634. ;.......................................................................
  635. ;
  636. ; Thisroutine analyzes what "PARSEFCB" stopped at.  If its the end of
  637. ; the command tail, indicate that and return.  If its a "[...]" stamp,
  638. ; process that and return.  If its just the end of the (first) filename,
  639. ; indicate that.
  640. ;
  641. AUX1:    LD    A,H        ; See if "parseu" says tail is done
  642.     OR    L        ; (it does that by returning zero)
  643.     JR    Z,RTNDUN    ; Rtn w/ carry set if that is the case.
  644.  
  645.     LD    A,(HL)        ; Delim; else beg of blanks foll last filename
  646.     CP    '['        ; "stamp"?
  647.     JR    NZ,NTSTMP    ; Br if not
  648.     CALL    PRCSTM        ; If so, process stamp & rtn. we are done.
  649.  
  650. RTNDUN:    SCF            ; Flag that we are done
  651.     RET
  652.  
  653. NTSTMP:    INC    HL        ; Skip past delimiter or 1 blank & rtn
  654.     AND    A        ; (indicates 'might not be done')
  655.     RET
  656. ;
  657. ;.......................................................................
  658. ;
  659. ; Convert the drive specified in "A" to a "drive vector" in ODRVEC.  The
  660. ; vector may be used should a disk reset become necessary.
  661. ;
  662. CNVEC:    PUSH    AF        ; Save everything
  663.     PUSH    BC
  664.     PUSH    DE
  665.     LD    DE,0000H    ; Init to all zeroes
  666.     DEC    A        ; Normalize to a=0, b=1, etc
  667.     LD    B,16        ; Loop counter
  668.  
  669. VECLP:    SUB    1        ; Decr
  670.     RR    D
  671.     RR    E        ; Shift in the result of any carry
  672.     DJNZ    VECLP
  673.  
  674.     LD    (ODRVEC),DE
  675.     POP    DE        ; Restore all regs and rtn
  676.     POP    BC
  677.     POP    AF
  678.     RET
  679. ;
  680. ;-----------------------------------------------------------------------
  681. ;    File I/O subroutines:  Input
  682. ;-----------------------------------------------------------------------
  683. ;
  684. ;.......................................................................
  685. ;
  686. ; Open the input file whose fcb is "INFCB"
  687. ;
  688. OPNIN:    CALL    LOGIN        ; Log to the input file's user area
  689.     LD    DE,INFCB    ; Open an input file
  690.     LD    C,OPEN
  691.     CALL    BDOSAV
  692.     INC    A
  693.     AND    A        ; (clr carry for successful return)
  694.     RET    NZ        ; Return if successful
  695.  
  696.     SCF            ; Return, indicating failure
  697.     RET
  698. ;
  699. ;.......................................................................
  700. ;
  701. ; Close the input file whose fcb is "INFCB".
  702. ;
  703. CLSIN:    CALL    LOGIN        ; Log to the input file's user area
  704.     LD    DE,INFCB
  705.     LD    C,CLOSE
  706.     CALL    BDOSAV        ; And close it
  707.     RET
  708. ;
  709. ;.......................................................................
  710. ;
  711. ; Set the input file ("INFCB") to "archived", if in the option was selected
  712. ;
  713.      IF    CRUNCH        ; (this routine used by CRUNCH only)
  714. ARCIT:    LD    A,(ARCHVM)    ; Check if the option was selected
  715.     OR    A
  716.     RET    Z        ; If not, just return
  717.  
  718.     LD    DE,INFCB    ; Set for bdos call
  719.     LD    HL,INFCB+11    ; Byte containing archive status
  720.     SET    7,(HL)        ; Set it
  721.     LD    C,SETATR    ; Bdos "set attribute" function
  722.     CALL    BDOSAV
  723.     RET
  724.      ENDIF
  725. ;
  726. ;.......................................................................
  727. ;
  728. ; "A" <-- Next byte from ("physical") input stream.
  729. ;      Returns with carry set on EOF.
  730. ;
  731. GETCHR:
  732. GETBYT:    EXX            ; Switch to i/o regs
  733.     LD    A,L        ; Pointer to next avail char
  734.     SLA    A        ; See if 00h or 80h
  735.     OR    A        ; (init carry flag [rtn stat] to clear)
  736.     CALL    Z,POSRLD    ; "possibly reload" the buffer if 00 or 80H
  737.     LD    A,(HL)        ; Get byte to return (garbage if eof)
  738.     INC    HL        ; Advance input pointer
  739.     EXX            ; Back to normal regs & rtn
  740.     RET
  741. ;
  742. ;...............................
  743. ;
  744. ;................................
  745. ;
  746. POSRLD:                ; "possibly reload" the input buffer
  747.                 ; I/o regs are active
  748.     LD    A,(SECNT)    ; Decr sector count (for this buffer)
  749.     DEC    A
  750.     LD    (SECNT),A
  751.     AND    A        ; (clr carry)
  752.     CALL    Z,RELOAD    ; Reload buffer if empty (resets HL)
  753.     RET    C        ; (also sets carry if eof is encountered)
  754.     CALL    PROGI        ; Incr #of recs read
  755.     AND    A        ; Guarantee clr carry if not eof yet
  756.     RET
  757. ;
  758. ;...............................
  759. ;
  760. ;.......................................................................
  761. ;
  762. ; Reload  the input buffer, & reset HL' to point to the beginning of
  763. ; it.  Assumes input BFR starts page boundary and is of page multiple
  764. ; length.  The I/O registers are active.
  765. ;
  766. RELOAD:    PUSH    BC
  767.     PUSH    DE
  768.  
  769.     CALL    LOGIN        ; Log to the input file user area
  770.  
  771.     LD    B,IBUFSZ    ; Loop counter, buffer length in pages
  772.     LD    DE,IBUF        ; Beg of buffer
  773.     LD    L,0        ; Will count sectors actually read
  774.  
  775.     LD    A,(CPM3FL)    ; See if multi-sector i/o is desired
  776.     OR    A
  777.     JP    NZ,MSECI    ; Br if so, else continue w/ conventional
  778.  
  779. RLDLP:    LD    E,0        ; Lo byte of current dma
  780.     CALL    RDSEC        ; Read in 128 bytes (1/2 page)
  781.     JR    NZ,RLDRTN    ; (return if eof enecountered)
  782.     INC    L        ; Incr "sectors read" count
  783.     LD    E,80H        ; To read in the next half page
  784.     CALL    RDSEC        ; Do that
  785.     JR    NZ,RLDRTN    ; As above
  786.     INC    L
  787.     INC    D        ; Next page
  788.     DJNZ    RLDLP        ; Loop till done
  789.  
  790. RLDRTN:    LD    A,L        ; Put count of sectors read into "secnt"
  791.  
  792. RLDRT2:    LD    (SECNT),A
  793.     POP    DE        ; Restore regs
  794.     POP    BC        ;
  795.     AND    A        ; Return w/ clr carry
  796.     JR    Z,ZEREAD    ; Br if #of sectors read was zero
  797.  
  798.     LD    HL,IBUF        ; Reset input pointer to beg of input buffer
  799.     RET            ; Rtn with carry clr (from "and" instr)
  800.  
  801. ZEREAD:    SCF            ; Set flg indicating no sectors were read (eof)
  802.     RET
  803. ;
  804. ;.......................................................................
  805. ;
  806. ; Multi sector i/o refill buffer routine. Fills whole buffer at once.
  807. ;
  808. MSECI:    LD    C,SETDMA    ; De already contains pntr to beg of input bfr
  809.     CALL    BDOSAV        ;
  810.  
  811.     LD    E,IBUFSZ*2    ; Spec multi sector count (secs = 2 x pages)
  812.     LD    C,SETMS        ; Bdos func#
  813.     CALL    BDOSAV        ;
  814.  
  815.     LD    DE,INFCB    ; Input file fcb
  816.     LD    C,READ        ;
  817.     CALL    BDOSAV        ; Fill it up!
  818.     OR    A        ; Did it fill all the way up?
  819.     JR    NZ,DIDNOT    ; Br if it didn't
  820.  
  821.     LD    A,IBUFSZ*2    ; If it did, then put the full # here & cont.
  822.     JR    RLDRT2        ; (rest is same as above)
  823.  
  824. DIDNOT:    LD    A,(BDOSHL+1)    ; Get the value bdos returned in h (# read)
  825.     JR    RLDRT2        ; (rest is same as above)
  826. ;
  827. ;.......................................................................
  828. ;
  829. ; Subr for [ non multi-] reload, reads 128 bytes to memory starting at DE
  830. ;
  831. RDSEC:    PUSH    DE        ; Save DE before clobbering it with fcb
  832.     LD    C,SETDMA    ; Set dma to val in DE
  833.     CALL    BDOSAV
  834.     LD    DE,INFCB    ; Input fcb
  835.     LD    C,READ
  836.     CALL    BDOSAV        ; Read a record
  837.     POP    DE        ; Restore DE to value on entry
  838.     OR    A        ; Set zero flag based on error val rtn'd in "a"
  839.     RET            ; & rtn
  840. ;
  841. ;-----------------------------------------------------------------------
  842. ;    File I/O subroutines:  Output
  843. ;-----------------------------------------------------------------------
  844. ;
  845. ;.......................................................................
  846. ;
  847. ; Open the output file.  Also type an arrow, followed by it's name.
  848. ;
  849. OPNOUT:    CALL    LOGOUT        ; Log to the output user #
  850.     LD    DE,ARROW    ; Print " ---> "
  851.     LD    A,(CPM3FL)    ; But use a different arrow for ms i/o
  852.     OR    A
  853.     JR    Z,REGARW
  854.     LD    DE,ARROW3
  855.  
  856. REGARW:    CALL    MESAG2        ; (Prints without a leading cr/lf)
  857.     LD    HL,OUTFCB
  858.     CALL    PRNFIL        ; Print output filename
  859.     LD    A,(NPROFM)    ; See if "no prompt" flag set
  860.     OR    A
  861.     JR    NZ,ERASIT    ; If so, go perf a "blind erase"
  862.  
  863. CHK4IT:    LD    C,SETDMA    ; (re-direct the crap from the below call)
  864.     LD    DE,DDMA        ; Def dma is a good unused area
  865.     CALL    BDOSAV        ;
  866.     LD    C,SFIRST    ; Else see if output filename exists
  867.     LD    DE,OUTFCB
  868.     CALL    BDOSAV
  869.     INC    A        ; Now zero if file does not already exist
  870.     JR    Z,MAKFIL    ; If that is the case, just go make the file
  871.  
  872.     LD    DE,PROMPT    ; File exist, prompt the user
  873.     CALL    MESAG2
  874.     CALL    RSPNSE        ; Get response
  875.     JR    Z,ERASIT    ; Erase it if response is positive
  876.  
  877. NOPE:    CALL    CRLF        ; Extra cr/lf for file skip
  878.     SCF            ; Set flag: "mission not accomplished"
  879.     RET            ;
  880.  
  881. ERASIT:    LD    A,(QUIFM)    ; For aesthetics, must do an extra crlf if
  882.     OR    A        ; - in quiet mode & a prompt was asked
  883.     JR    Z,NOAEST    ; (br if not in quiet mode)
  884.     LD    A,(NPROFM)
  885.     OR    A
  886.     JR    NZ,NOAEST    ; Br if no prompt was asked
  887.  
  888.     CALL    CRLF        ; Else do it
  889.  
  890. NOAEST:    LD    DE,OUTFCB    ; Erase existing file w/ same name
  891.     LD    C,ERASE        ; (if erase fails, "make" below will, too)
  892.     CALL    BDOSAV
  893.  
  894. MAKFIL:    LD    C,MAKE        ; Make the new file
  895.     CALL    BDOSAV
  896.     INC    A
  897.     JR    NZ,OUTOK    ; Err cond check
  898.  
  899.     LD    DE,ERR2A    ; "file creation error"
  900.     JP    FATAL        ; (this is fatal)
  901.  
  902. OUTOK:    AND    A        ; Guarantee clr carry
  903.     RET
  904. ;
  905. ;.......................................................................
  906. ;
  907. ; Close the output file whose fcb is "OUTFCB".
  908. ;
  909. CLSOUT:    CALL    LOGOUT        ; Log to the output file's user area
  910.     LD    DE,OUTFCB
  911.     LD    C,CLOSE
  912.     CALL    BDOSAV        ; And close it
  913.     RET
  914. ;
  915. ;.......................................................................
  916. ;
  917. ; Output char in 'A' to the output buffer.
  918. ;
  919. OUTB:    EXX            ; Switch to i/o regs
  920.     PUSH    AF        ; Save caller's char
  921.     LD    (DE),A        ; Put byte into the next avail position
  922.     INC    E        ; Increment pointer
  923.     LD    A,E        ; See if on a 128 byte boundary
  924.     SLA    A
  925.     JR    NZ,RETOUT    ; Return if not
  926.     CALL    PROGO        ; If so, update output record count
  927.     JR    C,RETOUT    ; Return if it wasn't a full page boundary
  928.     INC    D        ; Incr pointer high byte
  929.     LD    A,(EOBHI)    ; Limit
  930.     CP    D        ; Check
  931.     JR    NZ,RETOUT    ; Ret if limit not reached
  932.     PUSH    BC        ; If so, write the output buffer to disk
  933.     LD    A,(OBSZ)    ; Get output buffer size
  934.     SLA    A        ; Double pages for #of 128 byte records
  935.     LD    B,A        ; Number of records to write goes into b
  936.     CALL    WRTOUT        ; Writes out 'b' 128 byte records
  937.     POP    BC
  938.     LD    DE,OBUF        ; Reset pointer to beginning of bfr & rtn.
  939.  
  940. RETOUT:    POP    AF        ; Restore caller's char, flip regs & rtn
  941.     EXX
  942.     RET
  943. ;
  944. ;.......................................................................
  945. ;
  946. ; Write partial or full output buffer to disk.    The #of records to be
  947. ; written is specified in "B".
  948. ;
  949. WRTOUT:    CALL    LOGOUT        ; Log to the output file user area
  950.     LD    A,B        ; See if zero sectors spec'd
  951.     OR    A
  952.     RET    Z        ; Simply return if so
  953.  
  954.     LD    DE,OBUF        ; Init dma addr to beg of output bfr
  955.     LD    A,(CPM3FL)
  956.     OR    A
  957.     JP    NZ,MSECO    ; Br for multi-sector output
  958.  
  959. WRTLP:    CALL    WRSEC        ; Write 128 bytes
  960.     DEC    B
  961.     RET    Z        ; Return if done
  962.     LD    E,80H        ; Else incr by 1/2 page
  963.     CALL    WRSEC
  964.     INC    D        ; Inc hi-byte, 0 the lo to effect
  965.     LD    E,0        ; Another 80h incr
  966.     DJNZ    WRTLP        ; Loop till done
  967.     RET
  968. ;
  969. ;.......................................................................
  970. ;
  971. MSECO:    LD    C,SETDMA    ; De already points to the output buffer
  972.     CALL    BDOSAV
  973.     LD    E,B        ; Put #of secs to write here, still in b
  974.     LD    C,SETMS        ; Bdos func#
  975.     CALL    BDOSAV
  976.     LD    DE,OUTFCB    ; Output file fcb
  977.     LD    C,WRITE        ; Bdos func#
  978.     CALL    BDOSAV        ; Write out the whole buffer
  979.     OR    A
  980.     RET    Z        ; Ret if no error, else fall thru to
  981.                 ; "wrterr" below & then thru to "fatal"
  982. ;
  983. ;.......................................................................
  984. ;
  985. WRTERR:    CP    2        ; Disk full?
  986.     JR    NZ,NOTFUL
  987.     LD    DE,ERR2B    ; "+++ Disk Full +++"
  988.     CALL    MESAGE
  989.     CALL    ERACE        ; Close / erase output file w/message.
  990.                 ; (also closes input file)
  991.     LD    A,(DIFD)
  992.     OR    A
  993.     JR    NZ,TRYCHG    ; The foll is only possible for 2 diff drvs
  994.     CALL    CRLF
  995.     JP    RETCCP        ; Forget it, the guy's out of luck
  996.  
  997. TRYCHG:    LD    DE,MSGCH    ; Does he want to change diskettes?
  998.     CALL    MESAGE
  999.     CALL    RSPNSE        ; Get any key press. ^C will cancel.
  1000. ;
  1001. ;.......................................................................
  1002. ;
  1003. ; Now prepare to do a disk reset.  First perform a "select disk" func-
  1004. ; tion on the drive which is NOT being changed, namely the input drive.
  1005. ; Then perform a "reset drive" on the output drive (the user has already
  1006. ; changed diskettes).  Then set the default drive back the way it was.
  1007. ;
  1008.     LD    A,(IDSPEC)    ; Input drive spec, a=1, etc.
  1009.     DEC    A        ; Convert to "A=0" format
  1010.     LD    E,A        ; Where bdos wants it
  1011.     LD    C,SELDSK    ; Bdos select disk function
  1012.     CALL    BDOSAV
  1013.     LD    C,RSTDRV    ; Perform a disk reset
  1014.     LD    DE,(ODRVEC)
  1015.     CALL    BDOSAV
  1016.     LD    A,(DEFDRV)    ; Now restore the default drive
  1017.     DEC    A
  1018.     LD    E,A
  1019.     LD    C,SELDSK
  1020.     CALL    BDOSAV
  1021.     LD    HL,(BUFPTR)    ; Set things up so last file gets re-processed
  1022.     LD    DE,-12
  1023.     ADD    HL,DE
  1024.     LD    (BUFPTR),HL
  1025.     JP    NXTFIL        ; Start all over (resets stack there)
  1026.  
  1027. NOTFUL:    LD    DE,ERR2C    ; "output error." (other than disk full)
  1028.     JP    FATAL        ; (this is fatal)
  1029. ;
  1030. ;.......................................................................
  1031. ;
  1032. ; Auxiliary subr for above.  Writes 128 bytes from current val of DE.
  1033. ;
  1034. WRSEC:    LD    C,SETDMA    ; Set dma as spec'd
  1035.     CALL    BDOSAV
  1036.     PUSH    DE        ; Save that val
  1037.     LD    DE,OUTFCB    ; Spec the output file
  1038.     LD    C,WRITE
  1039.     CALL    BDOSAV        ; Do it
  1040.     OR    A
  1041.     POP    DE        ; Restore to same value as before
  1042.     RET    Z        ; Rtn, assuming no error
  1043.     JR    WRTERR
  1044. ;
  1045. ;.......................................................................
  1046. ;
  1047. ; Output the partial output buffer through the current pointer (DE'). If
  1048. ; not on a sector boundary, fill the remainder with "1A"'s.  Close files
  1049. ; and see if there are any more of them.
  1050. ;
  1051. DONE:    EXX            ; Determine where nearest record boundary is
  1052.     LD    A,E        ; Get low byte of output pointer
  1053.     EXX
  1054.     CPL            ; Compute how far to next page boundary
  1055.     INC    A
  1056.     AND    7FH        ; Convert to distance to next half-page bndry
  1057.     JR    Z,ONBNDY    ; If there already (should be the case on uncr)
  1058.  
  1059.     LD    B,A        ; Else set up to fill rest of sector w/ eof's
  1060.     LD    A,1AH
  1061.  
  1062. FILLP:    CALL    OUTB        ; Do that
  1063.     DJNZ    FILLP
  1064.  
  1065. ONBNDY:    EXX            ; Compute #of sectors to write to disk
  1066.  
  1067.     EX    DE,HL        ; Put output pointer in HL
  1068.     LD    BC,OBUF        ; (ok to clobber BC' now, uncr is done w/ it)
  1069.     AND    A        ; (clr carry)
  1070.     SBC    HL,BC        ; How far into the buffer we are
  1071.     SLA    L        ; Effectively divide difference by 128
  1072.     RL    H
  1073.     LD    B,H        ; "b" now has #of recs to be written
  1074.  
  1075.     CALL    WRTOUT        ; Do that
  1076.     CALL    PROGI2        ; Output the final count
  1077.     CALL    PROGF        ; Last pass: print values in "k" also
  1078.  
  1079.     EXX
  1080.     RET
  1081. ;
  1082. ;-----------------------------------------------------------------------
  1083. ;    File I/O subroutines:  Input and/or Output
  1084. ;-----------------------------------------------------------------------
  1085. ;
  1086. ;.......................................................................
  1087. ;
  1088. ; "Log" to the input, output, or the default user area.
  1089. ;
  1090. LOGDEF:    PUSH    BC
  1091.     PUSH    DE
  1092.     LD    A,(USERNO)    ; Log to the original user area, if necessary
  1093.     JR    LOGX
  1094.  
  1095. LOGOUT:    PUSH    BC
  1096.     PUSH    DE
  1097.     LD    A,(OUTUSR)    ; Log to the output user area, if necessary
  1098.     JR    LOGX
  1099.  
  1100. LOGIN:    PUSH    BC
  1101.     PUSH    DE
  1102.     LD    A,(INUSR)    ; Log to the input user area, if necessary
  1103.  
  1104. LOGX:    LD    E,A        ; Common code for either of above
  1105.     LD    A,(CURUSR)
  1106.     CP    E
  1107.     JR    Z,SKIPU        ; Filter out unnecessary user# changes
  1108.  
  1109.     LD    A,E        ; Back to "A" for updating "curusr"
  1110.     LD    (CURUSR),A    ; Do that
  1111.     LD    C,GSUSER    ; Now actually change user #'s
  1112.     CALL    BDOSAV
  1113.  
  1114. SKIPU:    POP    DE
  1115.     POP    BC
  1116.     RET
  1117. ;
  1118. ;.......................................................................
  1119. ;
  1120. ; Get the current (called on program entry) user#. Put it in "USERNO".
  1121. ; Get the default drive and put its adjusted value in "DEFDRV"
  1122. ;
  1123. GETUSR:    PUSH    BC
  1124.     PUSH    DE
  1125.     LD    C,GSUSER
  1126.     LD    E,0FFH        ; Spec "get" as opposed to "set"
  1127.     CALL    BDOSAV
  1128.     LD    (USERNO),A    ; Put that there
  1129.     LD    C,GETDSK    ; Get current disk function
  1130.     CALL    BDOSAV
  1131.     INC    A        ; Adjust so it is normal (ie a=1, not zero)
  1132.     LD    (DEFDRV),A    ; Put that there
  1133.     POP    DE
  1134.     POP    BC
  1135.     RET
  1136. ;
  1137. ;.......................................................................
  1138. ;
  1139. ; Add the value in A to the current running checksum.  Regular registers
  1140. ; active.
  1141. ;
  1142. CKSUM:    LD    HL,(CHKSUM)    ; Get current checksum
  1143.     LD    C,A
  1144.     LD    B,0        ; New val in BC
  1145.     ADD    HL,BC        ; Add to running checksum
  1146.     LD    (CHKSUM),HL    ; And save
  1147.     RET            ; Return with 'A'still intact
  1148. ;
  1149. ;.......................................................................
  1150. ;
  1151. ; Initialize the FCB pointed to by DE.    Leave the drive spec alone.
  1152. ;
  1153. CLRFCB:    PUSH    DE        ; Save caller's pointer to fcb
  1154.     INC    DE        ; Skip past drive spec
  1155.     LD    B,11        ; #of blanks for filename area
  1156.     LD    A,' '        ; A blank, obviously
  1157.  
  1158. ZLP1:    LD    (DE),A        ; Put in the blanks
  1159.     INC    DE
  1160.     DJNZ    ZLP1
  1161.  
  1162. CLREST:    LD    B,24        ; #of zeroes for the rest
  1163.     XOR    A        ; A zero, obviously
  1164.  
  1165. ZLP2:    LD    (DE),A        ; Put those in
  1166.     INC    DE
  1167.     DJNZ    ZLP2
  1168.  
  1169.     POP    DE        ; Restore pointer to fcb and rtn
  1170.     RET
  1171. ;
  1172. ;...............................
  1173. ;
  1174. CLRFC2:    PUSH    DE        ; Clear fcb starting after the filename field
  1175.     JR    CLREST        ; (DE supplied pointing to fcb+12)
  1176. ;
  1177. ;...............................
  1178. ;
  1179. ;.......................................................................
  1180. ;
  1181. ; Erase the output file, w/ message.
  1182. ;
  1183. ERACE:    CALL    CLSOUT        ; (entry here if files are still open)
  1184.     CALL    CLSIN
  1185.  
  1186. ERAOUT:    LD    DE,MSGERA    ; "erasing..."
  1187.     CALL    MESAG2
  1188.     LD    HL,OUTFCB
  1189.     CALL    PRNFIL
  1190.     CALL    LOGOUT        ; Log to appropriate user# first !
  1191.     LD    DE,OUTFCB
  1192.     LD    C,ERASE
  1193.     CALL    BDOSAV
  1194.     RET
  1195. ;
  1196. ;-----------------------------------------------------------------------
  1197. ;    Miscellaneous subroutines
  1198. ;-----------------------------------------------------------------------
  1199. ;
  1200. ;.......................................................................
  1201. ;
  1202. ; Get a user Y/N response. Abort on ^C, return zero stat on "yes"
  1203. ;
  1204. RSPNSE:    LD    C,CONIN        ; Console input
  1205.     CALL    BDOSAV        ; Wait for response
  1206.     CP    CTRLC        ; ^c ?
  1207.     JR    NZ,NCTRLC    ; Br if not
  1208.     LD    DE,ABORT    ; Abort w/ appropriate message
  1209.     JP    FATAL
  1210.  
  1211. NCTRLC:    CP    'Y'
  1212.     RET    Z
  1213.     CP    'y'
  1214.     RET            ; Rtns zero response if guy answered "Yes"
  1215. ;
  1216. ;.......................................................................
  1217. ;
  1218. ; 4 x 2 divide- hlde / BC for result in DE (remainder in HL)
  1219. ;
  1220. DIVIDE:    LD    A,B        ; }
  1221.     CPL            ; }
  1222.     LD    B,A        ; }
  1223.     LD    A,C        ; } negate divisor in BC
  1224.     CPL            ; }
  1225.     LD    C,A        ; }
  1226.     INC    BC        ; }
  1227.  
  1228. DV10:    LD    A,11H        ; Iterations, 17 req. to get all the DE bits
  1229.     JR    UM1
  1230. UM0:    ADC    HL,HL
  1231.  
  1232. UM1:    ADD    HL,BC        ; Divide hlde by -BC
  1233.     JR    C,UM2        ; If it fit
  1234.     SBC    HL,BC        ; Else restore it
  1235.     OR    A        ; Make sure carry is 0
  1236.  
  1237. UM2:    RL    E        ; Result bit to DE
  1238.     RL    D
  1239.     DEC    A
  1240.     JR    NZ,UM0        ; Continue
  1241.     RET
  1242. ;
  1243. ;...............................
  1244. ;
  1245. DIV10:    EX    DE,HL        ; Divide 16 bit val in HL by 10
  1246.     LD    HL,0        ; Zero the lo byte
  1247.     LD    BC,-10        ; We can skip the negation code
  1248.     JR    DV10
  1249. ;
  1250. ;.......................................................................
  1251. ;
  1252. ; BDOS call with all registers and alternates saved except "A"
  1253. ;
  1254. BDOSAV:    EX    AF,AF'
  1255.     PUSH    AF
  1256.     EX    AF,AF'
  1257.     PUSH    BC
  1258.     PUSH    DE
  1259.     PUSH    HL
  1260.     EXX
  1261.     PUSH    BC
  1262.     PUSH    DE
  1263.     PUSH    HL
  1264.     PUSH    IX
  1265.     PUSH    IY
  1266.     EXX
  1267.     CALL    BDOS
  1268.     LD    (BDOSHL),HL    ; Some routines may want to analyze HL
  1269.     EXX
  1270.     POP    IY
  1271.     POP    IX
  1272.     POP    HL
  1273.     POP    DE
  1274.     POP    BC
  1275.     EXX
  1276.     POP    HL
  1277.     POP    DE
  1278.     POP    BC
  1279.     EX    AF,AF'
  1280.     POP    AF
  1281.     EX    AF,AF'
  1282.     RET
  1283. ;
  1284. ;.......................................................................
  1285. ;
  1286. ; Type the string pointed to by DE to the console.
  1287. ;
  1288. MESAGE:    CALL    CRLF        ; Precede all messages with cr, lf
  1289.  
  1290. MESAG2:    PUSH    BC        ; (entry here for no cr/lf)
  1291.     LD    C,PRTSTR    ; Print string
  1292.     CALL    BDOSAV
  1293.     POP    BC
  1294.     RET
  1295. ;
  1296. ;.......................................................................
  1297. ;
  1298. ; Non-Z80 fatal error special "emergency exit".  This routine to be
  1299. ; JUMPED to.
  1300. ;
  1301. MESS80:    LD    C,PRTSTR    ; Can't use "MESAGE" beause can't use "BDOSAV"
  1302.     CALL    BDOS
  1303.     RET            ; Rtn to ccp. (os's stack still intact)
  1304. ;
  1305. ;.......................................................................
  1306. ;
  1307. ; Print a carriage return / linefeed sequence.
  1308. ;
  1309. CRLF:    LD    A,CR
  1310.     CALL    TYPE
  1311.     LD    A,LF
  1312.     CALL    TYPE
  1313.     RET
  1314. ;
  1315. ;.......................................................................
  1316. ;
  1317. ; Type the character in A to the console device.  Saves all registers.
  1318. ;
  1319. TYPE:    PUSH    AF
  1320.     PUSH    BC
  1321.     PUSH    DE
  1322.     LD    E,A        ; Where bdos wants it
  1323.     LD    C,CONOUT    ; Bdos "console output" function
  1324.     CALL    BDOSAV        ; Do it
  1325.     POP    DE
  1326.     POP    BC
  1327.     POP    AF
  1328.     RET
  1329. ;
  1330. ;.......................................................................
  1331. ;
  1332. ; Print fatal error messages.  Jump to this routine- not a call!
  1333. ;
  1334. FATALU:    CALL    MESAGE        ; Entry here if usage instructions desired.
  1335. GIVUSG:    LD    DE,CPYRT
  1336.     CALL    MESAGE
  1337.     LD    DE,USAGE
  1338.     CALL    MESAGE
  1339.     JR    LOGOFF        ; Skip the "0 files processed" business
  1340.  
  1341. FATAL:    CALL    MESAGE        ; Print any final message.
  1342.  
  1343. RETCCP:    LD    A,(NFP)        ; Get #of files processed
  1344.     LD    L,A        ; (must be <256)
  1345.     LD    H,0        ;
  1346.     CALL    DECOUT        ; Output that number
  1347.     LD    DE,FINMSG    ; "file(s) processed"
  1348.     CALL    MESAG2
  1349.  
  1350. LOGOFF:    CALL    LOGDEF        ; Restore user number from original prog entry
  1351.  
  1352.     LD    SP,(OLDSTK)    ; Restore to system stack
  1353.     LD    A,(WRMFLG)    ; Warm boot flag set?
  1354.     OR    A
  1355.     JP    NZ,0000        ; If so, perf a warm boot
  1356.     RET            ; Else return to system ccp
  1357. ;
  1358. ;.......................................................................
  1359. ;
  1360. ; Print the filename whose FCB is pointed to by HL.
  1361. ;
  1362. PRNFIL:    DEC    HL        ; Slide back to user# at fcb-1
  1363.     LD    B,(HL)        ; Put that here for now
  1364.     INC    HL        ; Back to drive spec
  1365.     LD    A,(HL)        ; Get drive spec
  1366.     INC    HL        ; Move to 1st char of filename
  1367.     OR    A        ; Drive = default?
  1368.     JR    NZ,NOTDEF    ; Br if not
  1369.     LD    A,(DEFDRV)    ; If so, get the default drive
  1370.  
  1371. NOTDEF:    ADD    A,'A'-1        ; Convert to a letter
  1372.     CALL    TYPE
  1373.     LD    C,11+2        ; Total spaces to fill for fn and ft + 1
  1374.                 ; (will be used later)
  1375.     LD    A,B        ; Get user# we picked up above
  1376.     CP    10        ; 2 digits?
  1377.     JR    C,ONEDIG    ; Br if not
  1378.     PUSH    AF
  1379.     LD    A,'1'        ; Type the '1'
  1380.     CALL    TYPE
  1381.     POP    AF
  1382.     DEC    C        ; Adjust #of spaces typed by one
  1383.     SUB    10
  1384.  
  1385. ONEDIG:    ADD    A,'0'        ; Ascii conversion
  1386.     CALL    TYPE        ; Type the other (or only) digit
  1387.     LD    A,':'        ; Follow drive spec with a ":"
  1388.     CALL    TYPE
  1389.     LD    B,8+1        ; Max chars in file name plus 1
  1390.     CALL    PRNFNT        ; Print file name
  1391.     LD    A,'.'        ; Print dot
  1392.     CALL    TYPE
  1393.     LD    B,3+1        ; Max chars in file type plus 1
  1394.     CALL    PRNFNT        ; Print file type
  1395.  
  1396. PRNSP:    LD    A,' '        ; Fill out with spaces
  1397.     DEC    C
  1398.     RET    Z
  1399.     CALL    TYPE
  1400.     JR    PRNSP
  1401. ;
  1402. ;...............................
  1403. ;
  1404. PRNFNT:    DEC    B        ; Aux routine for abv; print file name or type
  1405.     RET    Z        ; Reyurn if no more
  1406.     LD    A,(HL)        ; Else get character
  1407.     INC    HL        ; Point to next character
  1408.     CP    ' '        ; Is it a space?
  1409.     JR    Z,PRNFNT    ; If so, loop back for more
  1410.     DEC    C        ; Else, decrement count of printed chars
  1411.     CALL    TYPE        ; Print the character
  1412.     JR    PRNFNT        ; Back for more
  1413. ;
  1414. ;...............................
  1415. ;
  1416. ;.......................................................................
  1417. ;
  1418. ; Wildcard expansion.  All filenames matching INFCB will be packed into
  1419. ; FNBUFF, twelve bytes per filename.  The first byte is used as a
  1420. ; "tag/flag", the following eleven bytes in each entry contain the file-
  1421. ; name.  The tag/flag is set to 00 if the file is NOT to be processed,
  1422. ; 01 indicates file IS to be processed.  The initial state of this byte
  1423. ; is defined here, but may be manually modified if "confirm mode" is
  1424. ; selected. The initial value is determined as follows:
  1425. ;
  1426. ; 1. If confirm and archive modes are OFF, files are flagged for proces-
  1427. ;    sing (01).
  1428. ;
  1429. ; 2. If "archive bit" mode is on, all "un-archived" files are tagged to
  1430. ;    processed (01), others are not (00). This can be overidden either
  1431. ;    way later "confirm" mode was selected as well.
  1432. ;
  1433. ; 3. If confirm mode only was selected, files are flagged as NOT to be
  1434. ;    processed (00).  They can be manually tagged by the user later.
  1435. ;
  1436. ;    (Note that certain circumstances may cause the files to be flagged
  1437. ;    later as (02) "perform a direct copy", but this is not our concern
  1438. ;    now.  Also note that a flag byte of "FF" means "no more files in
  1439. ;     list".)
  1440. ;
  1441. WILDEX:    XOR    A        ; Init "#of files" to zero
  1442.     LD    (NFILES),A
  1443.     LD    DE,DDMA        ; Explicitly set the dma to 80h
  1444.     LD    C,SETDMA
  1445.     CALL    BDOSAV
  1446.     LD    DE,INFCB    ; Fcb to be expanded
  1447.     LD    C,SFIRST    ; Look for 1st match
  1448.     CALL    BDOSAV        ; Bdos "Search for first" call
  1449.     CP    0FFH        ; Any match?
  1450.     RET    Z        ; Error- no matches- rtn w/ zero stat
  1451.     LD    DE,FNBUFF    ; From now on, DE is buffer dest pointer
  1452.     CALL    MOVNAM        ; Move first filename into buffer
  1453.  
  1454. EXPLP:    PUSH    DE        ; } (save bfr dest pntr)
  1455.     LD    DE,INFCB    ; }
  1456.     LD    C,SNEXT        ; }
  1457.     CALL    BDOSAV        ; }
  1458.     POP    DE        ; } process all additional matches
  1459.     CP    0FFH        ; }
  1460.     JR    Z,DONEX        ; }
  1461.     CALL    MOVNAM        ; }
  1462.     JR    EXPLP        ; }
  1463.  
  1464. DONEX:    LD    (DE),A        ; Flag the last [non-] entry with ff
  1465.     OR    A        ; Also use the ff to rtn w/ non-zero stat
  1466.     RET
  1467. ;
  1468. ;................................
  1469. ;                ; Move filename to next position in FNBUFF
  1470. MOVNAM:    ADD    A,A        ; (pointed to by DE). Initialize the first
  1471.     ADD    A,A        ;  byte, the tag/flag byte, appropriately
  1472.     ADD    A,A        ;  depending on operating mode)
  1473.     ADD    A,A
  1474.     ADD    A,A        ; Bdos suplies directory entry at dma + 32*a
  1475.     ADD    A,DDMA        ; Namely 80h
  1476.     LD    L,A        ; Set up HL as source pointer
  1477.     LD    H,0        ; Hi-byte of ddma, namely zero
  1478.     LD    A,(CNFRFM)    ; Default each file to "tagged" or "untagged"
  1479.     LD    B,A        ; If /c or /a options, default to untagged
  1480.  
  1481.      IF    CRUNCH
  1482.     LD    A,(ARCHVM)    ; Archive bit mode only exists in CRUNCH
  1483.      ELSE
  1484.     XOR    A        ; (inherently "off")
  1485.      ENDIF
  1486.  
  1487.     OR    B        ; See if either mode is active
  1488.     JR    Z,CF0        ; Br if not
  1489.     LD    A,01H
  1490. CF0:    XOR    01H        ; Now A=00 unless either flag set, else A=01
  1491.     LD    B,12        ; Byte count +1 (11 filename characters)
  1492.  
  1493.     PUSH    DE        ; Save a copy of pntr to status byte
  1494.     JR    MIDLP        ; Transfer the tag/flag byte and 11 characters
  1495. ;
  1496. ;...............................
  1497. ;
  1498. LDIRLP:    LD    A,(HL)        ; Loop like ldir but "ands" w/ 7fh
  1499.     LD    C,A        ; (to grab the val of a on last loop, used blw)
  1500.     AND    7FH        ; Get rid of status bits
  1501.  
  1502. MIDLP:    LD    (DE),A        ; <== entry for first loop
  1503.     INC    HL
  1504.     INC    DE
  1505.     DJNZ    LDIRLP        ; Transfer 12 bytes
  1506. ;
  1507. ;...............................
  1508. ;
  1509.     POP    HL        ; (pushed as DE above)
  1510.  
  1511.      IF    CRUNCH
  1512.     LD    A,(ARCHVM)    ; Archive mode?
  1513.     OR    A
  1514.     JR    Z,SKPSTF    ; Skip this code if not
  1515.  
  1516.     LD    A,C        ; Get the archive bit, from the last char
  1517.     AND    80H        ; Isolate it
  1518.     XOR    80H        ; Flip it
  1519.     RLCA            ; And convert it into a possible 01h
  1520.     OR    (HL)
  1521.     LD    (HL),A        ; "stuff" it into the tag/flag byte.
  1522.      ENDIF
  1523.  
  1524. SKPSTF:    LD    A,(NFILES)    ; Incr #of files counter
  1525.     INC    A
  1526.     LD    (NFILES),A
  1527.     RET    NZ        ; Normal return
  1528. ;
  1529. ;...............................
  1530. ;
  1531.     LD    DE,ERR3        ; Too many files, fatal error
  1532.     JP    FATAL
  1533. ;
  1534. ;-----------------------------------------------------------------------
  1535. ;
  1536. ; Update the running count of #of records output (add one to it).
  1537. ;
  1538. PROGO:    PUSH    AF        ; Save everything
  1539.     PUSH    BC
  1540.     PUSH    HL
  1541.     LD    HL,(OUTCTR)    ; Update binary count
  1542.     INC    HL
  1543.     LD    (OUTCTR),HL
  1544.     LD    HL,PROGBF+11    ; Point to ascii string version of count
  1545.     CALL    BCDINC        ; Incr that, too
  1546.     POP    HL        ; Restore regs & return
  1547.     POP    BC
  1548.     POP    AF
  1549.     RET
  1550. ;
  1551. ;.......................................................................
  1552. ;
  1553. ; Update  #of records read on input.  Every 2 or 4 calls to this rou-
  1554. ; tine, actually update the display.  Monitor the console for ^C.
  1555. ;
  1556. PROGI:    PUSH    AF        ; Save everything
  1557.     PUSH    BC
  1558.     PUSH    HL
  1559.  
  1560.     LD    C,CONST        ; Get console status
  1561.     CALL    BDOSAV
  1562.     OR    A
  1563.     JR    Z,CONTIN    ; Continue if no character
  1564.     LD    C,CONIN
  1565.     CALL    BDOSAV        ; Get the char for analysis
  1566.     CP    CTRLC        ; ^c?
  1567.     JR    NZ,CONTIN    ; Continue if not
  1568.     LD    DE,ABORT    ; Else abort
  1569.     JP    FATAL
  1570.  
  1571. CONTIN:    LD    A,(QUIFM)
  1572.     OR    A
  1573.     JR    NZ,PERFIN    ; Skip the stuff below in quiet mode
  1574.     LD    A,(INCTR+0)    ; Mask ls bits to determine whether this call
  1575.     DEC    A        ; - is an 'active' one (updates the console)
  1576.     LD    B,A
  1577.     LD    A,(DIRFLG)    ; "direct copy flag" - different screen dsply
  1578.     OR    B
  1579.     AND    SCRUPT2        ; Screen update speed control #2
  1580.     JR    Z,FULUPD
  1581.     AND    SCRUPT1        ; Screen update speed control #1
  1582.     CALL    Z,PRTUPD    ; If zero, actually do a typeout
  1583.     JR    PERFIN
  1584.  
  1585. FULUPD:    CALL    PRNFIN        ; Perf "full" update.
  1586.  
  1587. PERFIN    EQU    $
  1588.  
  1589.      IF    CRUNCH
  1590.     LD    A,(FULFLG)    ; If table not full, skip below check
  1591.     OR    A
  1592.     JR    Z,SKIPW4
  1593.  
  1594.     LD    A,(INCTR+0)    ; This controls checking for adaptive reset
  1595.     DEC    A
  1596.     AND    SCRUPT1        ; CHLRST may initiate an adaptive reset by
  1597.     CALL    Z,CHKRST    ; Setting a flag
  1598.  
  1599.      ENDIF
  1600.  
  1601. SKIPW4:    LD    HL,(INCTR)    ; In any event, perform the increments
  1602.     INC    HL        ; First, incrment the binary version
  1603.     LD    (INCTR),HL
  1604.  
  1605.     LD    HL,PROGBF+5    ; Increment ascii string representing same
  1606.     CALL    BCDINC
  1607.     POP    HL        ; Restore regs & rtn
  1608.     POP    BC
  1609.     POP    AF
  1610.     RET
  1611. ;
  1612. ;.......................................................................
  1613. ;
  1614. ;...............................
  1615. ;
  1616. PRTUPD:    PUSH    DE        ; Type a "short-form" update update
  1617.     LD    A,'$'        ; To the screen (ie "records in" only)
  1618.     LD    (PROGBF+6),A    ; Effectively truncate the update text
  1619.     LD    DE,PROGBF
  1620.     CALL    MESAG2        ; Type to screen until the "$" terminator
  1621.     LD    A,' '        ; Restore that byte to it's natural state
  1622.     LD    (PROGBF+6),A
  1623.     POP    DE
  1624.     RET            ; And return
  1625. ;
  1626. ;...............................
  1627. ;
  1628. ;.......................................................................
  1629. ;
  1630. ; Routine  like  "PROGI", but does NOT increment and  WILL  update  the
  1631. ; console on any call. Basically used as a final screen update.
  1632. ;
  1633. PROGI2:    PUSH    AF
  1634.     LD    A,(QUIFM)    ; Still, don't type if in "quiet" mode
  1635.     OR    A
  1636.     JR    NZ,QUIET2
  1637.     PUSH    BC        ; Else print up the final tally
  1638.     PUSH    HL
  1639.     CALL    PRNFIN
  1640.     POP    HL
  1641.     POP    BC
  1642.  
  1643. QUIET2:    POP    AF
  1644.     RET
  1645. ;
  1646. ;.......................................................................
  1647. ;
  1648. ; Perform a full screen update (recs in / out, compression ratio, etc.)
  1649. ;
  1650. PRNFIN:    PUSH    DE
  1651.     PUSH    IX
  1652.     LD    DE,PROGBF    ; This buffer contains most of the stuff,
  1653.     CALL    MESAG2        ; - ready to be typed
  1654.  
  1655.     LD    A,(DIRFLG)
  1656.     OR    A
  1657.     JR    NZ,SKIPW2
  1658.  
  1659.     LD    DE,(OUTCTR)    ; Compression ratio must be computed, however
  1660.     PUSH    DE
  1661.     POP    IX        ; Get #of output recs into ix
  1662.  
  1663.     LD    HL,(INCTR)    ; Spec the divisor for the subroutine call
  1664.     LD    (DIVISR),HL
  1665.     CALL    COMRAT        ; Compute ratio. result, in %, returned in HL
  1666.     LD    A,' '        ; Need an extra space here to make it look good
  1667.     CALL    TYPE
  1668.     CALL    DECOUT        ; Type to screen in decimal
  1669.     LD    DE,PERCNT    ; A "%" char, basicly
  1670.     CALL    MESAG2        ; Type that
  1671.     LD    A,(OLDFLG)    ; Skip rest for old style (v1.x) files
  1672.     OR    A
  1673.     JR    NZ,SKIPW2
  1674.     LD    HL,4096        ; Display this value whenever table is full
  1675.     LD    A,(FULFLG)    ; Is it?
  1676.     OR    A
  1677.     JR    NZ,NOFUD    ; Br if so
  1678.     LD    HL,(ENTRY)    ; Type "Codes Assigned" to the screen
  1679.  
  1680.      IF    CRUNCH
  1681.     DEC    HL        ; Adjust for a 2 count "skew" due to
  1682.     DEC    HL        ; - inherent nature of uncr to be "behind"
  1683.      ENDIF
  1684.  
  1685. NOFUD:    CALL    DECOUT        ; The "ca" count
  1686.     LD    A,' '        ; Some more aesthetics
  1687.     CALL    TYPE
  1688.     CALL    TYPE
  1689.  
  1690.     LD    HL,(TTOTAL)    ; Get "Codes Reassigned"
  1691.     CALL    DECOUT        ; The "cr" count
  1692.  
  1693. SKIPW2:    POP    IX        ; Restore regs and return
  1694.     POP    DE
  1695.     RET
  1696. ;
  1697. ;.......................................................................
  1698. ;
  1699. ; "Incremental compression ratio" computation.    For analysis of the
  1700. ; possibility of setting the adaptive reset flag, compute the compres-
  1701. ; sion ratio since the last reset (not necessarily the beginning of the
  1702. ; file).  This is significantly preferable to analyzing the ratio since
  1703. ; the beginning (the one displayed on the console) because that number
  1704. ; gets very "stable" as one gets further and further into a large file.
  1705. ; Sudden structural variations will not get picked up quickly that way.
  1706. ;
  1707. ; INCTR0 and OUTCT0 contain the #of records at the time of the last re-
  1708. ; set (or zero).  The offset from them (to the current values) are the
  1709. ; numbers divided to compute the ratio.
  1710.  
  1711.      IF    CRUNCH
  1712. CHKRST:    PUSH    DE
  1713.     PUSH    IX
  1714.     LD    HL,(INCTR)    ; As described above
  1715.     LD    DE,(INCTR0)
  1716.     AND    A
  1717.     SBC    HL,DE
  1718.     LD    (DIVISR),HL    ; Adjusted input rec count will be the divisor
  1719.     LD    HL,(OUTCTR)
  1720.     LD    DE,(OUTCT0)
  1721.     AND    A
  1722.     SBC    HL,DE        ; Adjusted output record count is dividend
  1723.     EX    DE,HL
  1724.     PUSH    DE
  1725.     POP    IX        ; Put it in ix for the subr call
  1726.     CALL    COMRAT        ; Returns a compression ration in "HL"
  1727. ;
  1728. ; The criteria for adaptive reset is when the current "incremental"
  1729. ; ratio goes "up".  "Up" is defined as higher the limit, which is equal
  1730. ; to the lowest incremental ratio achieved so far (not necessarily the
  1731. ; last computed ratio).  ["So far" means since the last adaptive reset,
  1732. ; if any.]
  1733. ;
  1734. ; Computationsbelow are single byte precision.    If the "compression"
  1735. ; ratio (during crunching) actually ever got higher than 256%, then this
  1736. ;  analysis is really quite irrelevant.. that would really be a lost
  1737. ; cause...
  1738. ;
  1739.     LD    A,(LOWPER)    ; Get "target" value
  1740.     SUB    L        ; Compare to current
  1741.     JR    C,CHK4RS    ; If current is higher, reset may be indicated
  1742.     LD    A,L        ; If new ratio is lower, it is the new target
  1743.     LD    (LOWPER),A
  1744.     JR    SKIPW3        ; That's all
  1745. ;
  1746. ; If new value is higher, a reset may be indicated.  The exact criteria
  1747. ; is that the value be one full percentage point, besides the +/-1 nor-
  1748. ; mal roundoff wavering, above the target value.
  1749. ;
  1750. CHK4RS:    INC    A        ; Adjust the difference computed by one
  1751.     JP    P,SKIPW3    ; If that is not negative, no reset now
  1752.  
  1753.     LD    A,80H        ; Else set the adaptive reset flag. full
  1754.     LD    (RSTFLG),A    ; - processing occurs back at the main loop
  1755.  
  1756.     PUSH    HL        ; However, take care of updating these now
  1757.     LD    HL,(INCTR)    ; Inctr0 <-- inctr
  1758.     LD    (INCTR0),HL
  1759.     LD    HL,(OUTCTR)    ; Outct0 <-- outctr
  1760.     LD    (OUTCT0),HL
  1761.     POP    HL
  1762.  
  1763. SKIPW3:    POP    IX        ; Restore regs and return
  1764.     POP    DE
  1765.     RET
  1766.      ENDIF            ; CRUNCH
  1767. ;
  1768. ;.......................................................................
  1769. ;
  1770. ; Compute a compression ratio, in percent.  Calculates IX/("divisr").
  1771. ; When called, DE must have a a copy of the dividend as well as IX.
  1772. ;
  1773. COMRAT:    LD    HL,0        ; Prepare for 32 bit multiply by 100
  1774.     LD    B,H        ; [ ratio = (100 * out) / in ]
  1775.     LD    C,L
  1776.     ADD    IX,IX
  1777.     ADC    HL,HL        ; 2x
  1778.     ADD    IX,DE
  1779.     ADC    HL,BC        ; 3x
  1780.     ADD    IX,IX
  1781.     ADC    HL,HL        ; 6x
  1782.     ADD    IX,IX
  1783.     ADC    HL,HL        ; 12x
  1784.     ADD    IX,IX
  1785.     ADC    HL,HL        ; 24x
  1786.     ADD    IX,DE
  1787.     ADC    HL,BC        ; 25x
  1788.     ADD    IX,IX
  1789.     ADC    HL,HL        ; 50x
  1790.     ADD    IX,IX
  1791.     ADC    HL,HL        ; 100x
  1792.     ADD    IX,IX
  1793.     ADC    HL,HL        ; 200x
  1794.     PUSH    IX        ; Get result into HL DE for dividing
  1795.     POP    DE        ;
  1796.     LD    BC,(DIVISR)    ; Get divisor
  1797.     CALL    DIVIDE        ; Divides (HL DE) / BC
  1798.     EX    DE,HL        ; Put result into HL
  1799.     SRL    H        ; Divide it by 2
  1800.     RR    L        ;
  1801.     RET    NC        ; & return if no need to round up
  1802.     INC    HL        ; Else round up
  1803.     RET
  1804. ;
  1805. ;.......................................................................
  1806. ;
  1807. ; Increment a 4 character ASCII unpacked BCD string, pointed to by HL.
  1808. ;
  1809. BCDINC:    LD    B,4        ; Loop counter
  1810.  
  1811. DIGLP:    LD    A,(HL)        ; HL points to string
  1812.     OR    10H        ; Blank to zero conversion (init'd to blank)
  1813.     INC    A        ; Incr
  1814.     LD    (HL),A        ; Re-store
  1815.     CP    '9'+1        ; Carry?
  1816.     RET    NZ        ; Rtn if not
  1817.     LD    (HL),'0'    ; Else zero & loop to next char
  1818.     DEC    HL        ;
  1819.     DJNZ    DIGLP        ; (But not past limit)
  1820.     RET            ; And return
  1821. ;
  1822. ;.......................................................................
  1823. ;
  1824. ; Convert records to "k" and print same.  Called at end of process.
  1825. ;
  1826. PROGF:    PUSH    DE        ; Save regs
  1827.     PUSH    BC
  1828.     LD    DE,SPCPAR    ; Spaces, parenthesis
  1829.     CALL    MESAG2
  1830.     LD    HL,(INCTR)    ; Input recs
  1831.     CALL    AUXSUB        ; Div by 8 and type
  1832.     LD    DE,ARROW2    ; " --->"
  1833.     CALL    MESAG2
  1834.     LD    A,' '
  1835.     CALL    TYPE
  1836.     LD    HL,(OUTCTR)    ; Similarly for output recs
  1837.     CALL    AUXSUB
  1838.     LD    A,')'
  1839.     CALL    TYPE
  1840.     CALL    CRLF
  1841.     POP    BC        ; Restore & rtn
  1842.     POP    DE
  1843.     RET
  1844. ;
  1845. ;...............................
  1846. ;                ; Aux routine for above calculates (HL)/8
  1847. AUXSUB:    LD    DE,7        ; With upward rounding, & types it.
  1848.     ADD    HL,DE        ; [ie compute (#recs+7) / 8 ]
  1849.     SRL    H        ; }
  1850.     RR    L        ; }
  1851.     SRL    H        ; } div by 8
  1852.     RR    L        ; }
  1853.     SRL    H        ; }
  1854.     RR    L        ; }
  1855.     CALL    DECOUT        ; Type HL in decimal
  1856.     LD    A,'k'
  1857.     CALL    TYPE
  1858.     RET
  1859. ;
  1860. ;...............................
  1861. ;
  1862. ;.......................................................................
  1863. ;
  1864. ; Convert a binary number to four chars ASCII & type them, right justified.
  1865. ;
  1866. DECOUT:    CALL    DIV10        ; Divide orig # (in HL), by 10
  1867.     LD    A,L        ; Get remainder from l, (0-9)
  1868.     PUSH    AF        ; Save in reverse order retrieval later
  1869.     EX    DE,HL        ; Old dividend becomes new divisor
  1870.     CALL    DIV10        ; Repeat 3 more times
  1871.     LD    A,L
  1872.     PUSH    AF
  1873.     EX    DE,HL
  1874.     CALL    DIV10
  1875.     LD    A,L
  1876.     PUSH    AF
  1877.     EX    DE,HL
  1878.     CALL    DIV10
  1879.     LD    A,L
  1880.     PUSH    AF
  1881.     EX    DE,HL
  1882.     LD    B,3        ; Becomes loop counter
  1883.     LD    C,0EFH        ; Mask to convert zeroes to blanks
  1884.  
  1885. DECLP:    POP    AF        ; Type the 4 digits, with leading 0 suppression
  1886.     OR    A        ; Is it zero?
  1887.     JR    Z,LVMASK    ; Lv mask set if so
  1888.     LD    C,0FFH        ; Else cancel masking (of zeroes to blanks)
  1889. LVMASK:    ADD    A,'0'        ; Convert to ascii
  1890.     AND    C        ; Possibly blank a zero
  1891.     CALL    TYPE        ; Output the char
  1892.     DJNZ    DECLP        ; Do the first 3 digits
  1893.     POP    AF        ; Last digit is easy. never blank it.
  1894.     ADD    A,'0'        ; Convert to acsii
  1895.     CALL    TYPE        ; Type it & rtn
  1896.     RET
  1897. ;
  1898. ;.......................................................................
  1899. ;
  1900. ; (Re-)initialize all necessary ram locs.  Called once for each file to
  1901. ; be processed.  This routine gets its info from an initialization block
  1902. ; called "SHADOW" which is copied into the working memory.  Routine also
  1903. ; performs alternate register initialization.
  1904. ;
  1905. INTRAM:    LD    HL,SHADOW    ; Contains a copy of all relevant init values
  1906.     LD    DE,RAM        ; Target
  1907.     LD    BC,EOSHAD-SHADOW
  1908.     LDIR            ; Do it
  1909.     EXX            ; Routine performs register initialization too
  1910.     LD    HL,IBUF        ; Reset input buffer pointer
  1911.     LD    DE,OBUF        ; Reset output buffer pointer
  1912.     LD    BC,0        ; Zero this
  1913.     EXX            ; Back to primary registers
  1914.     RET
  1915. ;
  1916. ;.......................................................................
  1917. ;
  1918. ; Exchange the 12 byte entries at (HL) and (DE). [ Used by SORT below ]
  1919. ;
  1920. SWAP:    PUSH    DE
  1921.     PUSH    HL
  1922.     LD    B,12        ; Loop counter
  1923.  
  1924. SWAPLP:    LD    A,(DE)        ; Get a corresponding byte from each
  1925.     LD    C,(HL)
  1926.     EX    DE,HL        ; Exchange the pointers
  1927.     LD    (DE),A        ; And re-store the pair of bytes
  1928.     LD    (HL),C
  1929.     INC    HL
  1930.     INC    DE
  1931.     DJNZ    SWAPLP        ; Loop; (note- another ex DE,HL not needed)
  1932.     POP    HL
  1933.     POP    DE
  1934.     RET
  1935. ;
  1936. ;.......................................................................
  1937. ;
  1938. ; Compare the 11 byte entries at (HL+1) and (DE+1) [ Used by SORT below]
  1939. ;
  1940. COMP:    PUSH    DE
  1941.     PUSH    HL
  1942.     LD    B,11        ; Limit max #of comparisons
  1943.  
  1944. COMPLP:    INC    HL        ; Pre-incr pointers
  1945.     INC    DE
  1946.     LD    A,(DE)
  1947.     CP    (HL)
  1948.     JR    NZ,CMPRTN    ; If not equal, rtn with appropriate carry stat
  1949.     DJNZ    COMPLP        ; Loop up to eleven times
  1950.     SCF            ; Set for equal avoids unecessary equal swaps
  1951.  
  1952. CMPRTN:    POP    HL
  1953.     POP    DE
  1954.     RET
  1955. ;
  1956. ;.......................................................................
  1957. ;
  1958. ; Sort all of the 12 byte filename entries in FNBUFF. Sleazy bubble sort.
  1959. ;
  1960. SORT:    LD    A,(NFILES)    ; #of entries to be sorted
  1961.     LD    C,A        ; Init outer loop counter
  1962.     LD    DE,FNBUFF    ; Init "outer loop" pointer
  1963. ;
  1964. ;...............................
  1965. ;
  1966. OUTRLP:    LD    H,D        ; Reset inner loop pointer and counter
  1967.     LD    L,E        ; HL <-- DE
  1968.     LD    B,C        ; C  <-- B
  1969. ;
  1970. ;...............................
  1971. ;
  1972. INRLP:    PUSH    BC        ; Save loop counters
  1973.     CALL    COMP        ; Compare two entries
  1974.     CALL    NC,SWAP        ; Swap if necessary
  1975.     LD    BC,12        ; Incr inner pointer by 12
  1976.     ADD    HL,BC
  1977.     POP    BC        ; Restore loop counters
  1978.     DJNZ    INRLP
  1979. ;
  1980. ;...............................
  1981. ;
  1982.     LD    A,E        ; Incr DE by 12
  1983.     ADD    A,12
  1984.     LD    E,A
  1985.     LD    A,D
  1986.     ADC    A,0
  1987.     LD    D,A
  1988.     DEC    C
  1989.     JR    NZ,OUTRLP    ; Loop till done
  1990.     RET
  1991. ;
  1992. ;-----------------------------------------------------------------------
  1993. ;    Text, data, etc.
  1994. ;-----------------------------------------------------------------------
  1995. ;
  1996. PRSER5    EQU    $        ; (Destination filename supplied)
  1997. PRSER8    EQU    $        ; (Stamp buffer overflow)
  1998. PRSER1    EQU    $        ; (Error from "parseu")
  1999. PRSER2    EQU    $        ; (Invalid user#)
  2000. PRSER3    EQU    $        ; (Invalid drive)
  2001.  
  2002.     DB    'Invalid argument.$' ; (generic for all of the above)
  2003.  
  2004. PRSER4:    DB    'Invalid option.$' ;
  2005. MSGERA:    DB    ' Erasing: $'
  2006. MSGCPY:    DB    '   Copying...',CR,LF,' $'
  2007. ERR0:    DB    '[ File empty ]$'
  2008. ERR1:    DB    'Input file not found.',CR,LF,'$'
  2009. ERR2A:    DB    'File creation error.$'
  2010. ERR2B:    DB    CR,LF,'+++ Disk Full +++   ',BELL,'$'
  2011. ERR2C:    DB    'Output error.$'
  2012. ERR3:    DB    'Too many files.$'
  2013. LAKMEM:    DB    'Not enough memory.$'
  2014. WRNGUP:    DB    'Prog req''s Z-80.$'
  2015. ARROW:    DB    '  --->  $'
  2016. ARROW2:    DB    ' --->$'
  2017. ARROW3:    DB    '  ===>  $'
  2018. PERCNT:    DB    '%  $'
  2019. SPCPAR:    DB    ' ($'
  2020. DASHES:    DB    '----',CR,LF,'$'
  2021.  
  2022. MSGTAG:    DB    CR,LF
  2023.     DB    'Hit "T" to Tag files for processing,  <CR> to skip.,',CR,LF,LF
  2024.     DB    '    "B" =  Back one    "U" =  Untag    ^C  =  Abort'
  2025.     DB    CR,LF,LF,'$'
  2026. MSGOK:    DB    'Selections OK? <Y/N>:$'
  2027. MSGBEL:    DB    BELL        ; (cont. below)
  2028. MSGCLF:    DB    CR,LF,LF,'$'
  2029.  
  2030. MSGCH:    DB    CR,LF,'Change output diskette & hit <CR> to continue.'
  2031.     DB    CR,LF,'Else hit ^C to abort.',CR,LF,'$'
  2032. ABORT:    DB    CR,LF,'+++ Aborted +++',CR,LF,'$'
  2033. PROMPT:    DB    ' Overwrite existing file? ',BELL,'$'
  2034. HEADNG:    DB    '  in    out   rat   ca    cr',CR,LF ; (cont)
  2035.     DB    ' ====  ====  ====  ====  ====',CR,LF,'$'
  2036.  
  2037. FINMSG:    DB    ' File(s) processed.',CR,LF,'$'
  2038. ;
  2039. ;-----------------------------------------------------------------------
  2040. ;
  2041. SHADOW    EQU    $        ; (for description, see immediately below)
  2042. ;                ;
  2043.     DB    00        ; "fulflg"
  2044.     DW    0000        ; "chksum"
  2045.     DB    01        ; "secnt"
  2046.     DW    0000        ; "inctr"
  2047.     DW    0000        ; "outctr"
  2048.     DW    0000        ; "inctr0"
  2049.     DW    0000        ; "outct0"
  2050.     DW    0000H        ; "entry"
  2051.     DB    09        ; "codlen"
  2052.     DB    02H        ; "trgmsk"
  2053.     DB    09H        ; "codle0"
  2054.     DB    00H        ; "rstflg"
  2055.     DW    0000H        ; "ttotal"
  2056.     DB    0FFH        ; "lowper"
  2057.     DW    NOPRED        ; "lastpr"
  2058.     DB    01H        ; "entflg"
  2059.     DB    00H        ; "oldflg"
  2060.     DB    00H        ; "dirflg"
  2061.     DB    00H        ; "sqzflg"
  2062.     DB    CR,'    0 /   0$' ; "progbf"
  2063. ;
  2064. ;-----    PROGBF + 0  12345678901 ; (offsets into above)
  2065. ;             ^
  2066. EOSHAD    EQU    $
  2067. ;_______________________________________________________________________
  2068. ;
  2069.     DSEG
  2070. ;
  2071. ; The following RAM locations must be re-initialized each time the pro-
  2072. ; gram is executed (for each file when wildcards are used).  The area
  2073. ; called "SHADOW" (above) is used to accomplish this.
  2074.  
  2075. RAM    EQU    $
  2076.  
  2077. FULFLG:    DS    1        ; Becomes "FF" when table is full
  2078. CHKSUM:    DS    2        ; Checksum accumulated here
  2079. SECNT:    DS    1        ; Count of sectors read per "reload" call
  2080. INCTR:    DS    2        ; Count of total sectors read from input
  2081. OUTCTR:    DS    2        ; Likewise for output
  2082. INCTR0:    DS    2        ; Value of "inctr" at last reset
  2083. OUTCT0:    DS    2        ; Value of "outctr" at last reset
  2084. ENTRY:    DS    2        ; Current entry (code) number.
  2085. CODLEN:    DS    1        ; Current code length, in bits.
  2086. TRGMSK:    DS    1        ; Mask contains "1" bit in pos of next code len
  2087. CODLE0:    DS    1        ; "delayed" value of "codlen"
  2088. RSTFLG:    DS    1        ; Will cause an adaptive reset when set
  2089. TTOTAL:    DS    2        ; "codes reassigned" (for display purposes)
  2090. LOWPER:    DS    1        ; Lowest incremental compr. ratio achieved
  2091. LASTPR:    DS    2        ; "last pred"
  2092. ENTFLG:    DS    1        ; Flag prevents duplicating entries
  2093. OLDFLG:    DS    1        ;
  2094. DIRFLG:    DS    1        ; "direct flag", set when doing plain file copy
  2095. SQZFLG:    DS    1        ;
  2096. PROGBF:    DS    20        ; Alphanumeric ASCII to go to console
  2097. ;
  2098. ;.......................................................................
  2099. ;
  2100. INUSR:    DS    1        ; Must immediately precede the input fcb
  2101. INFCB:    DS    36        ; Input file fcb.
  2102.  
  2103. OUTUSR:    DS    1        ; Must immediately precede the output fcb
  2104. OUTFCB:    DS    36        ; Output fcb
  2105. ;
  2106. ;.......................................................................
  2107. ;
  2108. ; The flags below are analogous to some of patches at the beginning of
  2109. ; the program.    Those default values are copied into the data area here
  2110. ; each program execution, since some can be changed if an appropriate
  2111. ; command line option is processed.  This keeps the prgrm re-executable.
  2112. ;
  2113. QUIFM:    DS    1        ; Verbose mode flag
  2114. NPROFM:    DS    1        ; No prompt before overwrite flag
  2115. NOMSFM:    DS    1        ; Defeat multi-sector i/o flag
  2116. CNFRFM:    DS    1        ; Confirm every file flag
  2117. ARCHVM:    DS    1        ; Archive bit mode flag (used by crunch only)
  2118. BUFPTR:    DS    2        ; Used for indexing
  2119. OLDSTK:    DS    2        ; Operating system stack pointer saved here
  2120. DISP:    DS    2        ; A displacement
  2121. DIVISR:    DS    2        ; A divisor
  2122. BDOSHL:    DS    2        ; HL returned by BDOS calls saved here
  2123. CPM3FL:    DS    1        ; CP/M Plus flag
  2124. CURUSR:    DS    1        ; The "current" user area
  2125. USERNO:    DS    1        ; The default user area
  2126. DEFDRV:    DS    1        ; The default drive
  2127. IDSPEC:    DS    1        ; Input drive spec (a=1, b=2,...)
  2128. ODSPEC:    DS    1        ; Output drive spec
  2129. OBSZ:    DS    1        ; Output buffer size, pages
  2130. EOBHI:    DS    1        ; End of output buffer, hi-byte
  2131. NFILES:    DS    1        ; #of files (from wildcard expander)
  2132. FILNUM:    DS    1        ; File counter for tag mode
  2133. DIFDU:    DS    1        ; Set if input du: different than output du:
  2134. DIFD:    DS    1        ; Set if input d: is different than output d:
  2135. WLDFLG:    DS    1        ; Set if program invoked w/ wildcard(s)
  2136. ODRVEC:    DS    2        ; "drive vector" corresponding to output drv
  2137. NFP:    DS    1        ; #of files processed
  2138. ;
  2139. ;           (end of COMMON.LIB include)
  2140. ;=======================================================================
  2141.