home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / enterprs / cpm / utils / f / ql41.ark / QL.001 < prev    next >
Encoding:
Text File  |  1990-04-13  |  41.9 KB  |  1,852 lines
  1. ;.......................
  2. ;
  3. ; QL v4.1 26 January  1989
  4. ;
  5. QLVERS    EQU    41        ; <=== version #, keep up to date!
  6. QLDATE    MACRO
  7.     DB    '  26 January  1989'
  8.     ENDM
  9. ;==============================================================================
  10. ;
  11. ; Ascii equates
  12. ;
  13. NULL    EQU    0
  14. CTRLC    EQU    'C'-40H
  15. CTRLK    EQU    'K'-40H
  16. CTRLX    EQU    'X'-40H
  17. BEL    EQU    7
  18. BS    EQU    8
  19. TAB    EQU    9
  20. LF    EQU    10
  21. FF    EQU    12
  22. CR    EQU    13
  23. EOF    EQU    1AH
  24. ESC    EQU    1BH
  25.  
  26. ;==============================================================================
  27. ;
  28. ; BDOS function equates
  29. ;
  30. CONOUT    EQU    2        ; Console Output
  31. DIRIO    EQU    6        ; Direct Console I/O
  32. RDBUFF    EQU    10        ; Console Read String
  33. OPEN    EQU    15        ; File Open
  34. CLOSE    EQU    16        ; File Close
  35. SRCH1ST    EQU    17        ; Search 1st
  36. SRCHNXT    EQU    18        ; Search Next
  37. ERASE    EQU    19        ; File Erase
  38. READSEQ    EQU    20        ; File Read  [Sequential]
  39. WRITSEQ    EQU    21        ; File Write [Sequential]
  40. CREAT    EQU    22        ; File Create
  41. GETDSK    EQU    25        ; Get Current Disk
  42. SETDMA    EQU    26        ; Set Direct Memory Address
  43. SGUSER    EQU    32        ; Set/Get User
  44. RANDOM    EQU    33        ; File Read [Random]
  45. SETRND    EQU    36        ; Set random record
  46.  
  47. ;==============================================================================
  48. ;
  49. ; Page zero equates
  50. ;
  51. BDOSEV    EQU    0005        ; BDOS Entry Vector
  52. FCB1    EQU    005CH        ; File Control Block 1
  53. FCB1FN    EQU    FCB1+01        ; FCB1 Filename
  54. FCB1TYP    EQU    FCB1+09        ; FCB1 Type
  55. FCB1EXT EQU    FCB1+12        ; FCB1 Extent
  56. FCB1CR    EQU    FCB1+20H    ; Current rec in extent
  57. FCB1R0    EQU    FCB1+21H    ; Rec number for sizing & lbr random access
  58. FCB1R2    EQU    FCB1+23H    ; 0'd before random read
  59.  
  60. ;==============================================================================
  61. ;
  62. ; Derived Equates
  63. ;
  64.      IF    M80        ; Non-syntax specific implementation of
  65. Z1    EQU    FALSE        ; - mutual exclusion
  66.      ELSE
  67. Z1    EQU    TRUE
  68.      ENDIF
  69.  
  70.      IF    Z1
  71.     NLIST    S        ; No source listing
  72.     LIST    C        ; Gen com file directly
  73.      ENDIF
  74.  
  75.      IF    Z1
  76. CTRLDUMMY EQU    .NOT.(CTRLWORDSTAR.OR.CTRLDIMVID)
  77.      ELSE
  78. CTRLDUMMY EQU    NOT (CTRLWORDSTAR OR CTRLDIMVID)
  79.      ENDIF
  80.  
  81. ;==============================================================================
  82. ;
  83. ; "assumed equates"
  84. ;
  85. ; Adjustable screen height and width is only partially implemented in the
  86. ; current version, so for now these should remain at 24 and 80 respectively.
  87. ;
  88. LINES    EQU    24        ; Terminal console lines.
  89. COLUMNS    EQU    80        ; Terminal console columns.
  90.  
  91. ;==============================================================================
  92. ;
  93.      IF    ZCPR3
  94.     CSEG
  95.      ELSE
  96.     ASEG
  97.     ORG    100H
  98.      ENDIF
  99. ;.....
  100. ;
  101.      IF    ZCPR3
  102.     PUBLIC    $MEMRY
  103.     EXTRN    Z3VINIT,TINIT,DINIT
  104.     EXTRN    CLS,STNDOUT,STNDEND
  105.     EXTRN    Z3LOG,GETWHL,GETSPEED,GETCRT,GETVID
  106.     EXTRN    COUT,GETUD,PUTUD
  107.     EXTRN    RETUD,LOGUD
  108.      ENDIF
  109.  
  110. ; set the number of lines we can display (don't change)
  111.  
  112. DISPLY    EQU    LINES-LINEOVERLAP-1 ; Display page size = 23
  113. NL    EQU    LINES-6
  114.  
  115. ;=====================================================================
  116. ;    Entry Point
  117. ;=====================================================================
  118.  
  119. QL:    JP    MAIN        ; <=== entry
  120.  
  121.      IF    ZCPR3
  122.     DB    'Z3ENV',1
  123. Z3EADR:    DW    0
  124.      ENDIF
  125. ;..............................................................................
  126. ;
  127. ; embedded copyright message simplified & moved near beginning (for dump)
  128. ; since it is no longer displayed at runtime
  129.  
  130.     DB    'by Nick Dobrinich and Ross Presser '
  131.     DB    'Sections Copyright (c) 1986 '
  132.     DB    'Steven Greenberg and C.B. Falconer '
  133.     DB    'May be reproduced for non-profit use only.'
  134.  
  135. SIGNON:    CALL    MSG
  136.  
  137.     DB    'QL v',QLVERS/10+'0','.'
  138.     DB    (QLVERS-((QLVERS/10)*10))+'0'
  139.  
  140.      IF    ZCPR3        ;
  141.     DB    ' /Z3'        ;
  142.      ENDIF            ;
  143.  
  144.     QLDATE
  145.  
  146.     DB    CR,LF,LF
  147.     DB    '  --- While viewing ---           --- Toggle Commands ---',CR,LF
  148.     DB    CR,LF
  149.     DB    '<cr>    Forward one page          A   Display ASCII / HEX:  '
  150. ASTATE:    DB    'ASCII',CR,LF
  151.     DB    '<sp>    Forward one line          T   Truncate long lines:    '
  152. TSTATE:    DB    'YES',CR,LF
  153.     DB    '<##>    Go to any page ##         C   Case sensitive find:    '
  154. CSTATE:    DB    ' NO',CR,LF
  155.     DB    ' B      Backward one page',CR,LF
  156.     DB    ' H      Home (Top of file)',CR,LF
  157.     DB    ' E      End  (Bot of file)',CR,LF,LF
  158.     DB    ' F      Find text or hex byte',CR,LF
  159.     DB    ' R      Repeat find',CR,LF
  160.     DB    ' X      Exit viewing',CR,LF,LF,0
  161.     RET
  162.  
  163. REQCMD:    CALL    MSG
  164.     DB    CR,LF,LF,'Command, or <ret> to resume Viewing: ',0
  165.     RET
  166.  
  167. ;=====================================================================
  168. ;    Main Program
  169. ;=====================================================================
  170.  
  171. MAIN:
  172.     LD    (OLDSP),SP    ; Save old sp if no warm boot needed
  173.     LD    SP,STACK    ; Set up local stack
  174. ;................................
  175.                 ;
  176.      IF    ZCPR3        ; ZCPR3 initialization stuff
  177.     LD    HL,(Z3EADR)    ;
  178.     CALL    Z3VINIT        ;
  179.     CALL    TINIT        ;
  180.     CALL    GETCRT        ;
  181.     INC    HL        ;
  182.     INC    HL        ;
  183.     LD    A,(HL)        ; Get #of lines on CRT
  184.     LD    (NLINES),A    ; Keep that there
  185.     SUB    LINEOVERLAP+1    ;
  186.     LD    (DISPLAY),A    ; # of lines per screen
  187.     CALL    PUTUD        ; Save orig DU for exit
  188.     CALL    RETUD        ; Get orig logged DU
  189.     LD    (DEFDU),BC    ; Save that here
  190.     LD    DE,FCB1        ; Log to the file spec'd on the cmnd line
  191.     CALL    Z3LOG        ;
  192.     CALL    RETUD        ; Get the filenames DU
  193.     LD    (LBRDU),BC    ; And save that here..
  194.     LD    HL,($MEMRY)    ; Get addr of free memory
  195. ;...............................;
  196.  
  197. ;................................
  198.                 ; French vanilla CP/M
  199.      ELSE            ;
  200.     ld    A,LINES        ;
  201.     ld    (NLINES),a    ; Init screen size
  202.     LD    A,DISPLY    ;
  203.     LD    (DISPLAY),A    ; Init lines/pg-1
  204.     LD    C,GETDSK    ;
  205.     CALL    BDOSC1        ;
  206.     LD    (DEFDU+1),A    ; Keep default drive here ( 0 = "A")
  207.     LD    (LBRDU+1),A    ; Assume that the spec'd filename is same
  208.     LD    A,(FCB1+0)    ; Get the filename's drive spec
  209.     OR    A        ;
  210.     JR    Z,ISSAME    ; If zero, it is indeed the same
  211.     DEC    A        ; Else reduce the fcb+0 value so "A = 0"
  212.     LD    (LBRDU+1),A    ; And use that
  213.                 ;
  214. ISSAME:    LD    C,SGUSER    ; Now for user area stuff. For the regular
  215.     LD    E,0FFH        ; - CP / M version there is only one user#
  216.     CALL    BDOSC1        ;
  217.     LD    (DEFDU+0),A    ; So keep default user here (for display)
  218.     LD    (LBRDU+0),A    ; And a copy here as well
  219.     LD    HL,ENDPROG    ; Get addr of free memory
  220.      ENDIF            ;
  221. ;...............................;
  222.  
  223. ;................................
  224.                 ; New dynamic memory allocation.
  225.     LD    (@PTRTBL),HL    ; Assign beg of free memory to 1k "PTRTBL"
  226.     LD    DE,1024        ;
  227.     ADD    HL,DE        ;
  228.     LD    (@BUFFER),HL    ; And everything above that to "BUFFER"
  229. ;...............................;
  230.  
  231.     CALL    INI1MEM        ; Init all memory from "init1" - "end1init"
  232.     CALL    INI2MEM        ; Init all memory from "init2" - "end2init"
  233.                 ; (also initializes "ptrtbl")
  234.  
  235.     LD    A,40        ; Init Console String Buffer
  236.     LD    (STRMAX),A    ;
  237.  
  238.      IF    USEBIOSCONOUT    ; Using faster BIOS rtn
  239.     LD    HL,(1)        ; BIOS + 3 warm start ep
  240.     LD    DE,9        ; Bias to BIOS conout jp
  241.     ADD    HL,DE
  242.     LD    (BIOSCONOUT),HL    ; Save adr for fast putc
  243.      ENDIF
  244.  
  245.     LD    HL,(@BUFFER)    ; **
  246.     LD    (BUFPTR),HL    ; Set buffer ptr
  247. ;..............................................................................
  248. ;
  249. ; Check for existence of BYE5.
  250. ; Note that "remote operation" is assumed if BYE is detected.
  251. ;
  252.     LD    C,SGUSER    ; BDOS set/get user call
  253.     LD    E,0FFH        ; First get current value
  254.     CALL    BDOSC1        ;
  255.     PUSH    AF        ; Save current value
  256.                 ;
  257.     LD    C,SGUSER    ; BDOS set/get user call
  258.     LD    E,241        ; Magic number to see if bye is resident
  259.     CALL    BDOSC1        ; Look for special result from "set/get" user
  260.     CP    77        ; Magic return # if BYE is there
  261.     JR    NZ,NOBYE    ; Nope..
  262.     LD    HL,-0800H    ; Flag "BYE5" as resident by puttin -800h here
  263.     LD    (BYE5FLAG),HL    ; (otherwise is zero from init above)
  264.                 ;
  265. NOBYE:    POP    AF        ; Get orig user # back
  266.     LD    C,SGUSER    ; BDOS set/get user call
  267.     LD    E,A        ; Put user# in E
  268.     CALL    BDOSC1        ;
  269.  
  270. ;..............................................................................
  271. ;
  272.     CALL    CHKSUMCCP    ; Do simple chksum of CCP for quit
  273.     LD    (CCPCHKSUM),A
  274.  
  275. ; Do all calculations relating to available Memory right here...
  276.  
  277.     LD    HL,(BDOSEV+1)    ; Get BDOS base
  278.     LD    DE,(BYE5FLAG)    ; (-2k) if CCP to be saved, else zero
  279.     ADD    HL,DE        ; Add, ie subtract, that
  280.     LD    (BDOSBASE),HL    ; Take future requests for (BDOS+1) from here
  281.  
  282. ; open the file if one given
  283. ; try open 1st with given name, then as .lbr
  284. ;................................
  285.                 ;
  286.     LD    HL,FCB1FN    ; See if command tail is blank
  287.     LD    A,'/'        ; Chk for help invocation
  288.     CP    (HL)        ;
  289.     JP    Z,USAGE        ;
  290.     LD    A,' '        ;
  291.     CP    (HL)        ;
  292.     JR    NZ,SOMETH    ; Br if something was specified
  293.     LD    B,11        ; Else convert to *.*
  294.                 ;
  295. QUESLP:    LD    (HL),'?'    ;
  296.     INC    HL        ;
  297.     DJNZ    QUESLP        ;
  298.     JR    SWPAMBIG    ; Go "sweep" all matching filenames
  299. ;...............................;
  300.  
  301. ; check if ambig file specified
  302.  
  303. SOMETH:    LD    BC,11        ; Length (HL already set)
  304.     LD    A,'?'        ; Find a ?
  305.     CPIR            ; Search
  306.     JR    Z,SWPAMBIG    ; If ambiguous, sweep 'em
  307.  
  308. ;..............................................................................
  309. ;
  310. OPENSOMEFILE:            ;
  311.     LD    HL,FCB1EXT
  312.     LD    D,H        ; DE=HL
  313.     LD    E,L
  314.     INC    DE        ; +1
  315.     LD    (HL),B
  316.     LD    BC,23        ; Zero rest of FCB1
  317.     LDIR
  318.  
  319.     LD    C,OPEN
  320.     CALL    BDOSCALL    ; Open file
  321.     JP    P,OPENOK    ; Open ok >= 0
  322.  
  323. ; Version 4.1 rewritten
  324. ; If file does not open "as-is", AND filetype is not blank,
  325. ; we don't fool with it at all.  If it IS blank, we try
  326. ; .LBR, .ARK, and .ARC in succession.
  327.  
  328.     LD    HL,FCB1TYP    ; point to typ
  329.     CALL    ILCMP        ; Is it all blank?
  330.     DB    '   ',0
  331.     JR    NZ,NONE        ; If not, give up
  332.  
  333.     CALL    OPENIT        ; Try LBR
  334.     DB    'LBR',1
  335.     CALL    OPENIT        ; Try ARK
  336.     DB    'ARK',2
  337.     CALL    OPENIT        ; Try ARC
  338.     DB    'ARC',2
  339.  
  340.     JR    NONE        ; Give up if all failed
  341.  
  342. OPENIT:    POP    HL        ; Src
  343.     LD    DE,FCB1TYP    ; Dst
  344.     LD    BC,3        ; Len
  345.     LDIR            ; Set filetype to try
  346.     LD    A,(HL)        ; Get 'library type' flag
  347.     LD    (LIBRARY),A    ; Store it
  348.     INC    HL
  349.     LD    C,OPEN
  350.     CALL    BDOSCALL    ; Try to open it
  351.     JP    P,OPENOK    ; Go if it succeeded
  352.     JP    (HL)        ; Otherwise return
  353.  
  354. ;..............................................................................
  355. ;
  356. ; The routines to handle ambigous file specifications follow (ie arrive
  357. ;  here if at least one ? in filename).
  358. ;
  359. ; Note: In this case an LBR will always be opened as a library.
  360. ;  In the less than likely event the user wants to examine the guts
  361. ;  of an LBR file, he may still do so by typing the full command line, eg.
  362. ;  "QL FILE.LBR" - but "QL FILE" or "QL *.LBR" or almost anything else
  363. ;  will treat LBR files as libraries).
  364.  
  365. ; We accumulate filenames at the start of the buffer, resetting BUFPTR
  366. ; and ask the user to choose one. After selection, we open the file as
  367. ; if it had been fully specified.
  368.  
  369. ; After the user is finished with the file (or entire library if an LBR),
  370. ; QLEXIT returns to QFCFIL, so he can examine another one.  The filenames
  371. ; are protected by the resetting of BUFPTR.
  372.  
  373. ; first preserve ambiguous filename
  374.  
  375. SWPAMBIG:
  376.     LD    DE,(BUFPTR)    ; Dest for fnames
  377.     LD    (FILPTR),DE    ; Save as start of fname table
  378.     LD    HL,FCB1FN    ; Src
  379.     LD    BC,11        ; Len
  380.     LDIR
  381.     PUSH    DE        ; Save ptr
  382.  
  383.     LD    DE,80H        ; Set default DMA
  384.     LD    C,SETDMA
  385.     CALL    BDOSC1
  386.  
  387.     LD    C,SRCH1ST    ; Search for first
  388.     CALL    BDOSCALL
  389.     INC    A
  390.     JR    NZ,SWP1        ; Go if a match found
  391.  
  392. ;...............................;
  393. ; No files found.
  394. ; Last ditch effort - check for core dump
  395. NONE:    CALL    WHLCHK        ; Core dump allowed?
  396.     JR    Z,NOTCORE    ; Nope, don't try
  397.     LD    HL,FCB1FN    ; QL CORE will give a core dump
  398.     CALL    ILCMP        ; Note: check only fn, because
  399.     DB    'CORE    ',0    ; - ext was prob munched
  400.     JP    Z,COREDM    ; Matched -- do a core dump
  401. NOTCORE:
  402.     CALL    MSG        ; Display error msg
  403.     DB    CR,LF,'++ No matching files found ++',CR,LF,0
  404.     JR    USAGE
  405. ;..............................................................................
  406. ;
  407. SWP1:    LD    IX,0        ; Matches
  408.     POP    DE        ; Dest for fnames
  409.  
  410. SWPLP:    DEC    A        ; Un-INC
  411.     ADD    A,A        ; A<<5
  412.     ADD    A,A
  413.     ADD    A,A
  414.     ADD    A,A
  415.     ADD    A,A
  416.     ADD    A,81H        ; +DMA points to fn
  417.     LD    L,A        ; Move to HL
  418.     LD    H,0
  419.  
  420. ;................................
  421.     CALL    WHLCHK        ; System security stuff
  422.     JR    NZ,SWPOK    ; If wheel is set, it's ok
  423.     PUSH    HL        ; Save ptr to fn start
  424.     LD    BC,9        ; Check SYS attr
  425.     ADD    HL,BC        ;
  426.     POP    BC        ; Temp save ptr in BC
  427.     BIT    7,(HL)        ;
  428.     JR    NZ,SWPNXT    ; If set, pretend it wasn't found
  429.     DEC    HL        ; Next check if online COM file
  430.     call    ilcmp        ; Service routine 
  431.     db    'COM',0        ; 
  432.     jr    Z,swpnxt    ; If matched, pretend it wasn't found
  433.  
  434. ;.....
  435. ;                ; File is good, use it
  436.     PUSH    BC        ; Move ptr from BC to HL
  437.     POP    HL        ;
  438. SWPOK:    LD    B,11        ; Chars in filename
  439.  
  440. LDIRLP:    LD    A,(HL)        ; Move it - strip any hi-bits
  441.     AND    7FH        ; (can't use LDIR, oh well...)
  442.     LD    (DE),A        ;
  443.     INC    HL        ;
  444.     INC    DE        ;
  445.     DJNZ    LDIRLP        ;
  446.  
  447.     INC    IX        ; Count it
  448. ;.....
  449. ;                ; File is not authorized, go onto next
  450. SWPNXT:    LD    C,SRCHNXT    ; Search for next
  451.     CALL    BDOSCALL
  452.     INC    A
  453.     JR    NZ,SWPLP    ; Go get it if it's there
  454.  
  455.     PUSH    IX        ; Get count in HL
  456.     POP    HL
  457.     LD    A,H        ; >255 files?
  458.     OR    A        ; Better be zero!
  459.     JP    Z,SWP2        ;
  460.  
  461.     CALL    MSG        ; Display error msg
  462.     DB    CR,LF,'++ Error: Too many matching files ++',0
  463. USAGE:    CALL    MSG
  464.     DB    CR,LF,LF,' Usage:  QL <afn>'
  465.     DB    CR,LF
  466.     DB    ' where <afn> should not match more than 255 files.',0
  467.     CALL    WHLCHK        ; Core dump allowed?
  468.     JP    Z,QLEXIT    ; Nope, don't let him know
  469.     CALL    MSG
  470.     DB    CR,LF,' Or:  QL CORE',TAB,'for a core dump.'
  471.     DB    CR,LF,LF,0
  472.     JP    QLEXIT        ; Exit
  473.  
  474. SWP2:
  475.     LD    A,L        ; Get file cnt
  476.     OR    A        ; Zero files?
  477.     JP    Z,NONE        ; Err msg & exit
  478.  
  479. ; If there was only one file, don't sweep
  480.  
  481.     CP    1        ; Only 1 file?
  482.     JR    NZ,QFCSET    ; Nope, there's more
  483.  
  484.     LD    HL,-11        ; Back up to the fn found
  485.     ADD    HL,DE
  486.     JR    OKSEL        ; And open the file
  487.  
  488. ; Set up parameters for QFC
  489.  
  490. QFCSET:
  491.     LD    A,0FFh        ; Yes, we are sweeping
  492.     LD    (SWEEPING),A
  493.     LD    (BUFPTR),DE    ; Protect filenames
  494.     LD    IX,FILPARM    ; Point to QFC parm block
  495.     LD    (IX+FNCNT),L    ; File count
  496.     LD    HL,(FILPTR)    ; Table of filenames
  497.     LD    DE,11        ; Table entry length
  498.     ADD    HL,DE        ; Point past ambig fname
  499.     LD    (IX+FNTBL),L    ; Table start
  500.     LD    (IX+FNTBL+1),H    ;
  501.     LD    (IX+ENTLEN),E    ; Entry length
  502.     LD    (IX+FNOFFS),0    ; Offset to filename
  503.     LD    (IX+FNPARS),0    ; don't request parsing
  504.     LD    (IX+FNSORT),255    ; do request sorting
  505.     LD    (IX+HEDRTN),DFNS-256*(DFNS/256)    ; Set header routine
  506.     LD    (IX+HEDRTN+1),DFNS/256        ;
  507. QFCFIL:
  508.     CALL    INI2MEM        ; Init 2nd mem area on every sweep
  509.     LD    IX,FILPARM    ; Point to QFC parm block
  510.     CALL    QFC        ; Let user select a file
  511.  
  512. ; v4.1: Moved a lot to QFC.LIB (Quick File Choose)
  513.  
  514.     JP    Z,QLOUT        ; Escape char
  515.     JR    C,QFCFIL    ; Unknown chars 
  516.     
  517. OKSEL:    LD    DE,FCB1FN    ; Move selection to FCB1
  518.     LD    BC,11
  519.     LDIR
  520.  
  521.     ld    hl,fcb1typ    ; point to fcb1typ
  522.     call    ilcmp        ; Service routine
  523.     db    'LBR',0        ; Is it an LBR?
  524.     jr    Z,dolbr        ; 
  525. ;;    call    ilcmp        ; 
  526. ;;    db    'ARK',0        ; Is it an ARK? [ not yet supported ]
  527. ;;      jr    Z,doarc        ; 
  528. ;;    call    ilcmp        ; 
  529. ;;    db    'ARC',0        ; Is it an ARC? [ditto]
  530. ;;    jr    Z,doarc        ; 
  531.     sub    a        ; Normal file
  532. dofile:    ld    (library),a    ; 
  533.     JP    opensomefile    ; 
  534.  
  535. dolbr:    ld    a,1        ; lbr file
  536.     jr    dofile        ; 
  537. doarc:    ld    a,2        ; arc file
  538.     jr    dofile        ; 
  539.  
  540. ;.....................................
  541. ;
  542. ; Display 'n files matching DU <afn>'
  543. ;                
  544. DFNS:    CALL    CLEARSCREEN    ;
  545.     CALL    CRLF        ;
  546.     CALL    ONHALF
  547.     LD    L,(IX+FNCNT)    ; Get # of files
  548.     LD    H,0        ;
  549.     CALL    B2DEC        ; Display it
  550.     CALL    MSG        ;
  551.     DB    ' files matching ',0
  552.     CALL    PRFDU        ; Print appropriate DU:
  553.     LD    HL,(FILPTR)    ; Start of table
  554.     CALL    PRNFN        ; Print ambig filespec
  555.     CALL    OFFHALF        ;
  556.     CALL    CRLF        ;
  557.     JP    CRLF        ; &ret
  558. ;=============================================================================
  559. ;
  560. ; Come here if a "core dump" was requested
  561. ;
  562. COREDM:    LD    A,0FFH        ; 0ffh
  563.     LD    (CORE),A    ; Set flag
  564.     LD    (HIPG),A    ;
  565.     LD    HL,0FFFFH    ; Of all of memory
  566.     LD    (EOFADR),HL
  567.     LD    (FILELEN),HL
  568.     XOR    A
  569.     LD    (PAGE),A    ; Set init pg 0
  570.     LD    (AFLAG),A    ; Allow hex/ascii disp only
  571.     LD    (LIBRARY),A    ; Not a library
  572.     CALL    TOGLA        ; (flip from 0 [ascii] to ff [hex])
  573.     LD    HL,(@PTRTBL)    ;
  574.     INC    HL        ;
  575.     XOR    A        ;
  576.     LD    B,A        ; 256 pgs
  577.  
  578. SETMEMPP:
  579.     LD    (HL),A
  580.     INC    A
  581.     INC    HL
  582.     INC    HL
  583.     DJNZ    SETMEMPP
  584.     JP    PRPG        ; Display hex/ascii of pg 0
  585.  
  586. ;=============================================================================
  587. ;
  588. ; compute simple 1 byte chksum of entire CCP
  589. ; ret in a
  590. ;
  591. CHKSUMCCP:
  592.     LD    HL,(6)
  593.     LD    DE,0-800h-6    ; Size of CCP
  594.     ADD    HL,DE        ; *CCP
  595.     LD    BC,800h        ; Chksum entire CCP
  596.  
  597. CHK1SUM:
  598.     ADD    A,(HL)
  599.     CPI            ; HL++,BC--
  600.     RET    PO        ; Chksum in A
  601.     JR    CHK1SUM
  602.  
  603. ILLEGAL:
  604.     CALL    MSG        ; Display error and exit
  605.     DB    CR,LF,'++ Can''t display that ++',CR,LF,0
  606.  
  607. QLEXIT:
  608.     LD    SP,STACK    ; Stack may be questionable upon arrival here
  609.  
  610.     LD    A,(PUTCABRT)    ; Did we abort from PUTC?
  611.     OR    A
  612.     JR    NZ,QLOUT    ; Yep, don't re-sweep
  613.  
  614.     LD    A,(SWEEPING)    ; If in sweep mode, return to sweeper
  615.     OR    A        ;
  616.     JP    NZ,QFCFIL
  617.  
  618. QLOUT:    CALL    CRLF
  619.  
  620.      IF    ZCPR3        ; For Z3:
  621.     CALL    GETVID        ; Restore video
  622.     CALL    NZ,DINIT    ; (if necessary)
  623.     CALL    GETUD        ; and return to starting DU:
  624.      ENDIF
  625.  
  626.      IF    ALWAYSBOOT    ; Don't check CCP
  627.     JP    0
  628.      ELSE
  629.     CALL    CHKSUMCCP
  630.     LD    B,A        ; Ccp chksum now
  631.     LD    A,(CCPCHKSUM)    ; Orig CCP chksum
  632.     XOR    B
  633.     JP    NZ,0        ; Warm boot if CCP was overlaid
  634.     LD    SP,(OLDSP)    ; Else just ret to CCP
  635.     RET
  636.      ENDIF
  637.  
  638. ;-----------------------------------------------------------------------------
  639. ;
  640. QUIT:
  641. QUITNOSUM:
  642.     LD    SP,STACK    ; Extracting may foul stack
  643.     LD    A,(LIBRARY)
  644.     OR    A        ; Ordinary file?
  645.     JR    Z,QLEXIT    ; Yes, so exit
  646.  
  647.     DEC    A        ; Lbr file?
  648.     JR    Z,QUITSTAY    ; Yes, so stay
  649.  
  650. ;;    DEC    A        ; Arc/ark file? [Not supported yet!]
  651. ;;    JR    Z,QUITSTAY    ; Yes, so stay
  652.     JR    QLEXIT        ; Otherwise (type error) exit
  653.  
  654. ; working with some collection: list all members and let user choose next
  655. ;
  656. QUITSTAY:
  657.     LD    HL,0
  658.     LD    (FCB1R0),HL    ; Set lbr rec 0
  659.     CALL    SEEK        ; Position to lbr tof and fall thru
  660.  
  661. ; System security related stuff
  662. ;
  663. OPENOK:    CALL    WHLCHK        ; If wheel is set, skip all this
  664.     JR    NZ,LEGAL    ;
  665.     LD    HL,FCB1TYP+1    ; Else check if file has SYS attribute
  666.     BIT    7,(HL)        ;
  667.     JP    NZ,NONE        ; If it does, pretend file doesn't exist
  668.                 ;
  669.     DEC    HL        ; More system security: no examing online
  670.                 ; COM files. if they're in a lbr, ok, else
  671.                 ; They should be named OBJ or CZM.
  672.     call    ilcmp        ; Service routine
  673.     db    'COM',0        ;
  674.     JP    Z,ILLEGAL    ;
  675.  
  676. LEGAL:    LD    A,(LIBRARY)    ; Access OK, continue
  677.     OR    A        ; flag==0?
  678.     JP    Z,CHKIFCOMPRESSED ; Ordinary file
  679.     DEC    A        ; flag==1?
  680.     JR    Z,OPENLBR    ; Lbr file
  681. ;;    DEC    A        ; flag==2? [Again, not yet supported]
  682. ;;    JP    Z,OPENARC    ; Arc file
  683. ; When (if!) more 'types' are supported, jumps to
  684. ; the appropriate service routines go here.
  685. ;------------------------------------------------
  686.  
  687. ; read 1st lbr directory sector to see how big lbr dir is
  688.  
  689. OPENLBR:
  690.     LD    DE,(BUFPTR)    ; Set dma to buffer
  691.     LD    HL,1
  692.     LD    (NSECTS),HL
  693.     CALL    READFILE
  694.     LD    A,(MTFLAG)    ; Zero if readfile read nothing
  695.     OR    A        ;
  696.     JP    Z,LBRERROR    ; We'll call an empty LBR file a library error
  697.     LD    IX,(BUFPTR)    ; Point to buffer
  698.     LD    L,(IX+14)    ; Dir sects low
  699.     LD    H,(IX+15)    ; Dir sects high
  700.     DEC    HL        ; We already read the 1st
  701.     LD    A,H
  702.     OR    L
  703.     JR    Z,PAKDIR    ; Lbr dir is only 1 sect long
  704.     LD    (NSECTS),HL
  705.     CALL    READFILE    ; Read the rest of the lbr dir
  706.     JP    Z,LBRERROR
  707.  
  708. ; v4.1: Remove the deleted members from memory
  709.  
  710. PAKDIR: EX    DE,HL
  711.     LD    (HL),0FFH    ; Add lbr dir eof
  712.     SUB    A        ; Count active members
  713.     LD    HL,(BUFPTR)    ; Start of directory
  714.     PUSH    HL
  715.     POP    DE        ; DE:=HL
  716.     LD    (HL),0FEh    ; Mark first entry as deleted!
  717.  
  718. LBRPACK:
  719.     PUSH    AF        ; Save
  720. LBRP0:    LD    BC,32        ; entry length
  721.     LD    A,(HL)        ; Entry type
  722.     INC    A        ; End of directory?
  723.     JR    Z,LBRP2        ; yes, we're done - all, exit loop
  724.     INC    A        ; Deleted member?
  725.     JR    Z,LBRP1        ; yes, remove it
  726.     LDIR            ; Copy into packed directory
  727.     POP    AF        ; Restore count
  728.     INC    A        ; Count it
  729.     JR    LBRPACK     ; Loop
  730.  
  731. LBRP1:    ADD    HL,BC        ; Point to next
  732.     JR    LBRP0
  733.  
  734. LBRP2:    POP    AF        ; Restore counter
  735.     LD    IX,LIBPARM    ; QFC parameter block
  736.     LD    (IX+FNCNT),A    ; Filename cnt
  737.     LD    (IX+FNOFFS),1    ; Offset to filename
  738.     LD    (IX+FNPARS),0    ; Don't parse
  739.     LD    (IX+FNSORT),255    ; Do sort
  740.     LD    (IX+ENTLEN),C    ; Entry length
  741.     LD    HL,(BUFPTR)    ; Start of table
  742.     LD    (IX+FNTBL),L    ;
  743.     LD    (IX+FNTBL+1),H    ;
  744.     LD    (IX+HEDRTN),PRMBRDIR-256*(PRMBRDIR/256) ; Set header routine
  745.     LD    (IX+HEDRTN+1),PRMBRDIR/256
  746. QFCLBR:
  747.     LD    IX,LIBPARM    ; QFC parameter block
  748.     CALL    QFC
  749.  
  750.     JP    Z,QLEXIT    ; 'exit' type char pressed
  751.     JP    NC,SELMEMB    ; Selection made
  752.     CALL    UCASE        ; Possibly upcase a character in A
  753.  
  754.     LD    B,A        ;
  755.     CALL    WHLCHK        ; Nothing else legal if wheel isn't set
  756.     LD    A,B        ;
  757.     JR    Z,QFCLBR    ;
  758.  
  759.     CP    'E'        ; Set extract mode?
  760.     JR    Z,EXTRMODE    ;
  761.     CP    'V'        ; Set view mode?
  762.     JR    NZ,QFCLBR    ; Try again
  763.  
  764.     XOR    A        ; Flag for view mode
  765.     JR    MODESET
  766. EXTRMODE:            ;
  767.     LD    A,1        ; Flag for extract mode
  768. MODESET:            ;
  769.     LD    (EXTRACTING),A    ; Set the mode
  770.                 ; Fall thru, redisplay w/ new prompt
  771.  
  772.     JR    QFCLBR        ; Quicker
  773. ;
  774. ;..................................
  775. ;
  776. ; Display 'n members in DU:lib.ext'
  777. ;
  778. PRMBRDIR:            ;
  779.     CALL    CLEARSCREEN    ;
  780.     CALL    ONHALF        ; Display header in dim video
  781.     CALL    CRLF        ;
  782.     LD    L,(IX+FNCNT)    ; Get # of entries
  783.     LD    H,0        ;
  784.     CALL    B2DEC        ; Print it
  785.     CALL    MSG        ;
  786.     DB    ' members in ',0;
  787.     CALL    PRNDFN        ; Print DU:<filename>
  788.     CALL    CRLF        ;
  789.                 ;
  790.     LD    A,(EXTRACTING)    ; Check flag
  791.     OR    A        ;
  792.     JR    Z,VIEWMSG    ; View mode
  793.                 ;
  794.     CALL    MSG        ; Extract mode
  795.     DB    '[Extract to ',0
  796.     CALL    PRDDU        ; Print default DU:
  797.     CALL    MSG        ;
  798.     DB    ' -- Type V for view mode]',0
  799.     CALL    OFFHALF        ; Turn off dim video
  800.     JP    CRLF        ; &ret 
  801.                 ;
  802. VIEWMSG:            ;
  803.     CALL    MSG        ;
  804.     DB    '[View',0    ;
  805.     CALL    WHLCHK        ; Instructions to extract
  806.     JR    Z,VIEW1MSG    ; Only if authorized 
  807.     CALL    MSG
  808.     DB    ' -- Type E for extract mode',0
  809.  
  810. VIEW1MSG:
  811.     LD    A,']'        ; Finish msg
  812.     CALL    PUTC
  813.     CALL    OFFHALF        ; Turn off dimvid
  814.     JP    CRLF        ; &ret
  815. ;.....................................
  816. ;
  817. ; Print filename "C", pointed to by HL
  818. ;
  819. PRNUMFN:            ;
  820.     PUSH    BC        ;
  821.     PUSH    DE        ;
  822.     PUSH    HL        ;
  823.     CALL    CKABRT        ; Chk for abort 1/filename
  824.                 ; - (fixes stack and exits direct if requested)
  825.     PUSH    BC        ; Save everything ("chktyp" destroys)
  826.     PUSH    DE        ;
  827.     PUSH    HL        ;
  828.     LD    DE,8        ; Set de to point to the filename typ (hl+8)
  829.     ADD    HL,DE        ;
  830.     EX    DE,HL        ;
  831.     CALL    OFFHALF        ; Force full intensity NOW   
  832.     CALL    CHKTYP        ; Check if filename typ is COM, REL, etc.
  833.     CALL    C,ONHALF    ; If so, use half-intensity
  834.  
  835.     POP    HL        ;
  836.     POP    DE        ;
  837.     POP    BC        ;
  838.  
  839.     PUSH    BC        ;
  840.     PUSH    DE        ; Save everything("B2DEC" destroys)
  841.     PUSH    HL        ;
  842.     LD    A,C        
  843.     CP    100        ;
  844.     CALL    C,SPACE        ;
  845.     LD    A,C        ; ("b2dec" left justifies)
  846.     CP    10        ;
  847.     CALL    C,SPACE        ;
  848.     LD    L,C        ; Get member's #, still in C
  849.     LD    H,0        ; Put it in HL
  850.     CALL    B2DEC        ; Display it
  851.     CALL    MSG        ;
  852.     DB    '. ',0
  853.     POP    HL        ;
  854.     POP    DE        ; Restore registers
  855.     POP    BC        ;
  856.  
  857.     CALL    PRNFN        ; Type the file name pointed to by HL
  858.     CALL    OFFHALF
  859.     CALL    MSG        ; Type the fence
  860.     DB    ' |',0
  861.  
  862.     POP    HL        ;
  863.     POP    DE        ;
  864.     POP    BC        ;
  865.     RET            ; End of PRNUMFN: subr
  866. ;...............................;
  867.  
  868. ;................................
  869.                 ; Subr to type filename pointed to by HL
  870.                 ;
  871. PRNFN:    LD    A,(CORE)    ; A core dump never has a filename
  872.     OR    A        ;
  873.     RET    NZ        ; So forget about it
  874.                 ;
  875.     LD    B,8        ; Display first 8 chars in fn
  876.                 ;
  877. PRNXT:    LD    A,(HL)        ; Get char of member name
  878.     INC    HL        ; *char++
  879.     AND    7FH        ; (make sure 'dcase' works right)
  880.                 ;
  881.      IF    LOWERCASE    ;
  882.     CALL    DCASE        ; "downcase" the character
  883.      ENDIF            ; Lowercase
  884.                 ;
  885.     CALL    PUTC        ; Print it
  886.     DJNZ    PRNXT        ; Loop 8 times
  887.                 ;
  888.     LD    A,'.'        ; Now display a "."
  889.     CALL    PUTC        ;
  890.                 ;
  891.     LD    B,3        ; Same as above 3 more times for typ
  892.                 ;
  893. PRNXT2:    LD    A,(HL)        ;
  894.     INC    HL        ;
  895.     AND    7FH        ;
  896.                 ;
  897.      IF    LOWERCASE    ;
  898.     CALL    DCASE        ; "downcase" the character
  899.      ENDIF            ; Lowercase
  900.                 ;
  901.     CALL    PUTC        ;
  902.     DJNZ    PRNXT2        ; Loop 3 times
  903.     RET            ;
  904. ;...............................;
  905.  
  906. ;................................
  907.                 ;
  908. PRFDU:    LD    HL,(LBRDU)    ; Type the filename's (FCB1's) DU:
  909.     JR    PDU        ;
  910.                 ;
  911. PRDDU:    LD    HL,(DEFDU)    ; Type the originally logged (default) DU
  912.                 ;
  913. PDU:    LD    A,'A'        ;
  914.     ADD    A,H        ; Convert that to ascii
  915.     CALL    PUTC        ; And display it
  916.     LD    H,0        ; User# already in "L", so just zero H
  917.     CALL    B2DEC        ; Print the user#
  918.     LD    A,':'        ;
  919.     CALL    PUTC        ; Print a colon
  920.     RET            ;
  921. ;...............................;
  922.  
  923. ;................................
  924.                 ; Print DU:<filename> for the FCB1 filename
  925. PRNDFN:    CALL    PRFDU        ; Print DU:
  926.     LD    HL,FCB1+1    ; Point to filename
  927.     CALL    PRNFN        ; Print it and return
  928.     RET            ;
  929. ;...............................;
  930.  
  931.  
  932. ;................................
  933.                 ;
  934. CHEXIT:    CP    CTRLC        ; ^C or ^K exit right to CP/M
  935.     JP    Z,SYSTEM    ; (stack gets fixed)
  936.     CP    CTRLK        ;
  937.     JP    Z,SYSTEM    ;
  938.                 ;
  939.     CP    'X'        ; Other exit chars rtn w/ zero stat
  940.     RET    Z        ;
  941.     CP    'Q'        ;
  942.     RET    Z        ;
  943.     CP    ESC        ;
  944.     RET    Z        ;
  945.     CP    CTRLX        ;
  946.     RET    Z        ;
  947.     CP    CR        ;
  948.     RET            ;
  949. ;...............................;
  950.  
  951. ;=============================================================================
  952.  
  953. ; Here we prepare to extract (and possibly decompress) to disk.
  954. ; Most of the work is done by the routines for ordinary reading, with
  955. ; the few differences being invoked by the setting of the EXTRACTING flag.
  956. ;
  957. EXTCHK:    LD    A,(EXTRACTING)    ; Return Z flag for EXTRACTING
  958.     OR    A
  959.     RET
  960.  
  961. EXTRDONE:
  962. ; When we get here, all except last (partial) buffer has been written
  963. ; *(DE-1) is last addr used.
  964.     LD    A,127        ; Include last sector
  965.     ADD    A,E
  966.     LD    E,A
  967.     LD    A,D
  968.     ADC    A,0
  969.     LD    D,A
  970.     CALL    OUTFLUSH    ; Write the last buffer
  971.     LD    C,CLOSE        ; Close the file
  972.     LD    DE,FCB3
  973.     CALL    BDOSC1
  974.  
  975.      IF    ZCPR3
  976.     LD    BC,(LBRDU)    ;
  977.     CALL    LOGUD        ;
  978.      ENDIF            ; ZCPR3
  979.  
  980.     LD    HL,(FLSECTS)    ;
  981.     PUSH    HL
  982.     CALL    MSG
  983.     DB    CR,LF,'Wrote ',0
  984.     CALL    B2DEC        ; Print # of sectors
  985.     CALL    MSG
  986.     DB    ' sectors (',0
  987.     POP    HL        ; = # sectors
  988.     XOR    A        ; Clear carry & byte
  989.     LD    B,3
  990. ROLP:    RR    H        ; Divide by 8 & keep frac
  991.     RR    L
  992.     RR    A
  993.     DJNZ    ROLP
  994.     OR    A        ; Any fraction?
  995.     JR    Z,NOFRAC
  996.     INC    HL        ; Yep, count as 1K
  997. NOFRAC:    CALL    B2DEC        ; Print # of K
  998.     CALL    MSG
  999.     DB    'K)',CR,LF,0
  1000.  
  1001. logbkd:
  1002.     CALL    DELAY8
  1003.  
  1004. logbak:
  1005.      IF    ZCPR3
  1006.     LD    BC,(LBRDU)    ; Log back to the input DU
  1007.     CALL    LOGUD        ;
  1008.      ENDIF            ; ZCPR3
  1009.  
  1010.     JP    QUITNOSUM    ; Display lbr dir again
  1011. ;...............................;
  1012. ; v4.1: All filename parsing removed to PARSFN in QFC.LIB
  1013. EXTCRFILE:
  1014.     LD    HL,FCB3+17    ; UNCR/UNSQ stufgfed FN here
  1015.     CALL    PARSFN        ; Parse it into FCB3+1 AND FBC3+17
  1016.     JR    EXTFIL        ; Continue
  1017.  
  1018. EXTUCFILE: LD    HL,MEMBER    ; Point to member fn
  1019.     LD    DE,FCB3+1    ; Point to disk fcb
  1020.     LD    BC,11
  1021.     LDIR
  1022.  
  1023. EXTFIL:    LD    HL,FCB3+12    ; Gotta zero rest of fcb3
  1024.     LD    DE,FCB3+13
  1025.     LD    (HL),0
  1026.     LD    BC,20
  1027.     LDIR
  1028.     LD    (FLSECTS),BC    ; Reset the sectors-written counter
  1029.  
  1030.      IF    ZCPR3
  1031.     CALL    GETUD        ;
  1032.      ENDIF            ; ZCPR3
  1033.  
  1034.     LD    C,OPEN        ; Attempt to open file
  1035.     LD    DE,FCB3
  1036.     CALL    BDOSC1
  1037.     INC    A        ; Success means it already exists
  1038.     JR    Z,LEXT4
  1039.  
  1040.     CALL    MSG
  1041.     DB    CR,LF,LF,' ==> File exists; purge (y/N)? ',0
  1042.     CALL    GETCHR
  1043.     AND    1FH        ; Y, y, or ^Y OK
  1044.     CP    19H
  1045.     PUSH    AF        ; ***
  1046.     CALL    CRLF
  1047.     POP    AF        ; ***
  1048. ;;    JP    NZ,QUITNOSUM    ; Abort if he said no
  1049.     jp    nz,logbak
  1050.  
  1051.     LD    C,ERASE        ; Erase if he said yes
  1052.     LD    DE,FCB3
  1053.     CALL    BDOSC1
  1054.  
  1055. LEXT4:    LD    C,CREAT        ; Create the file
  1056.     LD    DE,FCB3
  1057.     CALL    BDOSC1
  1058.     RET    P        ; If it succeeded go back to reading-in code
  1059.  
  1060.     CALL    MSG
  1061.     DB    ' ++ Directory full ++ ',CR,LF,0
  1062. ;;LWAIT0:    CALL    DELAY8
  1063. ;;    JP    QUITNOSUM
  1064.     jp    logbkd
  1065.  
  1066. ; Buffer flush failed; disk is full.
  1067. NOSPACE:
  1068.     CALL    MSG
  1069.     DB    ' ++ Disk Full ++',CR,LF,0
  1070.     LD    C,ERASE        ; Erase the file
  1071.     LD    DE,FCB3
  1072.     CALL    BDOSC1
  1073. ;;    JR    LWAIT0
  1074.     jp    logbkd
  1075.  
  1076. ;...............................;
  1077. ; Library member selected.
  1078.  
  1079. SELMEMB:
  1080.     INC    HL        ; Point to entry fn (QFC set HL=*entry)
  1081.     LD    DE,MEMBER    ; Move member filename to member str
  1082.     LD    BC,11        ; (QFC set HL for us)
  1083.     LDIR
  1084.  
  1085.     LD    E,(HL)        ; HL = *member start
  1086.     INC    HL
  1087.     LD    D,(HL)        ; DE = starting sect of member
  1088.     LD    (FCB1R0),DE    ; Fill in lbr r0,r1 fld for seek to member
  1089.     INC    HL        ; HL = *member len
  1090.     LD    E,(HL)
  1091.     INC    HL
  1092.     LD    D,(HL)        ; DE = len in sects to read after seek
  1093.     LD    (NSECTS),DE
  1094.  
  1095. ; chk for zero len, maybe a lbr date file
  1096.  
  1097.     LD    A,D
  1098.     OR    E
  1099.     JP    Z,MT        ; If member is empty (zero-length)
  1100.  
  1101. ; position to member within lbr at fcb1r0
  1102.  
  1103. SEEKMEMBER:
  1104.     CALL    SEEK
  1105.     JP    CHKIFCOMPRESSED
  1106.  
  1107. ; assumes fcb1r0 is set to rec to seek to
  1108. ; set fcb1 r2 fld to 0
  1109.  
  1110. SEEK:    XOR    A
  1111.     LD    (FCB1R2),A    ; 0 lbr r2 fld
  1112.     LD    C,RANDOM
  1113.     CALL    BDOSCALL
  1114.     RET    Z        ; Seek ok
  1115.     POP    HL        ; Destroy ret adr
  1116.  
  1117. LBRERROR:
  1118.     CALL    MSG
  1119.     DB    'LBR read error',0
  1120.     CALL    DELAY8
  1121.     JP    QLEXIT
  1122. ;.....
  1123. ;
  1124. SUMMARY:
  1125.     CALL    ONHALF        ; Dim video
  1126.  
  1127.     CALL    MSG        ;
  1128.     DB    CR,LF,'  File: ',0 ;
  1129.     CALL    PRNDFN        ; Print DU:<filename>
  1130.     CALL    CRLF
  1131.  
  1132.     LD    A,(LIBRARY)    ; Some kind of collection?
  1133.     OR    A        ;
  1134.     JR    Z,NLBR2        ;
  1135.     CALL    MSG        ;
  1136.     DB    'Member: ',0    ;
  1137.     LD    HL,MEMBER    ;
  1138.     CALL    PRNFN        ;
  1139.     CALL    CRLF        ;
  1140.  
  1141. NLBR2:    LD    A,(INCOMPLETE)    ; Was read complete?
  1142.     OR    A
  1143.     JR    Z,DOSUMMARY    ; If so, we know file size
  1144.  
  1145. WARNING:
  1146.     CALL    MSG
  1147.     DB    CR,LF,'( ** Entire file does NOT FIT in Memory ** )',0
  1148.     CALL    OFFHALF
  1149.     RET
  1150.  
  1151. ; report file size
  1152.  
  1153. DOSUMMARY:
  1154.     CALL    MSG        ;
  1155.     DB    '  Size: ',0    ;
  1156.     LD    HL,(FILELEN)    ; In bytes
  1157.     PUSH    HL
  1158.     CALL    B2DEC
  1159.     CALL    MSG
  1160.     DB    ' bytes (',0
  1161.  
  1162.     POP    HL        ; HL = filelen
  1163.     SRL    H
  1164.     SRL    H        ; Shift to kilobytes
  1165.     INC    H        ; For overflow lsb
  1166.     LD    L,H
  1167.     LD    H,0
  1168.     CALL    B2DEC
  1169.     CALL    MSG
  1170.     DB    'k)',CR,LF,0
  1171.  
  1172. ; skip line count for non-text files
  1173.  
  1174.     LD    A,(AFLAG)
  1175.     OR    A
  1176.     JR    NZ,RETSUM    ; &ret, no line summary
  1177.  
  1178.     CALL    MSG
  1179.     DB    'Approx: ',0
  1180.     LD    A,(HIPG)
  1181.     DEC    A        ; Don't count last pg lines yet
  1182.     LD    B,A
  1183.     LD    HL,0
  1184.     JR    Z,ONLY1PG    ; Only 1 pg, nothing to add
  1185.     LD    A,(DISPLAY)    ; Actual lines per pg
  1186.     LD    E,A
  1187.     LD    D,L
  1188.  
  1189. CNTLINES:
  1190.     ADD    HL,DE
  1191.     DJNZ    CNTLINES
  1192.  
  1193. ONLY1PG:
  1194.     LD    A,(LASTPGLINES)
  1195.     LD    E,A
  1196.     LD    D,0
  1197.     ADD    HL,DE        ; Add in last pg lines
  1198.     CALL    B2DEC
  1199.     CALL    MSG
  1200.     DB    ' lines, ',0
  1201.  
  1202. ; added word counting code
  1203. ; words are any seq of chars >= '0' (30h) and < 80h
  1204. ; handle ws doc by ascii mask
  1205.  
  1206. ; count space between words
  1207.  
  1208.     LD    HL,(BUFPTR)
  1209.     LD    D,FALSE        ; Inword = false
  1210.  
  1211. ; reg E is temp storage for curr ch
  1212.  
  1213.     LD    IX,0        ; Word count
  1214.     LD    BC,(FILELEN)    ; Get actual file len
  1215.  
  1216. CNT:    LD    E,(HL)        ; Save ch
  1217.     INC    HL
  1218.     DEC    BC
  1219.     LD    A,B
  1220.     OR    C
  1221.     JR    Z,CNTALLDONE
  1222.     LD    A,E        ; Get ch
  1223.     AND    7FH        ; Mask to ascii
  1224.     CP    '0'        ; Cy if < '0'
  1225.     JR    C,ISWHITESP
  1226.  
  1227. ; ch is valid in word
  1228.  
  1229.     XOR    A        ; False
  1230.     OR    D        ; Inword == false?
  1231.     JR    NZ,CNT        ; No
  1232.     LD    D,0FFH        ; In a word now
  1233.     INC    IX        ; Word count++
  1234.     JR    CNT
  1235.  
  1236. ISWHITESP:
  1237.     LD    D,FALSE        ; Inword = false
  1238.     JR    CNT
  1239.  
  1240. CNTALLDONE:
  1241.     PUSH    IX
  1242.     POP    HL
  1243.     CALL    B2DEC
  1244.     CALL    MSG
  1245.     DB    ' words.',CR,LF,0
  1246.  
  1247. RETSUM:    CALL    OFFHALF
  1248.     RET            ; End summary
  1249.  
  1250. ;------------------------------------------------------------------------------
  1251. ;
  1252. ; may be compressed by squeezing or crunching
  1253. ;
  1254. CHKIFCOMPRESSED:
  1255.     XOR    A
  1256.     LD    (INCOMPLETE),A    ; Set read not incomplete yet
  1257.  
  1258.     LD    A,(LIBRARY)
  1259.     OR    A        ; Working fr lbr?
  1260.     LD    A,(FCB1TYP+1)    ; Chk 2nd letter of file typ
  1261.     JR    Z,ISITQZ    ; If not lbr
  1262.     LD    A,(MEMBER+9)    ; Else, 2nd letter of member typ
  1263.  
  1264. ISITQZ:    CP    'Q'
  1265.     JP    Z,SQUEEZED
  1266.  
  1267. ; chk for crunched file
  1268.  
  1269.     CP    'Z'
  1270.     JP    Z,CRUNCHED
  1271.  
  1272. ; else it's a normal uncompressed file
  1273. ; we also come back here for *.azm files after uncr fails
  1274.  
  1275. NORMAL:
  1276.     CALL    CRLF
  1277. NORML2:    CALL    EXTCHK        ; If extracting, handle files here
  1278.     CALL    NZ,EXTUCFILE    ; (the UnCompressed file routine)
  1279.     LD    DE,(BUFPTR)    ; Read into buffer til eof or mem full
  1280.     LD    HL,MEMBER    ; Print member filename in msg
  1281.     LD    A,(LIBRARY)
  1282.     OR    A
  1283.     JR    NZ,NRMLBR    ; Nsects already set for lbr member
  1284.     LD    HL,512        ; Force read to eof or up to BDOS
  1285.     LD    (NSECTS),HL
  1286.     LD    HL,FCB1FN    ; Print main filename in msg
  1287.  
  1288. NRMLBR:    CALL    MSG
  1289.     DB    CR,'Reading: ',0 ; (extra CR in case of overwrite)
  1290.     CALL    PRNFN        ; v4.1 say what we're reading
  1291.     CALL    READFILE
  1292.     JP    Z,TOOLARGE    ; Set incomplete read flag
  1293.     LD    A,(MTFLAG)    ; Else check if ANYTHING was read
  1294.     OR    A        ;
  1295.     JP    NZ,FINDEOF    ; If so, ok
  1296.  
  1297. MT:    CALL    MSG        ; Else complain
  1298.     DB    CR,LF,'===> File Empty.',CR,LF,0
  1299.     CALL    DELAY8        ;
  1300.     JP    QUITNOSUM    ;
  1301.  
  1302. ; rewritten for clarity?
  1303. ; DE should pt to 1st dma adr on entry
  1304. ; DE pts to last dma adr used on exit
  1305. ; seq read of uncompressed file or lbr member or lbr dir into buffer
  1306. ; reads entire file (up to BDOS) or nsects of a lbr dir or member
  1307. ; nsects should be set for max sects to read
  1308. ; NZ if read ok
  1309. ; Z  if too large for mem
  1310.  
  1311. READFILE:
  1312.     XOR    A        ; If subr returns w/ mtflag=0, nothing was read
  1313.     LD    (MTFLAG),A
  1314.  
  1315. REEDFILP:
  1316.     LD    C,SETDMA
  1317.     CALL    BDOSC1
  1318.     LD    C,READSEQ
  1319.     CALL    BDOSCALL
  1320.     RET    NZ        ; Read to eof ok
  1321.  
  1322.     LD    A,0FFH        ; If at least 1 sec read, set this flag
  1323.     LD    (MTFLAG),A    ;
  1324.  
  1325. ; pt to start of next dma
  1326.  
  1327.     LD    HL,128
  1328.     ADD    HL,DE        ; Dma += 128
  1329.     EX    DE,HL        ; DE=next dma adr
  1330.  
  1331. ; chk next dma adr < BDOS
  1332.  
  1333.     LD    A,(BDOSBASE+1)    ; [possibly adjusted] BDOS hi adr
  1334.     DEC    A        ; 256 byte BDOS safety cushion
  1335.     CP    D        ; Curr hi dma adr
  1336.     JR    NZ,OKNEXT    ; File about to crash into BDOS
  1337.  
  1338.     CALL    EXTCHK
  1339.     RET    Z        ; Nope, give up
  1340.  
  1341.     LD    DE,BDOSBASE    ; Pass end-of-buffer addr
  1342.     CALL    OUTFLUSH    ; Flush the buffer
  1343.                 ; On return, DE points to start of buffer again
  1344.  
  1345. ; chk if spec # of sects read
  1346.  
  1347. OKNEXT:    LD    HL,(NSECTS)
  1348.     DEC    HL        ; Nsects--
  1349.     LD    (NSECTS),HL
  1350.     LD    A,H
  1351.     OR    L        ; Spec # of sects read?
  1352.     JR    NZ,REEDFILP    ; No
  1353.  
  1354.     INC    A        ; Set nz for nsects read ok
  1355.     RET
  1356.  
  1357. ; C and DE must both be set for call
  1358. ; saves & restores BC,DE,HL,IX,IY
  1359. ; Z set if a = 0, M set if a < 0
  1360. BDOSC1:    PUSH    BC
  1361.     PUSH    DE
  1362.     PUSH    HL
  1363.     PUSH    IX
  1364.     PUSH    IY
  1365.     JR    DEISSET
  1366.  
  1367. ; C must be set for correct BDOS fn on fcb1
  1368. ; saves & restores all regs except af which has ret code
  1369. ; set z if a = 0
  1370.  
  1371. BDOSCALL:
  1372.     PUSH    BC
  1373.     PUSH    DE
  1374.     PUSH    HL
  1375.     PUSH    IX
  1376.     PUSH    IY
  1377.  
  1378.     LD    DE,FCB1        ; Set FCB1
  1379.  
  1380. DEISSET:
  1381.     CALL    BDOSEV
  1382.  
  1383. BDOSRET:
  1384.     OR    A        ; Set Z & sign flags
  1385.     POP    IY
  1386.     POP    IX
  1387.     POP    HL
  1388.     POP    DE
  1389.     POP    BC
  1390.     RET
  1391.  
  1392. ; unsqueezing code setup
  1393.  
  1394. SQUEEZED:
  1395.     LD    HL,(BDOSBASE)    ; [possibly adjusted] BDOS addr
  1396.     LD    (WORKAREA),HL    ; Workarea is all mem up to BDOS for unsq
  1397.  
  1398.     LD    HL,STACK
  1399.     LD    (SPSAVE),HL    ; Set default stk if too large
  1400.  
  1401. ; set *sq and *unsq
  1402.  
  1403.     LD    HL,100H        ; Src ptr for getbyt, forcing read
  1404.     LD    DE,(BUFPTR)    ; Dst ptr for out
  1405.  
  1406.     LD    (UNCRSRC),HL
  1407.     LD    (UNCRDST),DE
  1408.  
  1409.     CALL    MSG
  1410.     DB    CR,LF,LF,'Unsqueezing: ',0
  1411.  
  1412.     CALL    GETBYT
  1413.     CP    76H        ; Compressed file marker (halt inst)
  1414.     JP    NZ,NOTCOMPRESSED
  1415.  
  1416.     CALL    GETBYT
  1417.     CP    0FFH        ; Squeezed file marker
  1418.     JP    NZ,NOTCOMPRESSED
  1419.  
  1420.     CALL    GETBYT
  1421.     CALL    GETBYT        ; Skip 2 chksum bytes
  1422.  
  1423.     LD    DE,FCB3+17    ; Place to put unsqueezed fn
  1424.  
  1425. ; print the unsqueezed file name
  1426.  
  1427. NXTSQFNCHAR:
  1428.     CALL    GETBYT
  1429.  
  1430.     LD    (DE),A        ; Save in find string area
  1431.     INC    DE
  1432.  
  1433.     OR    A        ; '\0' $ term?
  1434.     JR    Z,SQFNDONE
  1435.     CALL    PUTC
  1436.     JR    NXTSQFNCHAR
  1437.  
  1438. SQFNDONE:
  1439.     CALL    EXTCHK        ; If we're extracting, time to open the file
  1440.     CALL    NZ,EXTCRFILE    ; (the CompRessed file routine)
  1441.  
  1442.     CALL    GETBYT        ; Get # of 4 byte transl pairs
  1443.     LD    L,A
  1444.     CALL    GETBYT
  1445.     LD    H,A
  1446.  
  1447. ; times 4 for number of bytes in transl tbl
  1448.  
  1449.     ADD    HL,HL
  1450.     ADD    HL,HL
  1451.     LD    B,H
  1452.     LD    C,L
  1453.  
  1454. ; copy unsq transl tbl over ptrtbl temporarily
  1455.  
  1456.     LD    HL,(@PTRTBL)    ;
  1457.  
  1458. COPYUNSQTT:
  1459.     CALL    GETBYT
  1460.     LD    (HL),A        ; Store into tt
  1461.     INC    HL
  1462.     DEC    BC        ; Ctr--
  1463.     LD    A,B
  1464.     OR    C
  1465.     JR    NZ,COPYUNSQTT
  1466.  
  1467.     LD    B,0        ; Init bit ctr
  1468.  
  1469. ; drive the unsqueezer
  1470.  
  1471. UNSQNEXT:
  1472.     CALL    UNSQ        ; Unsq 1 char
  1473.     JR    C,UNSQDONE    ; Eof
  1474.     CP    90H        ; Repeat count follows
  1475.     JR    Z,REPCHAR    ; Don't save 90h repeat ch
  1476.     LD    (LASTUNSQCH),A    ; Save in case of repeat count
  1477.     CALL    OUT        ; Put unsq char into buffer
  1478.     JR    UNSQNEXT
  1479.  
  1480. REPCHAR:
  1481.     CALL    UNSQ        ; Get repeat count
  1482.     JR    C,UNSQDONE    ; Eof
  1483.     OR    A        ; 0 cnt?
  1484.     JR    Z,SEND90H    ; Then send real 90h
  1485.     PUSH    BC        ; Save bit ctr B
  1486.     LD    B,A        ; Repeat ctr
  1487.     DEC    B        ; Actual cnt is 1 less
  1488.     JR    Z,UNSQNEXT
  1489.     LD    A,(LASTUNSQCH)
  1490.  
  1491. REPLOOP:
  1492.     PUSH    AF
  1493.     CALL    OUT        ; Out last ch B times
  1494.     POP    AF
  1495.     DJNZ    REPLOOP
  1496.     POP    BC        ; Rst bit ctr B
  1497.     JR    UNSQNEXT
  1498.  
  1499. SEND90H:
  1500.     LD    A,90H
  1501.     CALL    OUT
  1502.     JR    UNSQNEXT
  1503.  
  1504. UNSQDONE:
  1505.     CALL    OUT        ; Save eof marker
  1506.     LD    HL,(UNCRSRC)
  1507.     LD    DE,(UNCRDST)
  1508.     JP    FINDEOF
  1509.  
  1510. ; B = bitstogo mod 8 ctr
  1511. ; C = curr sq ch, maybe partially shifted
  1512. ; DE = curr transl tbl incr
  1513. ; HL = *sq transl tbl
  1514.  
  1515. UNSQ:    LD    DE,0        ; DE=curr tbl incr
  1516.     XOR    A
  1517.     OR    B        ; Chk bits to go = 0
  1518.     JR    NZ,NEWINDEX    ; Nz is sq char in progress
  1519.  
  1520. ; else start with a new sq char
  1521.  
  1522. NXTSQCHAR:
  1523.     CALL    GETBYT        ; Fetch a sq char
  1524.     LD    C,A        ; Save in C
  1525.     LD    B,8        ; 8 bits per char shift ctr
  1526.  
  1527. ; this code is from lt18 unsqueezer
  1528.  
  1529. NEWINDEX:
  1530.     LD    HL,(@PTRTBL)    ;
  1531.  
  1532. ; mult curr incr in DE by 4 by repeated adding
  1533.  
  1534.     ADD    HL,DE
  1535.     ADD    HL,DE
  1536.     ADD    HL,DE
  1537.     ADD    HL,DE
  1538.  
  1539. ; shift out lsb of sq char & chk it
  1540.  
  1541.     LD    A,C        ; Get sq char back
  1542.     SRL    A        ; Shift bit 0 into cy
  1543.     LD    C,A        ; Save sq ch again
  1544.     JR    NC,NOTSET    ; Use odd pair
  1545.     INC    HL        ; To even pair if bit was set in sq char
  1546.     INC    HL
  1547.  
  1548. NOTSET:    LD    E,(HL)        ; New incr for DE if not transl
  1549.     INC    HL
  1550.     LD    D,(HL)        ; > 7fh if valid transl
  1551.     BIT    7,D        ; Bit 7 set if valid
  1552.     JR    Z,NOTTRANSL    ; Hi bit not set: E is not a transl
  1553.  
  1554.     DEC    B        ; Bit ctr--
  1555.     LD    A,0FEH        ; End of transl tbl
  1556.     CP    D        ; Set z flag if eof
  1557.     LD    A,1AH        ; Get eof marker
  1558.     SCF            ; Mark this as the eof return
  1559.     RET    Z        ; Since 1ah could be repeat count
  1560.  
  1561.     LD    A,E        ; Else get char transl
  1562.     CCF            ; No carry if not eof
  1563.     CPL            ; Extract char by inversion
  1564.     RET            ; Ret the unsq ch
  1565.  
  1566. NOTTRANSL:
  1567.     DJNZ    NEWINDEX
  1568.     JR    NXTSQCHAR
  1569.  
  1570. ; uncrunching i/o code
  1571.  
  1572. CRUNCHED:
  1573.     CALL    MSG
  1574.     DB    CR,LF,LF,'Uncrunching: ',0
  1575.     LD    HL,100H        ; Src ptr for getbyt, dummy end of sect
  1576.     LD    DE,(BUFPTR)    ; Dst ptr for out
  1577.     LD    (UNCRSRC),HL
  1578.     LD    (UNCRDST),DE
  1579.  
  1580. ; chk to see if header is correct for crunched file
  1581. ; we do this here in order to abort gracefully if it's an uncrunched .azm file
  1582.  
  1583.     CALL    GETBYT
  1584.     CP    76H
  1585.     JR    NZ,NOTCOMPRESSED
  1586.     CALL    GETBYT
  1587.     CP    0FEH
  1588.     JR    NZ,NOTCOMPRESSED
  1589.  
  1590. ; crunched header ok
  1591. ; now output the file name
  1592. ;
  1593. ; Do not print data which may be after end of filename, but before the
  1594. ; zero (system dependent data allowed here; CR23d uses this). We will
  1595. ; print the chars if they are between "[" and "]", however.
  1596. ;
  1597.     LD    B,12        ; Loop limit for 11 chars plus "."
  1598.     LD    DE,FCB3+17    ; Place to put uncrunched filename
  1599.  
  1600. SAYLP:    CALL    GETBYT        ; Next filename char
  1601.  
  1602.     LD    (DE),A        ; Save fn for extracting
  1603.     INC    DE
  1604.  
  1605.     CP    '.'        ; Dot?
  1606.     JR    NZ,NOTDOT    ; If not
  1607.     LD    B,4        ; If we hit the dot, only 4 (dot+3) chars left
  1608.  
  1609. NOTDOT:    OR    A        ; A zero terminates, as always
  1610.     JR    Z,CRHDRDONE    ; Yes, done
  1611.     CALL    PUTC        ; Output the char
  1612.     DJNZ    SAYLP        ; Loop a limited number of times
  1613.  
  1614.     CALL    EXTCHK        ; If we're extracting, time to open the file
  1615.     CALL    NZ,EXTCRFILE    ; (the CompRessed file routine)
  1616.  
  1617.     CALL    GETBYT        ; This part's optional- print "[..]" text
  1618.     OR    A        ; End-of-header?
  1619.     JR    Z,CRHDRDONE    ; If so..
  1620.     CP    '['        ; Beg of comment?
  1621.     JR    NZ,FNDEOH    ; Forget it, skip junk and continue
  1622.     LD    B,A        ; Save that "["
  1623.     LD    A,' '        ; Space btwn filename and comment looks better
  1624.     CALL    PUTC        ;
  1625.     LD    A,B        ; Get that "[" bak again
  1626.  
  1627. CMNTLP:    CALL    PUTC        ; Ok, start typing comment
  1628.     CALL    GETBYT        ; Next char
  1629.     OR    A        ; In case of missing "]"
  1630.     JR    Z,CRHDRDONE    ;
  1631.     CP    ']'        ; End of comment?
  1632.     JR    NZ,CMNTLP    ; Loop for more chars if not
  1633.     CALL    PUTC        ; Print closing bracket
  1634.  
  1635. ; now (finally!) make sure we are at the zero marked eoh
  1636.  
  1637. FNDEOH:    CALL    GETBYT
  1638.     OR    A
  1639.     JR    NZ,FNDEOH
  1640.  
  1641. ; set workarea 24k below BDOS.
  1642.  
  1643. ; "UNC", in it's present configuration, checks that the address of free
  1644. ; memory supplied to it in HL allows FULLY 24k (or more). It does this
  1645. ; after rounding up the value supplied to the next even page boundary. So
  1646. ; we have to add in an extra 256 bytes to allow for this rounding process.
  1647.  
  1648. CRHDRDONE:
  1649.     LD    HL,(BDOSBASE)    ; [possibly adjusted] BDOS addr
  1650.     LD    DE,24*1024+256    ; 24k + one page for "rounding"
  1651.     XOR    A
  1652.     SBC    HL,DE
  1653.     LD    (WORKAREA),HL    ; Save for debug only
  1654.  
  1655.     CALL    UNC        ; Join uncrel after filename scanned
  1656.  
  1657.     LD    HL,(UNCRSRC)
  1658.     LD    DE,(UNCRDST)
  1659.  
  1660.     JR    C,CHKUNCRERRS
  1661.  
  1662. ; file was successfully uncrunched
  1663.  
  1664.     PUSH    DE        ; DE pts to last out+1
  1665.     EX    DE,HL        ; HL now pts to last out+1
  1666.     LD    DE,(BUFPTR)    ; Start of uncr text
  1667.     XOR    A
  1668.     SBC    HL,DE        ; Len of uncr text
  1669.     LD    (FILELEN),HL
  1670.     POP    DE        ; Last out+1 for findeof
  1671.  
  1672.     JP    FINDEOF        ; Treat like all others
  1673.  
  1674. CHKUNCRERRS:
  1675.     CP    2        ; Error 2 is file not crunched
  1676.     JR    NZ,CHK1ERROR
  1677.  
  1678. ; we can handle this error:
  1679. ; force top of file again, then treat as normal text
  1680.  
  1681. NOTCOMPRESSED:
  1682.     LD    HL,0
  1683.     LD    (FCB1R0),HL
  1684.     LD    C,RANDOM
  1685.     CALL    BDOSCALL    ; Read at tof
  1686.     JP    NORML2        ; (Will overwrite "Uncrunching" msg)
  1687.  
  1688. CHK1ERROR:
  1689.     PUSH    AF
  1690.     CALL    CRLF
  1691.     POP    AF
  1692.     CP    1
  1693.     JR    Z,ERR1
  1694.     CP    5
  1695.     JR    NZ,CHK3ERROR
  1696.  
  1697. ERR1:    CALL    MSG
  1698.     DB    'Unknown crunched format',0
  1699.     JP    QUITNOSUM
  1700.  
  1701. CHK3ERROR:
  1702.     CP    3
  1703.     JR    NZ,CHK4ERROR
  1704.     CALL    MSG
  1705.     DB    '++ File is corrupt ++',0
  1706.     JP    QUITNOSUM
  1707.  
  1708. CHK4ERROR:
  1709.     CP    4
  1710.     JR    NZ,UNCRUNKERROR
  1711.     CALL    MSG
  1712.     DB    '++ Out of memory ++',0
  1713.     JP    QUITNOSUM
  1714.  
  1715. UNCRUNKERROR:
  1716.     PUSH    AF
  1717.     CALL    MSG
  1718.     DB    '++ Uncrunch error: ',0
  1719.     POP    AF
  1720.     ADD    A,'0'        ; Make an ascii #
  1721.     CALL    PUTC
  1722.     JP    QUITNOSUM
  1723.  
  1724. ; i/o rtns for uncrel.azm
  1725. ; these are also used by unsq code
  1726.  
  1727. GETBYT:    PUSH    BC        ; Save working regs
  1728.     PUSH    HL
  1729.     LD    HL,(UNCRSRC)
  1730.  
  1731.     LD    A,H
  1732.     CP    1        ; At 100h?
  1733.     JR    C,STILLINSECT
  1734.  
  1735. ; read another sector of the file
  1736.  
  1737.     PUSH    DE        ; Save dst ptr fr BDOS destruction
  1738.  
  1739.     LD    C,SETDMA
  1740.     LD    DE,80H        ; Use default buffer
  1741.     CALL    BDOSC1
  1742.  
  1743.     LD    C,READSEQ
  1744.     CALL    BDOSCALL    ; Read next sector into it
  1745.     POP    DE        ; Restore DE
  1746.  
  1747.     LD    HL,80H        ; Set ptr to start of this sector
  1748.  
  1749. STILLINSECT:
  1750.     LD    A,(HL)        ; Get a char to uncr
  1751.     INC    HL        ; *ch++
  1752.  
  1753.     LD    (UNCRSRC),HL
  1754.     POP    HL        ; Restore working regs
  1755.     POP    BC
  1756.     RET
  1757.  
  1758. OUT:    PUSH    AF
  1759.     PUSH    DE        ; Save working regs
  1760.     LD    DE,(UNCRDST)
  1761.     LD    (DE),A
  1762.     INC    DE
  1763.  
  1764. ; chk for DE > workarea
  1765.  
  1766.     LD    A,(WORKAREA+1)
  1767.     CP    D        ; Hi bytes only
  1768.     JR    NZ,OUTOK
  1769.  
  1770. ; else, uncr/unsq text is about to run into workarea
  1771. ; so if we are extracting from a library, we flush the buffer now
  1772.  
  1773.     CALL    EXTCHK        ; Are we indeed extracting?
  1774.     JR    NZ,OUT0
  1775.  
  1776.     LD    SP,(SPSAVE)    ; Restore our sp
  1777.     CALL    CRLF
  1778.     DEC    DE        ; DE pts to last byte uncr
  1779.     JR    TOOLARGE
  1780.  
  1781. OUT0:    LD    DE,(WORKAREA)    ; Pass ptr to buffer top in DE
  1782.     LD    E,0
  1783.     CALL    OUTFLUSH
  1784.  
  1785. OUTOK:    LD    (UNCRDST),DE    ; Reset destination ptr
  1786.     POP    DE        ; Rst working regs
  1787.     POP    AF
  1788.     RET
  1789.  
  1790. OUTFLUSH:
  1791.     PUSH    HL        ; Save last 2 working regs
  1792.     PUSH    BC        ;
  1793.     LD    HL,(BUFPTR)    ;
  1794.     EX    DE,HL        ; Put last sector used addr in HL
  1795.     OR    A        ; Clear carry for 16-bit subtract
  1796.     SBC    HL,DE        ; HL is now length of full buffer
  1797.     PUSH    HL        ; Save it
  1798.     LD    B,0        ; BC will be sector counter
  1799.     LD    C,H        ;
  1800.     SLA    L        ;
  1801.     RL    C        ;
  1802.     RL    B        ; Now BC has correct sector count
  1803.  
  1804. OUTF0:    PUSH    BC
  1805.     PUSH    DE
  1806.     LD    C,SETDMA    ; Set DMA to this sector
  1807.     CALL    BDOSC1
  1808.     LD    C,WRITSEQ    ; Write sector
  1809.     LD    DE,FCB3        ; Extraction FCB
  1810.     CALL    BDOSC1
  1811.     JP    NZ,NOSPACE    ; NZ means write failed
  1812.     LD    HL,(FLSECTS)    ; Count one more sector flushed
  1813.     INC    HL
  1814.     LD    (FLSECTS),HL
  1815.     POP    DE
  1816.     POP    BC
  1817.     LD    HL,80H        ; Point to next sector
  1818.     ADD    HL,DE
  1819.     EX    DE,HL        ; Swap into DE
  1820.  
  1821.     DEC    BC        ; V4.0 need 2-byte loop counter, as mentioned
  1822.     LD    A,B        ;
  1823.     OR    C        ;
  1824.     JR    NZ,OUTF0    ;
  1825.  
  1826.     POP    HL        ; Get back orig buffer length
  1827.     LD    A,L        ; Low byte
  1828.     AND    127        ; This many bytes were not flushed
  1829.     LD    C,A        ; Move to BC
  1830.     LD    B,0
  1831.     EX    DE,HL        ; Point to unflushed bytes
  1832.     LD    DE,(BUFPTR)    ; Point to start of buffer
  1833.     JR    Z,OUTF1        ; If there were no bytes, skip it
  1834.     LDIR
  1835.  
  1836. OUTF1:
  1837.     POP    BC        ; Restore regs
  1838.     POP    HL
  1839.     RET            ; And DE points to first free location
  1840.  
  1841. ;..............................................................................
  1842. ;
  1843. TOOLARGE:
  1844.     LD    A,0FFH        ; Flag incomplete read
  1845.     LD    (INCOMPLETE),A
  1846.  
  1847. ; (Second half, QL.002 follows....)
  1848. ;.............................................................................
  1849.     LD    C,WRITSEQ    ; Write sector
  1850.     LD    DE,FCB3        ; Extraction FCB
  1851.     CALL    BDOSC1
  1852.     JP    NZ,NOSPACE    ; N