home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / mbug / mbug078.arc / COMMON.LZB / COMMON.LIB
Text File  |  1979-12-31  |  43KB  |  1,462 lines
  1. ;------------------------------------------------------------------------------
  2. ;    Command tail parsing, Wildcard expansion, other startup stuff
  3. ;------------------------------------------------------------------------------
  4.  
  5. STRTUP:
  6.     LD    A,(BDOS+2)    ; Size up the tpa
  7.     SUB    ENDHI+11    ; (includes 2k+ for the ccp)
  8.     JR    NC,ENOUGH    ;
  9.     LD    DE,LAKMEM    ; "not enough memory..."
  10.     JP    FATAL        ; (fatal error)
  11. ;..............................................................................
  12. ;
  13. ENOUGH:
  14.     LD    A,(QUIFL)    ; Move patches to data area for flag use
  15.     LD    (QUIFM),A    ; (allows the program to be re-executable
  16.     LD    A,(NPROFL)    ; - even if the patch corresponds to a
  17.     LD    (NPROFM),A    ; - command line option)
  18.     LD    A,(TRBOFL)    ;
  19.     LD    (NOMSFM),A    ;
  20.     LD    A,(CNFRFL)    ;
  21.     LD    (CNFRFM),A    ;
  22.  
  23.     XOR    A        ; Make sure the stamp defaults to a leading 0
  24.     LD    (STAMP+0),A    ;
  25.  
  26. ; Four    user# variables are used: USERNO is the original, saved for  restora-
  27. ; tion before exit. CURUSR is the currently "logged" user, INUSR contains the
  28. ; input  file's  user  code; OUTUSR is the output's. Both  are    defaulted  to
  29. ; USERNO.  Routines  LOGIN  and LOGOUT log to  appropriate  user  areas  when
  30. ; called. Unnecessary BDOS 'set user area' calls are inhibited at all  times,
  31. ; for what it's worth.
  32.  
  33.     CALL    GETUSR        ; Get user# guy started with
  34.     LD    A,(USERNO)    ; (above routine put the number here)
  35.     LD    (CURUSR),A    ; Define this as the "current" user#
  36.     LD    (INUSR),A    ; And the default user for both input & output
  37.     LD    (OUTUSR),A    ;
  38. ;..............................................................................
  39.  
  40.     LD    HL,(Z3ED)    ; Get ZCPR3 "environment descriptor"
  41.     LD    A,H        ;
  42.     OR    L        ; If 0000, program was not installed by Z3INS
  43.     JR    NZ,ZCPR        ; Non-zero; program is Z3
  44.  
  45.     LD    A,(Z3FLG)    ; Else see if installed by patch or CRINSTAL
  46.     OR    A        ;
  47.     JR    NZ,ZCPR        ; If so, go use Z3 code
  48. ;..............................................................................
  49. ;
  50. ; Non-ZCPR command tail processing.
  51. ;
  52.     CALL    GTOPTS        ; Get & process any "slash" options
  53.  
  54.     LD    HL,2000H    ; Init OUTFCB to default drive & 1 blank char
  55.     LD    (OUTFCB+0),HL    ;
  56.  
  57.     LD    DE,DDMA+1    ; Beg of string to be parsed
  58.     LD    HL,INFCB    ; 37 byte fcb, where fcb-1 will have user#
  59.     CALL    PARSEU        ; Parse. (Note- 'fcb'-1 is 'INUSR')
  60.  
  61.     PUSH    HL        ; Save command line pointer
  62.     LD    IX,INFCB    ; Spec fcb for "CHKVLD" call below.
  63.     CALL    CHKVLD        ; Check validity of drive / user (saves hl)
  64.     LD    A,(INFCB+1)    ; Make sure we have a non-blank filename
  65.     CP    ' '        ;
  66.     JP    Z,GIVUSG    ; Give usage & exit
  67.     CALL    AUX1        ; Aux processing handles special delimiters
  68.     POP    DE        ; Get back command line pointer, pushed as hl
  69.     JR    C,DONE1        ; AUX1 rtns w/ carry set if cmnd tail is dun
  70.  
  71.     LD    HL,OUTFCB    ; New fcb to be filled
  72.     CALL    PARSEU        ; Do it.
  73.     LD    IX,OUTFCB    ; Spec for "chkvld"
  74.     CALL    CHKVLD        ; Check validity of "OUTFCB"
  75.     CALL    AUX1        ; As above
  76.  
  77.     LD    A,(OUTFCB+1)    ; Additional check- 2nd filename should be blnk
  78.     CP    ' '        ;
  79.     JR    Z,DONE1        ;
  80.  
  81.     LD    DE,PRSER5    ; Error if not
  82.     JP    FATALU        ;
  83. ;..............................................................................
  84. ;
  85. ; ZCPR3 command tail processing.
  86. ;
  87. ZCPR:    LD    HL,DFCB+1    ; Input file spec will come from default FCB1
  88.     LD    A,(HL)        ; But first check for zcpr help invocation
  89.     CP    '/'        ;
  90.     JP    Z,GIVUSG    ; If so, give usage and exit
  91.     CP    ' '        ; No filename spec'd req's help also
  92.     JP    Z,GIVUSG    ;
  93.  
  94.     DEC    HL        ; Else set to beg of dfcb1
  95.     LD    DE,INFCB    ; The input FCB
  96.     CALL    CLRFCB        ; Init it to blanks and zeroes
  97.     LD    BC,16        ; Copy drive, filename, user, et al
  98.     LDIR            ; Now the input fcb is set up, but...
  99.  
  100.     LD    A,(DFCB+13)    ; Get the system supplied user# into the
  101.     LD    (INUSR),A    ; - byte where the program expects it
  102.  
  103.     LD    A,(DFCB2+13)    ; Similarly for the output file
  104.     LD    (OUTUSR),A    ; Goes there
  105.  
  106.     LD    A,(DFCB2+0)    ; Output drive spec stays here.
  107.     LD    (OUTFCB+0),A    ; Rest of FCB filled in later, for each file.
  108.  
  109.     LD    HL,DDMA        ; Look for "[...]" stamp
  110.     LD    C,(HL)        ;
  111.     LD    B,0        ; #of chars to search
  112.     LD    A,'['        ; Char to search for
  113.     CPIR            ;
  114.     DEC    HL        ; Move back to match point, if any
  115.     LD    A,B        ; Was there a match?
  116.     OR    C        ;
  117.     CALL    NZ,PRCSTM    ; (misses if "[" was last char, but that's ok)
  118.  
  119.     CALL    GTOPTS        ; Get and process any "slash options"
  120.  
  121. ; Continue w/ "DONE1" below...
  122. ;..............................................................................
  123. ;
  124. ; More preliminaries. Determine if multi-sector I/O is indicated; type    prog-
  125. ; ram intro to console; expand ambiguous wildcard filespecs.
  126. ;
  127. DONE1:    XOR    A        ; Default the multi-sec i/o flag to false
  128.     LD    (CPM3FL),A    ;
  129.  
  130.     LD    A,(NOMSFM)    ; If multi-sec i/o not desired, skip below tst
  131.     OR    A        ;
  132.     JR    NZ,NOSMS    ;
  133.  
  134.     LD    C,GETVER    ; Get cp/m version#
  135.     CALL    BDOS        ; Will return result in l
  136.     LD    A,30H-1        ;
  137.     CP    L        ; 3.0 or greater?
  138.     JR    NC,NOSMS    ; No, don't set flag
  139.     LD    (CPM3FL),A    ; Else set it with this convenient non-o #
  140.  
  141.                 ;
  142.                 ;
  143. NOSMS:    LD    DE,INTRO    ; Version#, etc.
  144.     CALL    MESAGE        ; Type that to console
  145.  
  146.     CALL    LOGIN        ; Log to the input files's user area
  147.     CALL    FIXFCB        ; Uncr will convert ? in middle of ext to "Z"
  148.     LD    DE,INFCB    ; Spec input FCB for below call
  149.     CALL    WILDEX        ; Perform wildcard expansion
  150.     LD    (NMBFLS),HL    ; Put number of matching files here
  151.     JR    NZ,SOME        ; Br if any matches at all (subr set z flag)
  152.  
  153.                 ;
  154.                 ;
  155.     LD    DE,ERR1        ; No matches- "Input file not found"
  156.     JP    FATAL        ;
  157.                 ;
  158. PERR3:    LD    DE,ERR3        ; "too many matching files" (unlikely)
  159.     JP    FATAL        ;
  160.  
  161.  
  162. SOME:    LD    DE,-MAXFLS    ; Maximum #of matching files supported
  163.     ADD    HL,DE        ;
  164.     JP    C,PERR3        ;
  165.  
  166.     LD    HL,FNBUFF    ; Init this pointer to 1st matching filename
  167.     LD    (BUFPTR),HL    ; (advances as we work on each file)
  168.     RET            ; This completes all the common preliminaries
  169. ;______________________________________________________________________________
  170. ;
  171. ; Support subroutines for above
  172. ;..............................................................................
  173. ;
  174. ; Get  and process one or two options. The options are the last item  in  the
  175. ; command tail, and must be preceded by a space & slash (ie allow slashes  in
  176. ; filenames). If found, zero out the slash so it becomes the effective end of
  177. ; the command tail before doing the real parsing.
  178. ;
  179. GTOPTS:    LD    A,(DDMA)    ; Get #of chars in command tail
  180.     OR    A        ; None?
  181.     RET    Z        ; Return if so
  182.  
  183.     LD    B,A        ; (will be used as loop limiter below)
  184.     ADD    A,DDMA        ; Add offset to beg of command tail
  185.     LD    L,A        ; Put result in hl, for transfer to ix
  186.     LD    H,0        ;
  187.     PUSH    HL        ;
  188.     POP    IX        ;
  189.     LD    A,' '        ; Now eliminate trailing blanks
  190.  
  191. BLNKLP:    CP    (IX)        ;
  192.     JR    NZ,LSTCHR    ; Br out at last real char
  193.     DEC    IX        ;
  194.     DJNZ    BLNKLP        ; ("B" still has length of cmnd tail)
  195.     RET            ;
  196.  
  197. LSTCHR:    LD    A,'/'        ; This is what we're looking for
  198.     CP    (IX-1)        ; Is next to last char a slash?
  199.     JR    NZ,CHEK2    ; If not, see if char before that is
  200.  
  201. MINISB:    LD    A,' '        ; (alt entry here from below)
  202.     SUB    (IX-2)        ; Is char before that blank?
  203.     RET    NZ        ; Forget it
  204.     LD    (IX-1),A    ; If so, zero the slash & process option at IX
  205.     CALL    PRCOPT        ;
  206.     SUB    A        ; Set zero flag
  207.     RET            ;
  208.  
  209. CHEK2:    DEC    IX        ; We will allow any two options
  210.     CP    (IX-1)        ; Is char before one before last a slash?
  211.     RET    NZ        ; Forget it
  212.  
  213.     CALL    MINISB        ; > use the same block of code abv as a subr
  214.     RET    NZ        ; Return if that did nothing
  215.     INC    IX        ;
  216.     CALL    PRCOPT        ; Else process the 2nd option as well
  217.     RET            ;
  218. ;..............................................................................
  219. ;
  220. ; Check the validity of the drive & user specified. This routine also a  user
  221. ; code of "FF", returned by "PARSEFCB" when none is specified, to the  actual
  222. ; value of the current user area. Called with IX pointing to th FCB in    ques-
  223. ; tion.
  224. ;
  225. CHKVLD:    PUSH    HL        ; Don't clobber command line pointer
  226.     LD    A,H        ; First check for hl=ffff, the generic error
  227.     AND    L        ; - return from PARSEFCB
  228.     INC    A        ;
  229.     JR    Z,RETER1    ; Br if that is the case
  230.  
  231.     LD    A,(IX-1)    ; Else get the user# generated by parsefcb
  232.     CP    0FFH        ; (at FCB-1). "FF" means current user
  233.     JR    NZ,NTDEFU    ; Br if user is not "default"
  234.  
  235.     LD    A,(USERNO)    ; Else convert "FF" to actual current user#
  236.     LD    (IX-1),A    ; And stick it
  237.  
  238. NTDEFU:    LD    HL,MAXUSR    ; Compare user code against "max user +1"
  239.     CP    (HL)        ;
  240.     JR    NC,RETER2    ; Br if invalid
  241.  
  242.     LD    A,(IX+0)    ; User# ok, now get the drive spec
  243.     LD    HL,MAXDRV    ;
  244.     CP    (HL)        ; Compare against max drive+1
  245.  
  246.     POP    HL        ; Restore command line pointer & rtn if drv ok
  247.     RET    C
  248.                 ;
  249.                 ;
  250.     LD    DE,PRSER3    ; "Invalid Drive" (fatal error)
  251.     JP    FATALU        ;
  252.                 ;
  253. RETER2:    LD    DE,PRSER2    ; "Invalid User" (nothing personal..)
  254.     JP    FATALU        ;
  255.                 ;
  256. RETER1:    LD    DE,PRSER1    ; "Invalid Argument" (illogical...)
  257.     JP    FATALU        ;
  258.  
  259. ;..............................................................................
  260. ;
  261. ; This    routine  analyzes what "PARSEFCB" stopped at. If its the end  of  the
  262. ; command tail, indicate that & rtn. If its a "[...]" stamp, process that and
  263. ; return. If its just the end of the (first) filename, indicate that.
  264. ;
  265. AUX1:    LD    A,H        ; See if "parseu" says tail is done
  266.     OR    L        ; (it does that by returning zero)
  267.     JR    Z,RTNDUN    ; Rtn w/ carry set if that is the case.
  268.  
  269.     LD    A,(HL)        ; Delim; else beg of blanks foll last filename
  270.     CP    '['        ; "stamp"?
  271.     JR    NZ,NTSTMP    ; Br if not
  272.     CALL    PRCSTM        ; If so, process stamp & rtn. We are done.
  273.  
  274. RTNDUN:    SCF            ; Flag that we are done
  275.     RET            ;
  276.  
  277. NTSTMP:    INC    HL        ; Skip past delimiter or 1 blank & rtn
  278.     AND    A        ; (indicates 'might not be done')
  279.     RET            ;
  280. ;..............................................................................
  281. ;
  282. ; Process a single letter option pointed to by IX.
  283. ;
  284. PRCOPT:    LD    A,(IX)        ; Get the letter
  285.     AND    0DFH        ; Upcase it
  286.     CP    'Q'        ;
  287.     JR    Z,QUIET        ; Force quiet mode
  288.     CP    'V'        ;
  289.     JR    Z,NOISY        ; Force verbose mode
  290.     CP    'C'        ;
  291.     JR    Z,CONFRM    ; Confirm mode
  292.  
  293.     LD    DE,PRSER4    ; Else option is bad, guy needs help
  294.     JP    FATALU        ;
  295.  
  296. QUIET:    LD    (QUIFM),A    ; Stick the 'q' (any non-zero #) in the flag
  297.     RET            ;
  298.  
  299. NOISY:    XOR    A        ; /V forces the quiet flag to the zero state
  300.     LD    (QUIFM),A    ;
  301.     RET            ;
  302.  
  303. CONFRM:    LD    (CNFRFM),A    ; /C sets the confirm flag to a non-0 value
  304.     RET            ;
  305. ;______________________________________________________________________________
  306. ;
  307. PRSER5    EQU    $        ; (destination filename supplied)
  308. PRSER8    EQU    $        ; (stamp buffer overflow)
  309. PRSER1    EQU    $        ; (error from "parseu")
  310.  
  311.     DB    'Invalid argument.$'
  312.  
  313. PRSER2:    DB    'Invalid user number.$'    ;
  314. PRSER3:    DB    'Invalid drive.$' ;
  315. PRSER4:    DB    'Invalid option.$' ;
  316.  
  317. ;------------------------------------------------------------------------------
  318. ;    File I/O subroutines:  Input
  319. ;------------------------------------------------------------------------------
  320.  
  321. ; Open the input file whose fcb is "INFCB"
  322. ;
  323. OPNIN:    CALL    LOGIN        ; Log to the input file's user area
  324.     LD    DE,INFCB    ; Open an input file
  325.     LD    C,OPEN        ;
  326.     CALL    BDOSAV        ;
  327.     INC    A        ;
  328.     AND    A        ; (clr carry for successful return)
  329.     RET    NZ        ; Return if successful
  330.  
  331.     SCF            ; Return, indicating failure
  332.     RET            ;
  333. ;..............................................................................
  334. ;
  335. ; Open the input file whose fcb is "INFCB"
  336. ;
  337. CLSIN:    CALL    LOGIN        ; Log to the input file's user area
  338.     LD    DE,INFCB    ;
  339.     LD    C,CLOSE        ;
  340.     CALL    BDOSAV        ; And close it
  341.     RET            ;
  342. ;______________________________________________________________________________
  343. ;
  344. ; "A" <-- Next byte from ("physical") input stream.
  345. ;      Returns with carry set on EOF.
  346.  
  347. GETCHR    EQU    $
  348. GETBYT    EQU    $
  349.  
  350.     EXX            ; Switch to i/o regs
  351.     LD    A,L        ; Pointer to next avail char
  352.     SLA    A        ; See if 00h or 80h
  353.     OR    A        ; (init carry flag [rtn stat] to clear)
  354.     CALL    Z,POSRLD    ; "possibly reload" the buffer if 00 or 80H
  355.     LD    A,(HL)        ; Get byte to return (garbage if eof)
  356.     INC    HL        ; Advance input pointer
  357.     EXX            ; Back to normal regs & rtn
  358.     RET            ;
  359. ;................................
  360. ;
  361. POSRLD:                ; "possibly reload" the input buffer
  362.                 ; I/o regs are active
  363.     LD    A,(SECNT)    ; Decr sector count (for this buffer)
  364.     DEC    A        ;
  365.     LD    (SECNT),A    ;
  366.     AND    A        ; (clr carry)
  367.     CALL    Z,RELOAD    ; Reload buffer if empty (resets hl)
  368.     RET    C        ; (also sets carry if eof is encountered)
  369.     CALL    PROGI        ; Incr #of recs read
  370.     AND    A        ; Guarantee clr carry if not eof yet
  371.     RET            ;
  372. ;..............................................................................
  373. ;
  374. ; Reload  the input buffer, & reset HL' to point to the beginning of it.  As-
  375. ; sumes  input bfr starts page boundary and is of page multiple  length.  The
  376. ; I/O registers are active.
  377. ;
  378. RELOAD:    PUSH    BC        ;
  379.     PUSH    DE        ;
  380.  
  381.     CALL    LOGIN        ; Log to the input file user area
  382.  
  383.     LD    B,IBUFSZ    ; Loop counter, buffer length in pages
  384.     LD    DE,IBUF        ; Beg of buffer
  385.     LD    L,0        ; Will count sectors actually read
  386.  
  387.     LD    A,(CPM3FL)    ; See if multi-sector i/o is desired
  388.     OR    A        ;
  389.     JP    NZ,MSECI    ; Br if so, else continue w/ conventional
  390.  
  391. RLDLP:    LD    E,0        ; Lo byte of current dma
  392.     CALL    RDSEC        ; Read in 128 bytes (1/2 page)
  393.     JR    NZ,RLDRTN    ; (return if eof enecountered)
  394.     INC    L        ; Incr "sectors read" count
  395.     LD    E,80H        ; To read in the next half page
  396.     CALL    RDSEC        ; Do that
  397.     JR    NZ,RLDRTN    ; As above
  398.     INC    L        ;
  399.     INC    D        ; Next page
  400.     DJNZ    RLDLP        ; Loop till done
  401.  
  402. RLDRTN:    LD    A,L        ; Put count of sectors read into "secnt"
  403.  
  404. RLDRT2:    LD    (SECNT),A    ;
  405.     POP    DE        ; Restore regs
  406.     POP    BC        ;
  407.     AND    A        ; Return w/ clr carry
  408.     JR    Z,ZEREAD    ; Br if #of sectors read was zero
  409.  
  410.     LD    HL,IBUF        ; Reset input pointer to beg of input buffer
  411.     RET            ; Rtn with carry clr (from "and" instr)
  412.  
  413. ZEREAD:    SCF            ; Set flg indicating no sectors were read (eof)
  414.     RET            ;
  415. ;..............................................................................
  416. ;
  417. ; Multi sector i/o refill buffer routine. Fills whole buffer at once.
  418. ;
  419. MSECI:    LD    C,SETDMA    ; De already contains pntr to beg of input bfr
  420.     CALL    BDOSAV        ;
  421.  
  422.     LD    E,IBUFSZ*2    ; Spec multi sector count (secs = 2 x pages)
  423.     LD    C,SETMS        ; Bdos func#
  424.     CALL    BDOSAV        ;
  425.  
  426.     LD    DE,INFCB    ; Input file fcb
  427.     LD    C,READ        ;
  428.     CALL    BDOSAV        ; Fill it up!
  429.     OR    A        ; Did it fill all the way up?
  430.     JR    NZ,DIDNOT    ; Br if it didn't
  431.  
  432.     LD    A,IBUFSZ*2    ; If it did, then put the full # here & cont.
  433.     JR    RLDRT2        ; (rest is same as above)
  434.  
  435. DIDNOT:    LD    A,(BDOSHL+1)    ; Get the value bdos returned in h (# read)
  436.     JR    RLDRT2        ; (rest is same as above)
  437. ;..............................................................................
  438. ;
  439. ; Subr for [ non multi-] reload, reads 128 bytes to memory starting at DE
  440. ;
  441. RDSEC:    PUSH    DE        ; Save de before clobbering it with fcb
  442.     LD    C,SETDMA    ; Set dma to val in de
  443.     CALL    BDOSAV        ;
  444.     LD    DE,INFCB    ; Input fcb
  445.     LD    C,READ        ;
  446.     CALL    BDOSAV        ; Read a record
  447.     POP    DE        ; Restore de to value on entry
  448.     OR    A        ; Set zero flag based on error val rtn'd in "a"
  449.     RET            ; & rtn
  450.  
  451. ;------------------------------------------------------------------------------
  452. ;    File I/O subroutines:  Output
  453. ;------------------------------------------------------------------------------
  454.  
  455. ; Open the output file.  Also type an arrow, followed by it's name.
  456. ;
  457. OPNOUT:    CALL    LOGOUT        ; Log to the output user #
  458.  
  459.     LD    DE,ARROW    ; Print " ---> "
  460.     LD    A,(CPM3FL)    ; But use a different arrow for ms i/o
  461.     OR    A        ;
  462.     JR    Z,REGARW    ;
  463.     LD    DE,ARROW3    ;
  464.  
  465. REGARW:    CALL    MESAG2        ; (prints w/o a leading cr/lf)
  466.     LD    HL,OUTFCB    ;
  467.     CALL    PRNFIL        ; Print output filename
  468.  
  469.     LD    A,(CNFRFM)    ; Confirm flag?
  470.     OR    A        ;
  471.     JR    Z,NCN        ; Br if not
  472.     LD    DE,CNMSG    ; Else ask confirmation message
  473.     CALL    MESAG2        ;
  474.     CALL    RSPNSE        ; Get answer
  475.     JR    Z,CHK4IT    ; If yes, continue
  476.     JR    NOPE        ;
  477.  
  478. NCN:    LD    A,(NPROFM)    ; "no prompt" flag set
  479.     OR    A        ;
  480.     JR    NZ,ERASIT    ; If so, go perf a "blind erase"
  481.  
  482. CHK4IT:    LD    C,SETDMA    ; (re-direct the crap from the below call)
  483.     LD    DE,DDMA        ; Def dma is a good unused area
  484.     CALL    BDOSAV        ;
  485.  
  486.     LD    C,SFIRST    ; Else see if output filename exists
  487.     LD    DE,OUTFCB    ;
  488.     CALL    BDOSAV        ;
  489.     INC    A        ; Now zero if file does not already exist
  490.     JR    Z,MAKFIL    ; If that is the case, just go make the file
  491.  
  492.     LD    DE,PROMPT    ; File exist, prompt the user
  493.     CALL    MESAG2        ;
  494.     CALL    RSPNSE        ; Get response
  495.     JR    Z,ERASIT    ; Erase it if response is positive
  496.  
  497. NOPE:    CALL    CRLF        ; Extra cr/lf for file skip
  498.     SCF            ; Set flag: "mission not accomplished"
  499.     RET            ;
  500.  
  501. ERASIT:    LD    A,(QUIFM)    ; For aesthetics, must do an extra CRLF if
  502.     OR    A        ; - in quiet mode & a prompt was asked
  503.     JR    Z,NOAEST    ; (br if not in quiet mode)
  504.     LD    A,(NPROFM)    ;
  505.     OR    A        ;
  506.     JR    NZ,NOAEST    ; Br if no prompt was asked
  507.  
  508.     CALL    CRLF        ; Else do it
  509.  
  510. NOAEST:    LD    DE,OUTFCB    ; Erase existing file w/ same name
  511.     LD    C,ERASE        ;
  512.     CALL    BDOSAV        ;
  513.  
  514. MAKFIL:    LD    C,MAKE        ; Make the new file
  515.     CALL    BDOSAV        ;
  516.     INC    A        ;
  517.     JR    NZ,OUTOK    ; Err cond check
  518.  
  519.     LD    DE,ERR2A    ; "file open error"
  520.     JP    FATAL        ; (this is fatal)
  521.  
  522. OUTOK:    AND    A        ; Guarantee clr carry
  523.     RET            ;
  524. ;..............................................................................
  525. ;
  526. ; Close the output file whose fcb is "OUTFCB".
  527. ;
  528. CLSOUT:    CALL    LOGOUT        ; Log to the output file's user area
  529.     LD    DE,OUTFCB    ;
  530.     LD    C,CLOSE        ;
  531.     CALL    BDOSAV        ; And close it
  532.     RET            ;
  533. ;______________________________________________________________________________
  534. ;
  535. ; Output char in 'A' to the output buffer.
  536. ;
  537. OUTB:    EXX            ; Switch to i/o regs
  538.     PUSH    AF        ; Save caller's char
  539.     LD    (DE),A        ; Put byte into the next avail position
  540.     INC    E        ; Increment pointer
  541.     LD    A,E        ; See if on a 128 byte boundary
  542.     SLA    A        ;
  543.     JR    NZ,RETOUT    ; Return if not
  544.  
  545.     CALL    PROGO        ; If so, update output record count
  546.     JR    C,RETOUT    ; Return if it wasn't a full page boundary
  547.  
  548.     INC    D        ; Incr pointer high byte
  549.     LD    A,EOBFHI    ; Limit
  550.     CP    D        ; Check
  551.     JR    NZ,RETOUT    ; Ret if limit not reached
  552.  
  553.     PUSH    BC        ; If so, write the output buffer to disk
  554.     LD    B,OBUFSZ*2    ; Number of 128 byte records to write
  555.     CALL    WRTOUT        ; Writes out 'b' 128 byte records
  556.     POP    BC        ;
  557.     LD    DE,OBUF        ; Reset pointer to beginning of bfr & rtn.
  558.  
  559. RETOUT:    POP    AF        ; Restore caller's char, flip regs & rtn
  560.     EXX            ;
  561.     RET            ;
  562. ;______________________________________________________________________________
  563. ;
  564. ; Write partial or full output buffer to disk.
  565. ; The #of records to be written is specified in "B".
  566. ;
  567. WRTOUT:    CALL    LOGOUT        ; Log to the output file user area
  568.  
  569.     LD    A,B        ; See if zero sectors spec'd
  570.     OR    A        ;
  571.     RET    Z        ; Simply return if so
  572.  
  573.     LD    DE,OBUF        ; Init dma addr to beg of output bfr
  574.  
  575.     LD    A,(CPM3FL)    ;
  576.     OR    A        ;
  577.     JP    NZ,MSECO    ; Br for multi-sector output
  578.  
  579. WRTLP:    CALL    WRSEC        ; Write 128 bytes
  580.     DEC    B        ;
  581.     RET    Z        ; Return if done
  582.     LD    E,80H        ; Else incr by 1/2 page
  583.     CALL    WRSEC        ;
  584.     INC    D        ; Inc hi-byte, 0 the lo to effect
  585.     LD    E,0        ; Another 80h incr
  586.     DJNZ    WRTLP        ; Loop till done
  587.  
  588.     RET            ;
  589. ;..............................................................................
  590. ;
  591. MSECO:    LD    C,SETDMA    ; De already points to the output buffer
  592.     CALL    BDOSAV        ;
  593.  
  594.     LD    E,B        ; Put #of secs to write here, still in b
  595.     LD    C,SETMS        ; Bdos func#
  596.     CALL    BDOSAV        ;
  597.  
  598.     LD    DE,OUTFCB    ; Output file fcb
  599.     LD    C,WRITE        ; Bdos func#
  600.     CALL    BDOSAV        ; Write out the whole buffer
  601.     OR    A        ;
  602.     RET    Z        ; Ret if no error, else fall thru to
  603.                 ; "wrterr" below & then thru to "fatal"
  604. ;..............................................................................
  605. ;
  606. WRTERR:    CP    2        ; Disk full?
  607.     JR    NZ,NOTFUL    ;
  608.     LD    DE,ERR2B    ; "disk full."
  609.     JP    FATAL        ;
  610.  
  611. NOTFUL:    LD    DE,ERR2C    ; "output error." (generic failure message)
  612.     JP    FATAL        ;
  613. ;..............................................................................
  614. ;
  615. ; Aux subr for above. Writes 128 bytes from current val of DE.
  616. ;
  617. WRSEC:    LD    C,SETDMA    ; Set dma as spec'd
  618.     CALL    BDOSAV        ;
  619.     PUSH    DE        ; Save that val
  620.     LD    DE,OUTFCB    ; Spec the output file
  621.     LD    C,WRITE        ;
  622.     CALL    BDOSAV        ; Do it
  623.     OR    A        ;
  624.     POP    DE        ; Restore to same value as before
  625.     RET    Z        ; Rtn, assuming no error
  626.  
  627.     JR    WRTERR        ;
  628. ;______________________________________________________________________________
  629. ;
  630. ; Output the partial output buffer thru the current pointer (DE'). If not  on
  631. ; a  sector  boundary, fill the remainder with "1A"'s. Close files &  see  if
  632. ; there are any more of them.
  633. ;
  634. DONE:    EXX            ; Determine where nearest record boundary is
  635.     LD    A,E        ; Get low byte of output pointer
  636.     EXX            ;
  637.     CPL            ; Compute how far to next page boundary
  638.     INC    A        ;
  639.     AND    7FH        ; Convert to distance to next half-page bndry
  640.     JR    Z,ONBNDY    ; If there already (should be the case on uncr)
  641.  
  642.     LD    B,A        ; Else set up to fill rest of sector w/ eof's
  643.     LD    A,1AH        ;
  644.  
  645. FILLP:    CALL    OUTB        ; Do that
  646.     DJNZ    FILLP        ;
  647.  
  648. ONBNDY:    EXX            ; Compute #of sectors to write to disk
  649.  
  650.     EX    DE,HL        ; Put output pointer in hl
  651.     LD    BC,OBUF        ; (ok to clobber bc' now, uncr is done w/ it)
  652.     AND    A        ; (clr carry)
  653.     SBC    HL,BC        ; How far into the buffer we are
  654.     SLA    L        ; Effectively divide difference by 128
  655.     RL    H        ;
  656.     LD    B,H        ; "b" now has #of recs to be written
  657.  
  658.     CALL    WRTOUT        ; Do that
  659.     CALL    PROGI2        ; Output the final count
  660.     CALL    PROGF        ; Last pass: print values in "k" also
  661.  
  662.     EXX            ;
  663.     RET            ;
  664.  
  665. ;------------------------------------------------------------------------------
  666. ;    File I/O subroutines:  Input and/or Output
  667. ;------------------------------------------------------------------------------
  668.  
  669. ; "Log" to the input, output, or the default user area.
  670.  
  671. LOGDEF:    PUSH    BC        ;
  672.     PUSH    DE        ;
  673.     LD    A,(USERNO)    ; Log to the original user area, if necessary
  674.     JR    LOGX        ;
  675.  
  676. LOGOUT:    PUSH    BC        ;
  677.     PUSH    DE        ;
  678.     LD    A,(OUTUSR)    ; Log to the output user area, if necessary
  679.     JR    LOGX        ;
  680.  
  681. LOGIN:    PUSH    BC        ;
  682.     PUSH    DE        ;
  683.     LD    A,(INUSR)    ; Log to the input user area, if necessary
  684.  
  685. LOGX:    LD    E,A        ; Common code for either of above
  686.     LD    A,(CURUSR)    ;
  687.     CP    E        ;
  688.     JR    Z,SKIPU        ; Filter out unnecessary user# changes
  689.  
  690.     LD    A,E        ; Back to "A" for updating "curusr"
  691.     LD    (CURUSR),A    ; Do that
  692.     LD    C,GSUSER    ; Now actually change user #'s
  693.     CALL    BDOSAV        ;
  694.  
  695. SKIPU:    POP    DE        ;
  696.     POP    BC        ;
  697.     RET            ;
  698. ;______________________________________________________________________________
  699. ;
  700. ; Get the current (called on program entry) user#. Put it in "USERNO".
  701. ; Get the default drive and put its adjusted value in "DEFDRV"
  702. ;
  703. GETUSR:    PUSH    BC        ;
  704.     PUSH    DE        ;
  705.     LD    C,GSUSER    ;
  706.     LD    E,0FFH        ; Spec "get" as opposed to "set"
  707.     CALL    BDOSAV        ;
  708.     LD    (USERNO),A    ; Put that there
  709.     LD    C,GETDSK    ; Get current disk function
  710.     CALL    BDOSAV        ;
  711.     INC    A        ; Adjust so it is normal (ie a=1, not zero)
  712.     LD    (DEFDRV),A    ; Put that there
  713.     POP    DE        ;
  714.     POP    BC        ;
  715.     RET            ;
  716. ;______________________________________________________________________________
  717. ;
  718. ; Advance to the next file in the wildcard expansion filename list.
  719. ;
  720. SKIPIT:    LD    A,(QUIFM)    ; One less cr/lf desirable in quiet mode
  721.     OR    A        ;
  722.     JR    NZ,NNCRLF    ;
  723.     CALL    CRLF        ; When done, advance console cursor to newline
  724.  
  725. NNCRLF:    LD    HL,(NMBFLS)    ; #of files left to do
  726.     DEC    HL        ; Done with that one!
  727.     LD    (NMBFLS),HL    ;
  728.     LD    A,H        ;
  729.     OR    L        ;
  730.     RET            ; Rtn w/ non-0 status if still more files
  731.  
  732. ;______________________________________________________________________________
  733. ;
  734. ; Add the value in A to the current running checksum. Regular regs active.
  735. ;
  736. CKSUM:    LD    HL,(CHKSUM)    ; Get current checksum
  737.     LD    C,A        ;
  738.     LD    B,0        ; New val in bc
  739.     ADD    HL,BC        ; Add to running checksum
  740.     LD    (CHKSUM),HL    ; And save
  741.     RET            ; Return w/ a still intact
  742. ;______________________________________________________________________________
  743. ;
  744. ; Initialize the FCB pointed to by DE. Leave the drive spec alone.
  745. ;
  746. CLRFCB:    PUSH    DE        ; Save caller's pointer to fcb
  747.     INC    DE        ; Skip past drive spec
  748.     LD    B,11        ; #of blanks for filename area
  749.     LD    A,' '        ; A blank, obviously
  750.  
  751. ZLP1:    LD    (DE),A        ; Put in the blanks
  752.     INC    DE        ;
  753.     DJNZ    ZLP1        ;
  754.  
  755.     LD    B,24        ; #of zeroes for the rest
  756.     XOR    A        ; A zero, obviously
  757.  
  758. ZLP2:    LD    (DE),A        ; Put those in
  759.     INC    DE        ;
  760.     DJNZ    ZLP2        ;
  761.  
  762.     POP    DE        ; Restore pointer to fcb and rtn
  763.     RET            ;
  764.  
  765. ;------------------------------------------------------------------------------
  766. ;    Misc. subroutines
  767. ;------------------------------------------------------------------------------
  768. ;
  769. RSPNSE:    LD    C,CONIN        ; --- get a user y/n response ---
  770.     CALL    BDOSAV        ; Wait for response
  771.     LD    C,A        ; Put that there for a sec
  772.     LD    A,' '        ;
  773.     CALL    TYPE        ;
  774.     LD    A,C        ; Ok...
  775.     CP    CTRLC        ; ^c ?
  776.     JR    NZ,NCTRLC    ; Br if not
  777.     LD    DE,ABORT    ;
  778.     JP    FATAL        ;
  779.  
  780. NCTRLC:    CP    'Y'        ;
  781.     RET    Z        ;
  782.     CP    'y'        ;
  783.     RET            ; Rtns zero response if guy answered "Yes"
  784. ;______________________________________________________________________________
  785.  
  786. DIVIDE:                ; 4 x 2 divide- hlde / bc for result in de
  787.                 ; (remainder in hl)
  788.  
  789.     LD    A,B        ; }
  790.     CPL            ; }
  791.     LD    B,A        ; }
  792.     LD    A,C        ; } negate divisor in bc
  793.     CPL            ; }
  794.     LD    C,A        ; }
  795.     INC    BC        ; }
  796.  
  797. DV10:    LD    A,11H        ; Iterations, 17 req. to get all the de bits
  798.     JR    UM1
  799. UM0:    ADC    HL,HL
  800. UM1:    ADD    HL,BC        ; Divide hlde by -bc
  801.     JR    C,UM2        ; If it fit
  802.     SBC    HL,BC        ; Else restore it
  803.     OR    A        ; Make sure carry is 0
  804. UM2:    RL    E        ; Result bit to de
  805.     RL    D
  806.     DEC    A
  807.     JR    NZ,UM0        ; Continue
  808.  
  809.     RET
  810. ;______________________________________________________________________________
  811. ;
  812. DIV10:    EX    DE,HL        ; Divide 16 bit val in hl by 10
  813.     LD    HL,0        ; Zero the lo byte
  814.     LD    BC,-10        ; We can skip the negation code
  815.     JR    DV10        ;
  816. ;______________________________________________________________________________
  817. ;
  818. ; Bdos call with all registers and alternates saved except "A"
  819. ;
  820. BDOSAV:    EX    AF,AF'
  821.     PUSH    AF
  822.     EX    AF,AF'
  823.  
  824.     PUSH    BC
  825.     PUSH    DE
  826.     PUSH    HL
  827.     EXX
  828.     PUSH    BC
  829.     PUSH    DE
  830.     PUSH    HL
  831.     PUSH    IX
  832.     PUSH    IY
  833.     EXX
  834.     CALL    BDOS
  835.     LD    (BDOSHL),HL    ; Some routines may want to analyze hl
  836.     EXX
  837.     POP    IY
  838.     POP    IX
  839.     POP    HL
  840.     POP    DE
  841.     POP    BC
  842.     EXX
  843.     POP    HL
  844.     POP    DE
  845.     POP    BC
  846.  
  847.     EX    AF,AF'
  848.     POP    AF
  849.     EX    AF,AF'
  850.  
  851.     RET
  852. ;______________________________________________________________________________
  853. ;
  854. ; Type the string pointed to by DE to the console.
  855. ;
  856. MESAGE:    CALL    CRLF        ; Precede all messages with cr, lf
  857.  
  858. MESAG2:    PUSH    BC        ; (entry here for no cr/lf)
  859.     LD    C,PRTSTR    ; Print string
  860.     CALL    BDOSAV        ;
  861.     POP    BC        ;
  862.     RET            ;
  863. ;______________________________________________________________________________
  864. ;
  865. ; Non-Z80 fatal error special "emergency exit". This routine to be JUMPED to.
  866. ;
  867. MESS80:    LD    C,PRTSTR    ; Can't use "MESAGE" beause can't use "BDOSAV"
  868.     CALL    BDOS        ;
  869.     RET            ; Rtn to CCP. (OS's stack still intact)
  870. ;______________________________________________________________________________
  871. ;
  872. ; Print a carriage return / linefeed sequence.
  873. ;
  874. CRLF:    LD    A,CR        ;
  875.     CALL    TYPE        ;
  876.     LD    A,LF        ;
  877.     CALL    TYPE        ;
  878.     RET            ;
  879. ;______________________________________________________________________________
  880. ;
  881. ; Type the character in A to the console device. Saves all regs.
  882. ;
  883. TYPE:    PUSH    AF        ;
  884.     PUSH    BC        ;
  885.     PUSH    DE        ;
  886.     LD    E,A        ; Where bdos wants it
  887.     LD    C,CONOUT    ; Bdos "console output" function
  888.     CALL    BDOSAV        ; Do it
  889.     POP    DE        ;
  890.     POP    BC        ;
  891.     POP    AF        ;
  892.     RET            ;
  893. ;______________________________________________________________________________
  894. ;
  895. ; Print fatal error messages. Jump to this routine- not a call!
  896. ;
  897. FATALU:    CALL    MESAGE        ; Entry here if usage instructions desired.
  898. GIVUSG:    LD    DE,USAGE    ;
  899.  
  900. FATAL:    CALL    MESAGE        ; Print any final message.
  901. RETCCP:    CALL    LOGDEF        ; Restore user number from original prog entry
  902.  
  903.     LD    SP,(OLDSTK)    ; Restore to system stack
  904.     LD    A,(WRMFLG)    ; Warm boot flag set?
  905.     OR    A        ;
  906.     JP    NZ,0000        ; If so, perf a warm boot
  907.     RET            ; Else return to system ccp
  908. ;______________________________________________________________________________
  909. ;
  910. ; Print the filename whose FCB is pointed to by HL. Aligned filename printout
  911. ; due to J. Sage.
  912. ;
  913. PRNFIL:    DEC    HL        ; Slide back to user# at fcb-1
  914.     LD    B,(HL)        ; Put that here for now
  915.     INC    HL        ; Back to drive spec
  916.     LD    A,(HL)        ; Get drive spec
  917.     INC    HL        ; Move to 1st char of filename
  918.     OR    A        ; Drive = default?
  919.  
  920.     JR    NZ,NOTDEF    ; Br if not
  921.     LD    A,(DEFDRV)    ; If so, get the default drive
  922.  
  923. NOTDEF:    ADD    A,'A'-1        ; Convert to a letter
  924.     CALL    TYPE        ;
  925.  
  926.     LD    C,11+2        ; Total spaces to fill for fn and ft + 1
  927.                 ; (will be used later)
  928.  
  929.     LD    A,B        ; Get user# we picked up above
  930.     CP    10        ; 2 digits?
  931.     JR    C,ONEDIG    ; Br if not
  932.     PUSH    AF        ;
  933.     LD    A,'1'        ; Type the '1'
  934.     CALL    TYPE        ;
  935.     POP    AF        ;
  936.     DEC    C        ; Adjust #of spaces typed by one
  937.     SUB    10        ;
  938.  
  939. ONEDIG:    ADD    A,'0'        ; Ascii conversion
  940.     CALL    TYPE        ; Type the other (or only) digit
  941.  
  942.     LD    A,':'        ; Follow drive spec with a ":"
  943.     CALL    TYPE        ;
  944.  
  945.     LD    B,8+1        ; Max chars in file name plus 1
  946.     CALL    PRNFNT        ; Print file name
  947.     LD    A,'.'        ; Print dot
  948.     CALL    TYPE
  949.     LD    B,3+1        ; Max chars in file type plus 1
  950.     CALL    PRNFNT        ; Print file type
  951. PRNSP:    LD    A,' '        ; Fill out with spaces
  952.     DEC    C        ;
  953.     RET    Z        ;
  954.     CALL    TYPE        ;
  955.     JR    PRNSP        ;
  956. ;................................
  957. ;
  958. PRNFNT:    DEC    B        ; Aux routine for abv; print file name or type
  959.     RET    Z        ; Reyurn if no more
  960.     LD    A,(HL)        ; Else get character
  961.     INC    HL        ; Point to next character
  962.     CP    ' '        ; Is it a space?
  963.     JR    Z,PRNFNT    ; If so, loop back for more
  964.     DEC    C        ; Else, decrement count of printed chars
  965.     CALL    TYPE        ; Print the character
  966.     JR    PRNFNT        ; Back for more
  967. ;______________________________________________________________________________
  968. ;
  969. ; Wildcard expansion.  HL points to the filename buffer, & DE to the FCB.  On
  970. ; exit, HL will have the #of files, whose names are spaced 16 bytes apart  in
  971. ; the filename buffer (note names start at buffer +1, +17, etc.).
  972. ;
  973. WILDEX:                ; After S. Kluger
  974.     PUSH    DE        ; Save pointer to fcb to be expanded
  975.     LD    DE,DDMA        ; Explicitly set the dma to 80h
  976.     LD    C,SETDMA    ;
  977.     CALL    BDOSAV        ;
  978.     POP    DE        ; Restore fcb
  979.  
  980.     LD    HL,FNBUFF    ; Beginning of filename expansion buffer
  981.     LD    (BUFPTR),HL    ; Init pointer to that
  982.     LD    HL,0        ;
  983.     LD    (COUNT),HL    ; Init count to zero
  984.     LD    C,SFIRST    ;
  985.     CALL    BDOSAV        ; Bdos "Search for first" call
  986.     CP    0FFH        ;
  987.     RET    Z        ; Nothing found -- error
  988.  
  989.     CALL    MOVEN        ; Else move first name to buffer
  990.  
  991. WLOOP:    LD    C,SNEXT        ; "search for next"
  992.     CALL    BDOSAV        ;
  993.     CP    0FFH        ;
  994.     JR    Z,DONEW        ; Finished
  995.     CALL    MOVEN        ; Move another name in
  996.     JR    WLOOP        ; Loop for rest of files
  997.  
  998. DONEW:    OR    A
  999.     LD    HL,(COUNT)
  1000.     RET
  1001.  
  1002. MOVEN:    PUSH    DE        ; Aux routine for above
  1003.     LD    HL,(BUFPTR)
  1004.     ADD    A,A
  1005.     ADD    A,A
  1006.     ADD    A,A
  1007.     ADD    A,A
  1008.     ADD    A,A
  1009.     ADD    A,80H
  1010.     LD    C,A
  1011.     LD    B,0
  1012.     LD    D,16        ; Move 16 chars
  1013.  
  1014. MOVLP:    LD    A,(BC)
  1015.     LD    (HL),A
  1016.     INC    HL
  1017.     INC    BC
  1018.     DEC    D
  1019.     JR    NZ,MOVLP
  1020.  
  1021.     LD    (BUFPTR),HL
  1022.     POP    DE
  1023.     LD    HL,(COUNT)
  1024.     INC    HL
  1025.     LD    (COUNT),HL
  1026.     RET
  1027. ;______________________________________________________________________________
  1028. ;
  1029. ; Update the running count of #of records output (add one to it).
  1030. ;
  1031. PROGO:    PUSH    AF        ; Save everything
  1032.     PUSH    BC        ;
  1033.     PUSH    HL        ;
  1034.  
  1035.     LD    HL,(OUTCTR)    ; Update binary count
  1036.     INC    HL        ;
  1037.     LD    (OUTCTR),HL    ;
  1038.  
  1039.     LD    HL,PROGBF+11    ; Point to ascii string version of count
  1040.     CALL    BCDINC        ; Incr that, too
  1041.  
  1042.     POP    HL        ; Restore regs & return
  1043.     POP    BC        ;
  1044.     POP    AF        ;
  1045.     RET            ;
  1046. ;..............................................................................
  1047. ;
  1048. ; Update  #of records read on input. Every 2 or 4 calls to this routine,  ac-
  1049. ; tually update the display.
  1050. ;
  1051. PROGI:    PUSH    AF        ; Save everything
  1052.     PUSH    BC        ;
  1053.     PUSH    HL        ;
  1054.  
  1055.     PUSH    DE        ;
  1056.     LD    C,DIRCON    ;
  1057.     LD    E,0FFH        ; See if a char is avail; if it is, get it
  1058.     CALL    BDOSAV        ;
  1059.     POP    DE        ;
  1060.     OR    A        ; Return code from bdos- zero if no char
  1061.     JR    Z,CONTIN    ; If not, continue
  1062.  
  1063.     CP    CTRLC        ; ^c?
  1064.     JR    NZ,CONTIN    ; Continue if not
  1065.  
  1066.     LD    DE,ABORT    ; Else abort
  1067.     JP    FATAL        ;
  1068.  
  1069. CONTIN:    LD    A,(INCTR+0)    ; Mask ls bits to determine whether this call
  1070.     DEC    A        ; - is an 'active' one (updates the console)
  1071.     LD    L,A        ; Put that there for a sec
  1072.     LD    A,(UFLAG2)    ; 03H for UNCR, 07H for CRUNCH
  1073.     AND    L        ;
  1074.     LD    L,A        ; Once again, put that there for a sec
  1075.  
  1076.     LD    A,(QUIFM)    ; Flag disables all verbiage
  1077.     OR    L        ; (both must be zero for a printout)
  1078.     CALL    Z,PRNFIN    ; If zero, actually do a printout
  1079.  
  1080.     LD    HL,(INCTR)    ; In any event, perform the increments
  1081.     INC    HL        ; First, incrment the binary version
  1082.     LD    (INCTR),HL    ;
  1083.  
  1084.     LD    HL,PROGBF+5    ; Increment ascii string representing same
  1085.     CALL    BCDINC        ;
  1086.  
  1087.     POP    HL        ; Restore regs & rtn
  1088.     POP    BC        ;
  1089.     POP    AF        ;
  1090.     RET            ;
  1091. ;..............................................................................
  1092. ;
  1093. ; Routine  like  "PROGI" above, but does NOT increment and  WILL  update  the
  1094. ; console on any call. Basically used as a final screen update.
  1095. ;
  1096. PROGI2:    PUSH    AF        ;
  1097.     LD    A,(QUIFM)    ; Still, don't type if in "quiet" mode
  1098.     OR    A        ;
  1099.     JR    NZ,QUIET2    ;
  1100.  
  1101.     PUSH    BC        ; Else print up the final tally
  1102.     PUSH    HL        ;
  1103.     CALL    PRNFIN        ;
  1104.     POP    HL        ;
  1105.     POP    BC        ;
  1106.  
  1107. QUIET2:    POP    AF        ;
  1108.     RET            ;
  1109. ;______________________________________________________________________________
  1110. ;
  1111. PRNFIN:    PUSH    DE        ; Update the console display...
  1112.     PUSH    IX        ;
  1113.  
  1114.     LD    DE,PROGBF    ; This buffer contains most of the stuff,
  1115.     CALL    MESAG2        ; - ready to be typed
  1116.  
  1117.     LD    DE,(OUTCTR)    ; Compression ratio must be computed, however
  1118.     PUSH    DE        ;
  1119.     POP    IX        ; Get #of output recs into ix
  1120.  
  1121.     LD    HL,(INCTR)    ; Spec the divisor for the subroutine call
  1122.     LD    (DIVISR),HL    ;
  1123.     CALL    COMRAT        ; Compute ratio. result, in %, returned in hl
  1124.  
  1125.     LD    A,' '        ; Need an extra space here to make it look good
  1126.     CALL    TYPE        ;
  1127.  
  1128.     CALL    DECOUT        ; Type to screen in decimal
  1129.     LD    DE,PERCNT    ; A "%" char, basicly
  1130.     CALL    MESAG2        ; Type that
  1131.  
  1132.     LD    A,(OLDFLG)    ; Skip rest for old style (v1.x) files
  1133.     OR    A        ;
  1134.     JR    NZ,SKIPW    ;
  1135.  
  1136.     LD    HL,(ENTRY)    ; Type "Codes Assigned" to the screen
  1137.     LD    A,(UFLAG)    ; Fudge factor analysis
  1138.     OR    A        ;
  1139.     JR    Z,NOFUD        ;
  1140.     DEC    HL        ; Adjust for a 2 count "skew" due to
  1141.     DEC    HL        ; - inherent nature of UNCR to be "behind"
  1142. NOFUD:    CALL    DECOUT        ;
  1143.  
  1144.     LD    A,' '        ; Some more aesthetics
  1145.     CALL    TYPE        ;
  1146.     CALL    TYPE        ;
  1147.  
  1148.     LD    HL,(TTOTAL)    ; Get "Codes Reassigned"
  1149.     CALL    DECOUT        ; Type that value
  1150.  
  1151.     LD    A,(FULFLG)    ; Below analysis only used by "crunch" only
  1152.     LD    L,A        ;
  1153.     LD    A,(UFLAG)    ; Conceivably speed things up a little?
  1154.     AND    L        ; (by skipping if not full or not crunching)
  1155.     JR    Z,SKIPW        ;
  1156.  
  1157. ; "Incremental compression ratio" computation. For analysis of the  possibil-
  1158. ; ity of setting the adaptive reset flag, compute the compression ratio since
  1159. ; the  last reset (not necessarily the beginning of the file).    This is  sig-
  1160. ; nificantly  preferable to analyzing the ratio since the beginning (the  one
  1161. ; displayed  on  the console) because that number gets very "stable"  as  one
  1162. ; gets further & further into a large file. Sudden structural variations will
  1163. ; not get picked up quickly that way.
  1164.  
  1165. ; INCTR0 and OUTCT0 contain the #of records at the time of the last reset (or
  1166. ; zero). The offset from them (to the current values) are the numbers divided
  1167. ; to compute the ratio.
  1168.  
  1169.     LD    HL,(INCTR)    ; As described above
  1170.     LD    DE,(INCTR0)    ;
  1171.     AND    A        ;
  1172.     SBC    HL,DE        ;
  1173.     LD    (DIVISR),HL    ; Adjusted input rec count will be the divisor
  1174.  
  1175.     LD    HL,(OUTCTR)    ;
  1176.     LD    DE,(OUTCT0)    ;
  1177.     AND    A        ;
  1178.     SBC    HL,DE        ; Adjusted output record count is dividend
  1179.     EX    DE,HL        ;
  1180.     PUSH    DE        ;
  1181.     POP    IX        ; Put it in IX for the subR call
  1182.  
  1183.     CALL    COMRAT        ; Returns a compression ration in "HL"
  1184.  
  1185. ; The  criteria  for adaptive reset is when the current  "incremental"    ratio
  1186. ; goes "up". "Up" is defined as higher the limit, which is equal to the  low-
  1187. ; est  incremental ratio achieved so far (not necessarily the  last  computed
  1188. ; ratio). ["So far" means since the last adaptive  reset, if any.]
  1189.  
  1190. ; Computations    below are single byte precision. If the  "compression"    ratio
  1191. ; (during  crunching) actually ever got higher than 256%, then this  analysis
  1192. ; is really quite irrelevant.. that would really be a lost cause...
  1193.  
  1194.     LD    A,(LOWPER)    ; Get "target" value
  1195.     SUB    L        ; Compare to current
  1196.     JR    C,CHK4RS    ; If current is higher, reset may be indicated
  1197.  
  1198.     LD    A,L        ; If new ratio is lower, it is the new target
  1199.     LD    (LOWPER),A    ;
  1200.     JR    SKIPW        ; That's all
  1201.  
  1202. ; If  new  value is higher, a reset may be indicated. The exact  criteria  is
  1203. ; that    the  value  be one full percentage point, besides the  +/-  1  normal
  1204. ; roundoff wavering, above the target value.
  1205.  
  1206. CHK4RS:    INC    A        ; Adjust the difference computed by one
  1207.     JP    P,SKIPW        ; If that is not negative, no reset now
  1208.  
  1209.     LD    A,80H        ; Else set the adaptive reset flag. Full
  1210.     LD    (RSTFLG),A    ; - processing occurs back at the main loop
  1211.  
  1212.     PUSH    HL        ; However, take care of updating these now
  1213.     LD    HL,(INCTR)    ; Inctr0 <-- inctr
  1214.     LD    (INCTR0),HL    ;
  1215.     LD    HL,(OUTCTR)    ; Outct0 <-- outctr
  1216.     LD    (OUTCT0),HL    ;
  1217.     POP    HL        ;
  1218.  
  1219. SKIPW:    POP    IX        ; Restore regs and return
  1220.     POP    DE        ;
  1221.     RET
  1222. ;______________________________________________________________________________
  1223. ;
  1224. ; Compute a compression ratio, in percent.  Calculates IX / ("divisr").  When
  1225. ; called, DE must have a a copy of the dividend as well as IX.
  1226. ;
  1227. COMRAT:    LD    HL,0        ; Prepare for 32 bit multiply by 100
  1228.     LD    B,H        ; [ ratio = (100 * out) / in ]
  1229.     LD    C,L        ;
  1230.  
  1231.     ADD    IX,IX
  1232.     ADC    HL,HL        ; 2x
  1233.     ADD    IX,DE
  1234.     ADC    HL,BC        ; 3x
  1235.     ADD    IX,IX
  1236.     ADC    HL,HL        ; 6x
  1237.     ADD    IX,IX
  1238.     ADC    HL,HL        ; 12x
  1239.     ADD    IX,IX
  1240.     ADC    HL,HL        ; 24x
  1241.     ADD    IX,DE
  1242.     ADC    HL,BC        ; 25x
  1243.     ADD    IX,IX
  1244.     ADC    HL,HL        ; 50x
  1245.     ADD    IX,IX
  1246.     ADC    HL,HL        ; 100x
  1247.     ADD    IX,IX
  1248.     ADC    HL,HL        ; 200x
  1249.  
  1250.     PUSH    IX        ; Get result into hl de for dividing
  1251.     POP    DE        ;
  1252.  
  1253.     LD    BC,(DIVISR)    ; Get divisor
  1254.     CALL    DIVIDE        ; Divides (hl de) / bc
  1255.     EX    DE,HL        ; Put result into hl
  1256.     SRL    H        ; Divide it by 2
  1257.     RR    L        ;
  1258.     RET    NC        ; & return if no need to round up
  1259.     INC    HL        ; Else round up
  1260.     RET
  1261. ;..............................................................................
  1262. ;
  1263. ; Increment a 4 character ASCII unpacked BCD string, pointed to by HL.
  1264. ;
  1265. BCDINC:    LD    B,4        ; Loop counter
  1266.  
  1267. DIGLP:    LD    A,(HL)        ; Hl points to string
  1268.     OR    10H        ; Blank to zero conversion (init'd to blank)
  1269.     INC    A        ; Incr
  1270.     LD    (HL),A        ; Re-store
  1271.     CP    '9'+1        ; Carry?
  1272.     RET    NZ        ; Rtn if not
  1273.     LD    (HL),'0'    ; Else zero & loop to next char
  1274.     DEC    HL        ;
  1275.     DJNZ    DIGLP        ; (but not past limit)
  1276.  
  1277.     RET            ; & rtn
  1278. ;______________________________________________________________________________
  1279. ;
  1280. ; Convert records to "k" and print same.  Called at end of process.
  1281. ;
  1282. PROGF:    PUSH    DE        ; Save regs
  1283.     PUSH    BC        ;
  1284.                 ;
  1285.     LD    DE,SPCPAR    ; Spaces, parenthesis
  1286.     CALL    MESAG2        ;
  1287.     LD    HL,(INCTR)    ; Input recs
  1288.     CALL    AUXSUB        ; Div by 8 and type
  1289.     LD    DE,ARROW2    ; " --->"
  1290.     CALL    MESAG2        ;
  1291.     LD    A,' '        ;
  1292.     CALL    TYPE        ;
  1293.     LD    HL,(OUTCTR)    ; Similarly for output recs
  1294.     CALL    AUXSUB        ;
  1295.     LD    A,')'        ;
  1296.     CALL    TYPE        ;
  1297.     CALL    CRLF        ;
  1298.  
  1299.     POP    BC        ; Restore & rtn
  1300.     POP    DE        ;
  1301.     RET            ;
  1302.  
  1303. ;................................
  1304.                 ; Aux routine for above calculates (HL)/8
  1305. AUXSUB:    LD    DE,7        ; With upward rounding, & types it.
  1306.     ADD    HL,DE        ; [ie compute (#recs+7) / 8 ]
  1307.  
  1308.     SRL    H        ; }
  1309.     RR    L        ; }
  1310.     SRL    H        ; } div by 8
  1311.     RR    L        ; }
  1312.     SRL    H        ; }
  1313.     RR    L        ; }
  1314.  
  1315.     CALL    DECOUT        ; Type hl in decimal
  1316.     LD    A,'k'        ;
  1317.     CALL    TYPE        ;
  1318.     RET            ;
  1319. ;______________________________________________________________________________
  1320. ;
  1321. ; Convert a binary number to four chars ASCII & type them, right justified.
  1322. ;
  1323. DECOUT:    CALL    DIV10        ; Divide orig # (in hl), by 10
  1324.     LD    A,L        ; Get remainder from l, (0-9)
  1325.     PUSH    AF        ; Save in reverse order retrieval later
  1326.     EX    DE,HL        ; Old dividend becomes new divisor
  1327.  
  1328.     CALL    DIV10        ; Repeat 3 more times
  1329.     LD    A,L        ;
  1330.     PUSH    AF        ;
  1331.     EX    DE,HL        ;
  1332.  
  1333.     CALL    DIV10        ;
  1334.     LD    A,L        ;
  1335.     PUSH    AF        ;
  1336.     EX    DE,HL        ;
  1337.  
  1338.     CALL    DIV10        ;
  1339.     LD    A,L        ;
  1340.     PUSH    AF        ;
  1341.     EX    DE,HL        ;
  1342.  
  1343.     LD    B,3        ; Becomes loop counter
  1344.     LD    C,0EFH        ; Mask to convert zeroes to blanks
  1345.  
  1346. DECLP:    POP    AF        ; Type the 4 digits, with leading 0 suppression
  1347.     OR    A        ; Is it zero?
  1348.     JR    Z,LVMASK    ; Lv mask set if so
  1349.     LD    C,0FFH        ; Else cancel masking (of zeroes to blanks)
  1350. LVMASK:    ADD    A,'0'        ; Convert to ascii
  1351.     AND    C        ; Possibly blank a zero
  1352.     CALL    TYPE        ; Output the char
  1353.     DJNZ    DECLP        ; Do the first 3 digits
  1354.  
  1355.     POP    AF        ; Last digit is easy. Never blank it.
  1356.     ADD    A,'0'        ; Convert to ACSII
  1357.     CALL    TYPE        ; Type it & rtn
  1358.     RET
  1359. ;______________________________________________________________________________
  1360. ;
  1361. ; (Re-)initialize  all    necessary ram locs. Called once for each file  to  be
  1362. ; processed.  This routine gets its info from an initialization block  called
  1363. ; "SHADOW",  which is copied into the working memory. Routine  also  performs
  1364. ; alternate register initialization.
  1365. ;
  1366. INTRAM:    LD    HL,SHADOW    ; Contains a copy of all relevant init values
  1367.     LD    DE,RAM        ; Target
  1368.     LD    BC,EOSHAD-SHADOW
  1369.     LDIR            ; Do it
  1370.  
  1371.     EXX            ; Routine performs register initialization too
  1372.     LD    HL,IBUF        ; Reset input buffer pointer
  1373.     LD    DE,OBUF        ; Reset output buffer pointer
  1374.     LD    BC,0        ; Zero this
  1375.     EXX            ; Back to primary registers
  1376.  
  1377.     RET            ;
  1378.  
  1379. ;------------------------------------------------------------------------------
  1380. ;    Text, data, etc.
  1381. ;------------------------------------------------------------------------------
  1382.  
  1383. ;______________________________________________________________________________
  1384. ;
  1385. CNMSG:    DEFB    ' Do it? ','$'
  1386. ABORT:    DEFB    '^C detected.$'
  1387. PROMPT:    DEFB    ' Overwrite existing file? ',BELL,'$'
  1388. HEADNG:    DEFB    '  in    out   rat   ca    cr',CR,LF ; (cont)
  1389.     DEFB    ' ====  ====  ====  ====  ====',CR,LF,'$'
  1390. ;______________________________________________________________________________
  1391. ;
  1392. SHADOW    EQU    $        ; (for description, see immediately below)
  1393.                 ;
  1394.     DB    00        ; "fulflg"
  1395.     DW    0000        ; "chksum"
  1396.     DB    01        ; "secnt"
  1397.     DW    0000        ; "inctr"
  1398.     DW    0000        ; "outctr"
  1399.     DW    0000        ; "inctr0"
  1400.     DW    0000        ; "outct0"
  1401.     DW    0000H        ; "entry"
  1402.     DB    09        ; "codlen"
  1403.     DB    02H        ; "trgmsk"
  1404.     DB    09H        ; "codle0"
  1405.     DB    00H        ; "rstflg"
  1406.     DW    0000H        ; "ttotal"
  1407.     DB    0FFH        ; "lowper"
  1408.     DW    NOPRED        ; "lastpr"
  1409.     DB    01H        ; "entflg"
  1410.     DB    00H        ; "oldflg"
  1411.     DB    CR,'    0 /   0$' ; "progbf"
  1412.  
  1413. EOSHAD    EQU    $
  1414. ;______________________________________________________________________________
  1415.  
  1416.     DSEG
  1417.  
  1418. ; The  following  ram locs must be re-initialized each time  the  program  is
  1419. ; executed (for each file when wildcards are used). The area called  "SHADOW"
  1420. ; above is used to accomplish this.
  1421.  
  1422. RAM    EQU    $
  1423.  
  1424. FULFLG:    DS    1        ; Becomes "FF" when table is full
  1425. CHKSUM:    DS    2        ; Checksum accumulated here
  1426. SECNT:    DS    1        ; Count of sectors read per "reload" call
  1427. INCTR:    DS    2        ; Count of total sectors read from input
  1428. OUTCTR:    DS    2        ; Likewise for output
  1429. INCTR0:    DS    2        ; Value of "inctr" at last reset
  1430. OUTCT0:    DS    2        ; Value of "outctr" at last reset
  1431. ENTRY:    DS    2        ; Current entry (code) number.
  1432. CODLEN:    DS    1        ; Current code length, in bits.
  1433. TRGMSK:    DS    1        ; Mask contains "1" bit in pos of next code len
  1434. CODLE0:    DS    1        ; "Delayed" value of "CODLEN"
  1435. RSTFLG:    DS    1        ; Will cause an adaptive reset when set
  1436. TTOTAL:    DS    2        ; "codes reassigned" (for display purposes)
  1437. LOWPER:    DS    1        ; Lowest incremental compr. ratio achieved
  1438. LASTPR:    DS    2        ; "Last pred"
  1439. ENTFLG:    DS    1        ; Flag prevents duplicating entries
  1440. OLDFLG:    DS    1        ;
  1441. PROGBF:    DS    20        ; Alphanumeric ASCII to go to console
  1442. ;..............................................................................
  1443.  
  1444. INUSR:    DS    1        ; MUST immediately precede the input FCB
  1445. INFCB:    DS    36        ; Input file FCB.
  1446.  
  1447. OUTUSR:    DS    1        ; MUST immediately precede the output FCB
  1448. OUTFCB:    DS    36        ; Output FCB
  1449.  
  1450. ;..............................................................................
  1451. ;
  1452. ; The  flags below are analogous to some of patches at the beginning  of  the
  1453. ; program. Those default values are copied into the data area here each prog-
  1454. ; ram  execution,  since some can be changed if an appropriate    command  line
  1455. ; option is processed. This keeps the prgrm re-executable.
  1456.  
  1457. QUIFM:    DS    1        ; Verbose mode flag
  1458. NPROFM:    DS    1        ; No prompt before overwrite flag
  1459. NOMSFM:    DS    1        ; Defeat multi-sector i/o flag
  1460. CNFRFM:    DS    1        ; Confirm every file flag
  1461. ;______________________________________________________________________________
  1462.