home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / commercial-software / programming / Z80TOOLS.ZIP / DISK1.ZIP / CMDASM.ANT < prev    next >
Text File  |  1998-07-30  |  74KB  |  3,264 lines
  1. ; Copyright (C) 1985 M&T Publishing Co. all rights reserved
  2.  
  3. ;    TYPIST -- echo keyboard lines to printer
  4.     maclib    environ
  5.     dseg
  6. linesize equ    132    ; max line we will read
  7. keyboard:
  8.     confile
  9. printer:
  10.     lstfile
  11. line    strspace linesize
  12.  
  13.     cseg
  14.     prolog
  15. loop:
  16.     fgetstr keyboard,line,linesize
  17.     rz
  18.     fputline printer,line
  19.     jmp    loop
  20.  
  21.     end
  22. e    strspace linesize
  23.  
  24.     cseg
  25.     prolog
  26. ; Copyright (C) 1985 M&T Publishing Co. all rights reserved
  27.  
  28. ;    KEYFILE destination
  29. ; write keyboard lines into file specified by "destination"
  30.     maclib    environ
  31.     dseg
  32. Linelen equ    256
  33. Input:    filedef Linelen,,CON:
  34. Screen: msgfile
  35. Output: filedef Linelen
  36. Line:    strspace Linelen
  37.  
  38. Prompt: strconst '==>'
  39. Ughhh:    strconst 'I have a problem.$'
  40.  
  41.     cseg
  42.     prolog
  43.  
  44. ;verify the command operand Destination
  45. ; parse and save command operands
  46.     savetail    ; save operands, set A to count
  47. ; if not just 1, abort w/ message
  48.     cpi    1    ; exactly one?
  49.     abort    nz,Ughhh
  50. ; assign operand 1 to Output
  51.     tailtokn 1    ; set DE->string of token #1
  52.     xchg        ; make that HL->token
  53.     fassign Output,@H ; assign string to file
  54. ; if invalid, abort w/ message
  55.     abort    z,Ughhh ; Z true if not valid filespec
  56. ; if ambiguous, abort w/ message
  57.     cpi    '?'    ; A="?" if ambiguous
  58.     abort    z,Ughhh
  59. ;prepare the Input file
  60.     freset    Input
  61. ;prepare the Output file
  62.     frewrite Output
  63.  
  64. loop:
  65. ; display Prompt on Screen
  66.     fputstr Screen,Prompt
  67. ; read Line from Input
  68.     fgetstr Input,Line,Linelen
  69. ; if end of file, break
  70.     jz    done
  71. ; write Line to Output
  72.     fputline Output,Line,Linelen
  73. ;end loop.
  74.     jmp    loop
  75.  
  76. ; close the Output file
  77. done:    fclose    Output
  78.     ret
  79.     end
  80. e to Output
  81.     fputline Output,Line,Linel    title    'EMIT command'
  82. ;===============================================================
  83. ;
  84. ;        EMIT  device  bytes...
  85. ;
  86. ; Emit a control sequence specified by "bytes..." operands, to
  87. ; a logical device CON:, LST:, or AUX: as given by "device."
  88. ;
  89. ; History:
  90. ; initial code 18 June 84
  91. ; Copyright (C) 1985 M&T Publishing Co. all rights reserved
  92. ;===============================================================
  93.     maclib    environ
  94.     dseg
  95.  
  96. usage:    ; usage message for aborts
  97. cr    equ    AsciiCR
  98. lf    equ    AsciiLF
  99. tab    equ    AsciiTAB
  100.  db 'EMIT sends bytes to a device.  Syntax is',cr,lf
  101.  db tab,'EMIT device bytes...',cr,lf
  102.  db 'Device must be CON: or LST: or AUX: or PUN:',cr,lf
  103.  db 'A byte is either',cr,lf
  104.  db tab,'a decimal number from 0 to 255',cr,lf
  105.  db tab,'a hex number from 0H to 0FFH',cr,lf
  106.  db tab,'name of a control character like ESC or CR',cr,lf
  107.  db tab,'quoted literal characters like ''ABC or "9',cr,lf
  108.  db '$' ; must end abort with a dollarsign
  109.  
  110. abdev:    strconst ' is not a device I can emit to.$'
  111. abopr:    strconst ' is not a byte-code I can convert.$'
  112.  
  113. ntoken    db    0    ; number of operands
  114. ctoken    db    0    ; token being worked on now
  115. cbyte    dw    0    ; ->next byte of "stuff"
  116.  
  117. stuff:    ds    128    ; space for output bytes (and msgs)
  118.  
  119. dest:    filedef 128
  120.  
  121.     cseg
  122.     prolog
  123.  
  124. ;   validate the number of command-tokens
  125.  
  126.     extrn    CHKOPS
  127.     lxi    b,(1*256)+255    ; B=1, C=255
  128.     lxi    d,usage     ; DE->usage message
  129.     call    CHKOPS
  130.     sta    ntoken        ; save count of operands
  131.  
  132. ;   validate the device-name and assign to dest
  133.  
  134.     call    checkdev    ; do it in a subroutine
  135.  
  136. ; set up for the loop:
  137.     mvi    a,2        ; first byte will be
  138.     sta    ctoken        ; ..operand #2
  139.     lxi    h,stuff     ; and will go into
  140.     shld    cbyte        ; ..byte 0 of stuff
  141.     mvi    b,0        ; count bytes in B
  142.  
  143. ;   for each code-token c with initial byte x...
  144.  
  145. for:
  146.     lxi    h,ntoken
  147.     mov    a,m        ; A = total operands
  148.     inx    h        ; HL->ctoken
  149.     cmp    m        ; total < current?
  150.     jc    donefor     ; (yes, done)
  151.     mov    a,m        ; A = current token
  152.     inr    m        ; ..and ctoken = next
  153.     tailtokn @A        ; DE->current token
  154.     ldax    d        ; A = initial byte
  155.  
  156. ;    if (x is alphabetic) then
  157. ;        j := handle-name(c,j)
  158.  
  159.     alpha?    @A        ; is A alphabetic?
  160.     jnz    notalph     ; (no)
  161.     call    handlename    ; yes, handle it
  162.     jmp    for        ; ..and interate
  163.  
  164. ;    else if (x is decimal) then
  165. ;        j := handle-number(c,j)
  166. notalph:
  167.     digit?    @A        ; is it a digit?
  168.     jnz    notdig        ; (no)
  169.     call    handlenum
  170.     jmp    for
  171.  
  172. ;    else if (x is a quote) then
  173. ;        j := handle-literal(c,j)
  174. notdig:
  175.     cpi    ''''        ; single quote?
  176.     jz    isquote
  177.     cpi    '"'        ; ..or double?
  178.     jnz    notquote
  179. isquote:
  180.     call    handlelit
  181.     jmp    for
  182.  
  183. ;    else badbyte(c)
  184. notquote:
  185.     call    badbyte
  186.  
  187. ;   end for.
  188.  
  189. donefor:
  190.     mov    a,b
  191.     ora    a        ; any bytes decoded?
  192.     rz            ; (no, quit)
  193.  
  194. ;    write the saved bytes to dest
  195.  
  196.     lxi    h,stuff
  197.     lxi    d,dest
  198. outloop:
  199.     mov    a,m        ; A = this byte
  200.     inx    h        ; HL->next one
  201.     fputbyte @D,@A        ; write it
  202.     djnz    outloop
  203.  
  204.     ret
  205.  
  206. ; handlename: DE->operand beginning with alphabetic --
  207. ; decode it with a table look-up.
  208.  
  209.     dseg
  210. names:    strtable 36        ; set up table of names
  211.     strentry 'NUL'        ; after each name,
  212.     db    0        ; put byte value.
  213.     strentry 'SOH'
  214.     db    1
  215.     strentry 'STX'
  216.     db    2
  217.     strentry 'ETX'
  218.     db    3
  219.     strentry 'EOT'
  220.     db    4
  221.     strentry 'ENQ'
  222.     db    5
  223.     strentry 'ACK'
  224.     db    6
  225.     strentry 'BEL'
  226.     db    7
  227.     strentry 'BS'
  228.     db    8
  229.     strentry 'HT'
  230.     db    9
  231.     strentry 'LF'
  232.     db    10
  233.     strentry 'VT'
  234.     db    11
  235.     strentry 'FF'
  236.     db    12
  237.     strentry 'CR'
  238.     db    13
  239.     strentry 'SO'
  240.     db    14
  241.     strentry 'SI'
  242.     db    15
  243.     strentry 'DLE'
  244.     db    16
  245.     strentry 'DC1'    ; DC1 = XON = ctrl-Q
  246.     db    17
  247.     strentry 'XON'
  248.     db    17
  249.     strentry 'DC2'
  250.     db    18
  251.     strentry 'DC3'    ; DC3 = XOFF = ctrl-S
  252.     db    19
  253.     strentry 'XOFF'
  254.     db    19
  255.     strentry 'DC4'
  256.     db    20
  257.     strentry 'NAK'
  258.     db    21
  259.     strentry 'SYN'
  260.     db    22
  261.     strentry 'ETB'
  262.     db    23
  263.     strentry 'CAN'
  264.     db    24
  265.     strentry 'EM'
  266.     db    25
  267.     strentry 'SUB'
  268.     db    26
  269.     strentry 'ESC'
  270.     db    27
  271.     strentry 'FS'
  272.     db    28
  273.     strentry 'GS'
  274.     db    29
  275.     strentry 'RS'
  276.     db    30
  277.     strentry 'US'
  278.     db    31
  279.     strentry 'SPACE'
  280.     db    32
  281.     strentry 'COMMA'
  282.     db    44
  283.  
  284.     cseg
  285. handlename:
  286.     push    h
  287.     push    psw
  288.  
  289.     lxi    h,names
  290.     strlook @D,@Hupdate ; find DE->string in HL->table
  291.     jnz    badbyte ; give up if not in table
  292.     inx    h    ; HL->byte after matching entry
  293.     mov    a,m    ; ..which is requested value
  294.     lhld    cbyte
  295.     mov    m,a    ; put in next "stuff" slot
  296.     inx    h
  297.     shld    cbyte    ; update pointer
  298.     inr    b    ; ..and count byte
  299.  
  300.     pop    psw
  301.     pop    h
  302.     ret
  303.  
  304. ; handlenum: DE->token commencing in a digit, convert it
  305. ; from either decimal or hex.
  306.  
  307. handlenum:
  308.     push    psw
  309.     push    h
  310.  
  311.     push    d        ; save ->start of string
  312.     strend    @Dupdate    ; DE->null at end of string
  313.     dcx    d        ; DE->last byte of string
  314.     ldax    d
  315.     pop    d        ; recover ->string
  316.     cpi    'H'        ; hex number?
  317.     jnz    nothex
  318.  
  319.     straxbw @D        ; convert hex to binary in HL
  320.     jmp    dechex        ; ..and check value
  321.  
  322. nothex: digit?    @A        ; not hex, is it decimal?
  323.     jnz    badbyte     ; (no -- 17X...)
  324.     stradbw @D        ; convert decimal to binary
  325.  
  326. dechex: mov    a,h        ; value > 255?
  327.     ora    a        ; ..H is nonzero if so
  328.     jnz    badbyte     ; (yes, give up)
  329.     mov    a,l        ; no, save value in A
  330.     lhld    cbyte
  331.     mov    m,a        ; and put in next stuff slot
  332.     inx    h
  333.     shld    cbyte        ; update pointer,
  334.     inr    b        ; ..and count byte
  335.  
  336.     pop    h
  337.     pop    psw
  338.     ret
  339.  
  340. ; handlelit: DE->string starting with one of two quotes,
  341. ; copy it (less quotes) to stuff.
  342.  
  343. handlelit:
  344.     push    psw
  345.     push    h
  346.     push    d
  347.  
  348.     ldax    d    ; A = opening quote
  349.     inx    d    ; DE->byte after it
  350.     push    d    ; (save that)
  351.     strend    @Dupdate; DE->terminal null
  352.     dcx    d    ; DE->closing byte of string
  353.     xchg        ; (make that HL)
  354.     cmp    m    ; did they close the quote?
  355.     jnz    notclosed
  356.     mvi    m,0    ; yes, truncate string
  357. notclosed:
  358.     pop    d    ; DE->first literal byte again
  359.  
  360.     ldax    d    ; is there anything left now,
  361.     ora    a    ; ..or was it just only a quote?
  362.     jnz    havesome
  363.     pop    d    ; recover ->whole string
  364.     jmp    badbyte ; ..and give up
  365.  
  366. havesome:
  367.     lhld    cbyte
  368. litloop:
  369.     mov    m,a    ; copy literal byte to stuff
  370.     inr    b    ; ..and count it
  371.     inx    h    ; ..and point to next slot
  372.     inx    d    ; ..and point to next byte
  373.     ldax    d    ; is that byte
  374.     ora    a    ; ..the null at the end?
  375.     jnz    litloop ; (no, continue)
  376.  
  377.     shld    cbyte    ; record final ->next slot
  378.     pop    d
  379.     pop    h
  380.     pop    psw
  381.     ret
  382.  
  383. ; badbyte: DE->an operand we can't handle, abort
  384. badbyte:
  385.     xchg        ; HL->operand
  386.     lxi    d,stuff ; DE->space to build msg
  387.     strcopy @D,@H
  388.     strappnd @D,abopr
  389.     abort    ,@D
  390.  
  391. ; checkdev: subroutine to validate "device" operand and
  392. ; abort if it isn't appropriate.
  393.  
  394.     dseg
  395. devtab: strtable 4        ; initiate table of 4 strings
  396.     strentry 'CON:'     ; fill with valid devices
  397.     strentry 'LST:'
  398.     strentry 'AUX:'
  399.     strentry 'PUN:'
  400.     cseg
  401. checkdev:
  402.     push    h
  403.     push    d
  404.     push    psw
  405.     tailtokn 1        ; DE->first operand string
  406.     strlook @D,devtab    ; lookup DE->string in table
  407.     jnz    baddev        ; (didn't find it)
  408.     xchg            ; make it HL->operand
  409.     lxi    d,dest        ; and DE->file
  410.     fassign @D,@H        ; assign name to filedef
  411.     frewrite @D        ; ..and open it
  412.     pop    psw
  413.     pop    d
  414.     pop    h
  415.     ret
  416. baddev: ; oops, not a device we know -- build an abort message
  417.     xchg            ; HL->bad device
  418.     lxi    d,stuff     ; place to build message
  419.     strcopy @D,@H        ; copy "frummage" to stuff
  420.     lxi    h,abdev
  421.     strappnd @D,@H        ; append rest of msg
  422.     abort    ,@D        ; ..and abort with it
  423.  
  424.     end
  425. H        ; copy "frummage" to;===============================================================
  426. ;
  427. ;        CDUMP  filespec
  428. ;
  429. ; Displays file "filespec" in ascii, 64 bytes to the line, for
  430. ; safe inspection when the contents of the file are in doubt.
  431. ;
  432. ; Abort messages
  433. ;    usage message
  434. ;    input-open messages
  435. ;
  436. ; Modules:
  437. ;    CHKOPS
  438. ;    OPENIN
  439. ;
  440. ; History
  441. ; initial code 6/21/84
  442. ; Copyright (C) 1985 M&T Publishing Co. all rights reserved
  443. ;===============================================================
  444.     maclib    environ
  445.     dseg
  446.  
  447. usage:    db    'CDUMP filespec'
  448.     db    AsciiCR,AsciiLF
  449.     db    'Displays contents of file 64 bytes/line, with'
  450.     db    AsciiCR,AsciiLF
  451.     db    'control characters translated to "~" and ends'
  452.     db    AsciiCR,AsciiLF
  453.     db    'of lines shown as "//".'
  454.     db    AsciiCR,AsciiLF
  455.     db    '$'
  456.  
  457. user:    msgfile
  458. input:    filedef 1024
  459. line:    strspace 64
  460.  
  461.     cseg
  462.     prolog
  463.  
  464. ; check operand count of 1, etc (CHKOPS)
  465.  
  466.     mvi    b,1    ; minimum operands: 1
  467.     mov    c,b    ; maximum ditto
  468.     lxi    d,usage
  469.     extrn    CHKOPS
  470.     call    CHKOPS
  471.  
  472. ; validate filespec, assign it to input, and open it
  473.  
  474.     mvi    a,1    ; operand 1 is filespec
  475.     lxi    d,input ; filedef to assign it to
  476.     extrn    OPENIN
  477.     call    OPENIN
  478.  
  479. ; repeat
  480. loop:
  481. ;   make first 64-byte line and display it
  482.     call    makeline
  483.     fputline user,line
  484.  
  485. ;   make second line and display it
  486.     call    makeline
  487.     fputline user,line
  488.  
  489. ; until end-of-file(input) or keyboard-pending
  490.     testcon     ; keyboard?
  491.     jnz    done    ; (yes)
  492.     feof?    input    ; no, end of file?
  493.     jnz    loop    ; (no, continue)
  494.  
  495. ; end cdump.
  496. done:    ret
  497.  
  498. ; makeline()
  499. makeline:
  500.     push    psw
  501.     push    b
  502.     push    d
  503.     push    h
  504.  
  505. ;   make line a null string
  506.     lxi    d,line
  507.     strnull @D
  508.     xchg        ; carry HL->string position
  509.     lxi    d,input ; ..and DE->file
  510.  
  511. ;   for t := 0 to 63 
  512.     mvi    b,64    ; set loop count
  513. mloop:
  514.  
  515. ;    c := fgetbyte(input)
  516.     fgetbyte @D
  517.  
  518. ;    c := translate(c)
  519.     call    translate
  520.  
  521. ;    append c to line
  522.     xchg
  523.     strput    @Dupdate,@A
  524.     xchg
  525.  
  526. ;   end for
  527.     djnz    mloop
  528.  
  529. ;end makeline.
  530.     pop    h
  531.     pop    d
  532.     pop    b
  533.     pop    psw
  534.     ret
  535.  
  536. ;translate(x) : character
  537. translate:
  538.  
  539. ;   if (x > 127) then x := x - 128
  540.     cpi    AsciiDEL+1
  541.     jc    lt128
  542.     ani    AsciiDEL
  543. lt128:
  544.  
  545. ;   if (x >= space) and (x < DEL) then return x
  546.     cpi    AsciiBlank ; if less than space
  547.     jc    iscontrol  ; ..it's a control char
  548.     cpi    AsciiDEL   ; not less than space,
  549.     rc           ; if < DEL, is ascii
  550. iscontrol:
  551.  
  552. ;   if (x = CR) or (x = LF) then return slash
  553.     cpi    AsciiCR
  554.     jz    slash
  555.     cpi    AsciiLF
  556.     jnz    dot
  557. slash:    mvi    a,'/'
  558.     ret
  559.  
  560. ;   return a dot
  561. dot:    mvi    a,'.'
  562.     ret
  563. ;end translate.
  564.  
  565.     end
  566. 
  567.     jz    slash
  568.     cpi    AsciiLF
  569.     jnz    dot
  570. slash:    mvi    a,'/'    title    'BDUMP -- binary file display'
  571. ;===============================================================
  572. ;
  573. ;        BDUMP  filespec
  574. ;
  575. ; Displays file "filespec" in hex and ascii, 16 bytes to the
  576. ; line, with CP/M record numbers.
  577. ;
  578. ; Abort messages
  579. ;    usage message
  580. ;    input-open messages
  581. ;
  582. ; Modules:
  583. ;    CHKOPS
  584. ;    OPENIN
  585. ;
  586. ; History
  587. ; initial code 6/26/84
  588. ; Copyright (C) 1985 M&T Publishing Co. all rights reserved
  589. ;===============================================================
  590.     maclib    environ
  591.     dseg
  592.  
  593. usage:    db    'BDUMP filespec'
  594.     db    AsciiCR,AsciiLF
  595.     db    'Displays contents of file 16 bytes/line, with'
  596.     db    AsciiCR,AsciiLF
  597.     db    'data shown in both hex and ascii, with CP/M'
  598.     db    AsciiCR,AsciiLF
  599.     db    'file record numbers.'
  600.     db    AsciiCR,AsciiLF
  601.     db    '$'
  602.  
  603. input:    filedef 1024
  604.  
  605.     cseg
  606.     prolog
  607.  
  608. ; check operand count of 1, etc (CHKOPS)
  609.  
  610.     mvi    b,1    ; minimum operands: 1
  611.     mov    c,b    ; maximum ditto
  612.     lxi    d,usage
  613.     extrn    CHKOPS
  614.     call    CHKOPS
  615.  
  616. ; validate filespec, assign and open (OPENIN)
  617.  
  618.     mvi    a,1    ; operand #1 is filespec
  619.     lxi    d,input ; DE->filedef for it
  620.     extrn    OPENIN
  621.     call    OPENIN
  622.  
  623. ; HL will carry record number
  624.     lxi    h,0
  625. ; DE will address input file
  626.     lxi    d,input
  627.  
  628. ; repeat
  629. ;    get 128 bytes and display it
  630. loop128:
  631.     call    show128 ; with(file,recnum)
  632.     inx    h    ; next record number
  633. ; until end-of-file(input) or keyboard-pending
  634.     testcon     ; keyboard pending?
  635.     jnz    done    ; (yes)
  636.     feof?    input    ; no, end of file?
  637.     jnz    loop128 ; (no, continue)
  638. ;end bdump.
  639. done:    ret
  640.  
  641. ;show128(DE->file,HL=recnum)
  642.  
  643. ; user is a file representing the screen
  644. ; line is space for a display line
  645. ; block is space for 128 bytes of data
  646.     dseg
  647. user:    msgfile     ; moved to this level
  648. line:    strspace 80
  649. block:    ds    128
  650.     cseg
  651.  
  652. show128:
  653.     push    psw
  654.     push    b
  655.     push    d
  656.     push    h    ; save recnum on top of stack
  657.  
  658. ; fgetblok(given file,block)
  659.  
  660.     fgetblok @D,block,128
  661.  
  662. ; process 1st 16 bytes into line
  663.  
  664.     lxi    h,block
  665.     lxi    d,line
  666.     call    show16    ; with(line,bytes)
  667.  
  668. ; append record number recnum to line
  669.  
  670.     strput    @Dupdate,AsciiBlank
  671.     xthl    ; save ->bytes, HL=recnum
  672.     strbwax @D,@H
  673.     xthl    ; get back HL->bytes
  674.  
  675. ; fputline(user,line)
  676.  
  677.     fputline user,line
  678.  
  679. ; do 7 more times
  680.     mvi    b,7    ; loop count for djnz
  681. loop7:
  682. ;   process next 16 bytes into line
  683.     lxi    d,16
  684.     dad    d    ; advance HL to next 16
  685.     lxi    d,line
  686.     call    show16    ; with(line,bytes)
  687. ;   fputline(user,line)
  688.     fputline user,line
  689. ;   end do.
  690.     djnz    loop7
  691.  
  692. ;end show128.
  693.  
  694.     pop    h
  695.     pop    d
  696.     pop    b
  697.     pop    psw
  698.     ret
  699.  
  700. ;show16(DE->line,HL->bytes)  { method 1 }
  701.  
  702. show16:
  703.     push    psw
  704.     push    b
  705.     push    d
  706.     push    h    ; HL->bytes to display
  707.  
  708. ; make line the null string
  709.  
  710.     strnull @D
  711.  
  712. ; for each byte x in bytes
  713.     mvi    b,16
  714. loophex:
  715. ;   append hex display of x to line
  716.     mov    a,m    ; get byte "x"
  717.     inx    h    ; ..and advance pointer
  718.     strbbax @Dupdate,@A
  719. ;   append a blank to line
  720.     mvi    a,AsciiBlank
  721.     strput    @Dupdate,@A
  722. ; end for
  723.     djnz    loophex
  724.  
  725. ; append another blank to line
  726.     strput    @Dupdate,@A ; A = blank at end of loop
  727.  
  728. ; for each byte x in bytes
  729.     pop    h    ; recover ->bytes
  730.     push    h    ; ..and save again
  731.     mvi    b,16
  732. loopasc:
  733. ;   append translate(x) to line
  734.     mov    a,m
  735.     inx    h
  736.     call    translate
  737.     strput    @Dupdate,@A
  738. ; end for
  739.     djnz    loopasc
  740.  
  741. ;end show16.
  742.     pop    h
  743.     pop    d
  744.     pop    b
  745.     pop    psw
  746.     ret
  747.  
  748. ;translate(x) : character (from cdump)
  749. translate:
  750.  
  751. ;   if (x > 127) then x := x - 128
  752.     cpi    AsciiDEL+1
  753.     jc    lt128
  754.     ani    AsciiDEL
  755. lt128:
  756.  
  757. ;   if (x >= space) and (x < DEL) then return x
  758.     cpi    AsciiBlank ; if less than space
  759.     jc    iscontrol  ; ..it's a control char
  760.     cpi    AsciiDEL   ; not less than space,
  761.     rc           ; if < DEL, is ascii
  762. iscontrol:
  763.  
  764. ;   if (x = CR) or (x = LF) then return backslash
  765.     cpi    AsciiCR
  766.     jz    slish
  767.     cpi    AsciiLF
  768.     jnz    dot
  769. slish:    mvi    a,'\'
  770.     ret
  771.  
  772. ;   return a dot
  773. dot:    mvi    a,'.'
  774.     ret
  775. ;end translate.
  776.  
  777.     end
  778. 
  779.     jz    slish
  780.     cpi    Asci;===============================================================
  781. ;
  782. ;        PACK  infile  outfile
  783. ;
  784. ; Read infile, compress using digraph and run-length methods,
  785. ; and write compressed data as outfile.
  786. ;
  787. ; Abort messages
  788. ;    file-open messages
  789. ;    usage message
  790. ;
  791. ; Modules
  792. ;    CHKOPS
  793. ;    OPENUT (OPENIN, OPENOU)
  794. ;    LOOKUP
  795. ;
  796. ; History:
  797. ; initial code 13 July 84
  798. ; Copyright (C) 1985 M&T Publishing Co. all rights reserved
  799. ;===============================================================
  800.     maclib    environ
  801.     dseg
  802. usage:
  803.  db AsciiTAB,'PACK  infile  outfile'
  804.  db AsciiCR,AsciiLF
  805.  db 'Reads file "infile," compresses its data, and writes the'
  806.  db AsciiCR,AsciiLF
  807.  db 'compressed result as "outfile."  Use the UNPACK program'
  808.  db AsciiCR,AsciiLF
  809.  db 'to restore packed data to normal.  Only ASCII files will'
  810.  db AsciiCR,AsciiLF
  811.  db 'show significant reduction in size.'
  812.  db AsciiCR,AsciiLF
  813.  db '$'
  814.  
  815. infile: filedef 128    ; small input buffer
  816. outfile: filedef 16384    ; big buffer for speed
  817.  
  818. Literally equ    0E8h    ; prefix for nonascii byte
  819. CRLF    equ    0E9h    ; code for CR, LF pair
  820. CLTAB    equ    0EAh    ; code for CR, LF, TAB
  821. ; EBh through EEh uncommitted
  822. EndFile equ    0EFh    ; code for physical end of file
  823. RunBase equ    0F0h    ; base code for a run of 2 or more
  824. Run17    equ    0FFh    ; code for a run of 17
  825.  
  826. Verflag equ    0FFh    ; prefix for version
  827. Version equ    74h    ; month/year in hex for version check
  828.  
  829.     cseg
  830.  
  831.     extrn    CHKOPS,OPENIN,OPENOU
  832.  
  833.     prolog
  834.  
  835. ; chkops(1,2) { one or two operands }
  836.     mvi    b,1    ; at least one,
  837.     mvi    c,2    ; not more than 2, operands
  838.     lxi    d,usage
  839.     call    CHKOPS
  840.  
  841. ; openin(1,infile) { first names infile }
  842.     mvi    a,1
  843.     lxi    d,infile
  844.     call    OPENIN
  845.  
  846. ; openou(2,outfile,infile) { 2nd is null or names outfile }
  847.     mvi    a,2
  848.     lxi    b,infile
  849.     lxi    d,outfile
  850.     call    OPENOU
  851.  
  852. ; initialize outfile with version-code
  853.     mvi    a,Verflag
  854.     fputbyte @D,@A
  855.     mvi    a,Version
  856.     fputbyte @D,@A
  857.  
  858.     call    process ; process-loop out of line
  859.  
  860.     fclose    outfile
  861.     ret
  862.  
  863. ;===============================================================
  864. ; In the following we will deal with pseudo-code variables b and
  865. ; c as words, and carry them in registers BC and DE respectively
  866. ; To reduce (?) confusion we give meaningful (?) names to the
  867. ; high and low bytes of the register pairs.
  868.  
  869. varBhi    equ    B
  870. varBlo    equ    C
  871. varChi    equ    D
  872. varClo    equ    E
  873.  
  874. ;===============================================================
  875. ; readtoC(): read a byte from infile and form it as a word in
  876. ; the variable c.  Form a value of 256 if end of file is seen.
  877. readtoC:
  878.     fgetbyte infile
  879.     mov    varClo,a
  880.     mvi    varChi,0 ; assume not end of file
  881.     rnz        ; (right)
  882.     inr    varChi    ; 00 returned, make c=0100h
  883.     ret
  884.  
  885. ;===============================================================
  886. ; compareC(A): compare the byte in A to variable c.  If c>255
  887. ; then it doesn't match anything; otherwise do a byte compare.
  888. compareC:
  889.     dcr    varChi    ; test hi byte for zero by
  890.     inr    varChi    ; decrementing and incrementing
  891.     rnz        ; c > 255, is eof, matches nothing
  892.     cmp    varClo
  893.     ret
  894.  
  895. ;===============================================================
  896. ; cmpBC: compare b=c.  If either is > 255 (end of file), they
  897. ; don't match.  Else do byte-compare.
  898. cmpBC:
  899.     mov    a,varBhi
  900.     ora    varChi
  901.     rnz        ; (exit if either > 255)
  902.     mov    a,varBlo
  903.     cmp    varClo
  904.     ret
  905.  
  906. ;===============================================================
  907. ; the main loop, after the pseudo-code but modified to use the
  908. ; above hardware-specific subroutines.    A classification table
  909. ; is used for quick recognition and translation of the common
  910. ; 13 characters " etaoinshrdlu."
  911.  
  912.     dseg
  913. classtable:
  914. $-PRINT ; shorten the listing
  915.     rept    128 ; array[0..127] of bytes
  916.     db    0ffh ; = not one of the common characters
  917.     endm
  918. $+PRINT
  919.     org    classtable+' '
  920.     db    0
  921.     org    classtable+'e'
  922.     db    1
  923.     org    classtable+'t'
  924.     db    2
  925.     org    classtable+'a'
  926.     db    3
  927.     org    classtable+'o'
  928.     db    4
  929.     org    classtable+'i'
  930.     db    5
  931.     org    classtable+'n'
  932.     db    6
  933.     org    classtable+'s'
  934.     db    7
  935.     org    classtable+'h'
  936.     db    8
  937.     org    classtable+'r'
  938.     db    9
  939.     org    classtable+'d'
  940.     db    10
  941.     org    classtable+'l'
  942.     db    11
  943.     org    classtable+'u'
  944.     db    12
  945.     org    classtable+128
  946.     cseg
  947.  
  948. process:
  949.     push    psw
  950.     push    b
  951.     push    d
  952.     push    h
  953.  
  954. ;b := readone()
  955. ;c := readone()
  956.     call    readtoC
  957.     mov    varBhi,varChi
  958.     mov    varBlo,varClo
  959.     call    readtoC
  960.  
  961. ;repeat {. here b is known to be a valid byte .}
  962. toploop:
  963.  
  964. ;    if (b > 127) then
  965. ;     fputbyte(Literally,outfile)
  966. ;     fputbyte(b,outfile)
  967.     mov    a,varBlo    ; if byte value
  968.     ora    a        ; ..has high bit of 0
  969.     jp    lt128        ; ..it is less than 128
  970.     mvi    a,Literally
  971.     fputbyte outfile,@A
  972.     mov    a,varBlo
  973.     fputbyte outfile,@A
  974.     jmp    botloop
  975.  
  976. lt128:
  977. ;    else if (b and c are a compressible pair) then
  978. ;     form the pair as x
  979.     lxi    h,classtable
  980.     dad    b    ; HL->classtable[b]
  981.     mov    a,m    ; ..which is FF
  982.     ora    a    ; ..if b not one of " etaoinshrdlu"
  983.     jm    nopair
  984.     call    makepair ; try 2nd byte for a pair
  985.     ora    a    ; paircodes have high bit set
  986.     jp    nopair
  987.  
  988. ;     fputbyte(x,outfile)
  989. ;     c := readone()
  990.     fputbyte outfile,@A
  991.     call    readtoC
  992.     jmp    botloop
  993.  
  994. nopair:
  995. ;    else if (b = CR) and (c = LF) then
  996.     mov    a,varBlo
  997.     cpi    AsciiCR
  998.     jnz    noCR
  999.     mvi    a,AsciiLF
  1000.     call    compareC
  1001.     jnz    noCR
  1002.  
  1003. ;     x := CRLF
  1004. ;     c := readone()
  1005.     mvi    h,CRLF    ; use H for "x" here
  1006.     call    readtoC
  1007.  
  1008. ;     if (c = TAB) then
  1009.     mvi    a,AsciiTAB
  1010.     call    compareC
  1011.     jnz    noTAB
  1012.  
  1013. ;         x := CLTAB
  1014. ;         c := readone(infile)
  1015.     mvi    h,CLTAB
  1016.     call    readtoC
  1017.  
  1018. noTAB:
  1019. ;     endif
  1020. ;     fputbyte(x,outfile)
  1021.     mov    a,h
  1022.     fputbyte outfile,@A
  1023.     jmp    botloop
  1024.  
  1025. noCR:
  1026. ;    else if (b = c) then {. possible run .}
  1027.     call    cmpbc
  1028.     jnz    norun
  1029.     call    doruncode ; run-code stuff out of line
  1030.     jmp    botloop
  1031.  
  1032. norun:
  1033. ;    else
  1034. ;     fputbyte(b,outfile)
  1035.     mov    a,varBlo
  1036.     fputbyte outfile,@A
  1037. ;    endif
  1038.  
  1039. botloop:
  1040. ;    b := c
  1041.     mov    varBhi,varChi
  1042.     mov    varBlo,varClo
  1043.  
  1044. ;    c := readone(infile)
  1045.     call    readtoC
  1046.  
  1047. ;until (b > 255)
  1048.     mov    a,varBhi
  1049.     ora    a
  1050.     jz    toploop
  1051.  
  1052.     mvi    a,EndFile
  1053.     fputbyte outfile,@A
  1054.  
  1055.     pop    h
  1056.     pop    d
  1057.     pop    b
  1058.     pop    psw
  1059.     ret
  1060.  
  1061. ;===============================================================
  1062. ; makepair, somewhat modified from the pseudo-code: When called
  1063. ; it is already known that "b" is a common letter, and its
  1064. ; numeric code 0..12 is in register A.
  1065.  
  1066.     dseg
  1067. aftersp strconst 't aiocsw'
  1068. aftere    strconst ' rsndcmt'
  1069. aftert    strconst 'h eorias'
  1070. aftera    strconst 'nt lrmcs'
  1071. aftero    strconst ' nrfupmd'
  1072. afteri    strconst 'ntsclofg'
  1073. aftern    strconst ' dtgeaso'
  1074. afters    strconst ' tesia.u'
  1075. afterh    strconst 'ea iotr.'
  1076. afterr    strconst 'ea oisty'
  1077. afterd    strconst ' eios.a,'
  1078. afterl    strconst 'e lioydv'
  1079. afteru    strconst 'tslrmned'
  1080.  
  1081. followers: ; table of pointers to follower-lists
  1082.     dw    aftersp
  1083.     dw    aftere,aftert,aftera
  1084.     dw    aftero,afteri,aftern
  1085.     dw    afters,afterh,afterr
  1086.     dw    afterd,afterl,afteru
  1087.  
  1088.     cseg
  1089. makepair:
  1090.     dcr    varChi
  1091.     inr    varChi    ; if c > 255,
  1092.     rnz        ; ..we can't make a pair
  1093.  
  1094.     push    b
  1095.     push    d
  1096.     push    h
  1097.  
  1098. ; At this point we know variable c is a byte, not eof, and
  1099. ; that variable b -- regs BC -- is too.  Hence BC=00xx.
  1100. ; We'll be using B and C as work registers, and will rely
  1101. ; on B being initially 00.
  1102.  
  1103. ;    p := lookup(b,list1) -- already done
  1104.     mov    c,a    ; BC = 00nn, the first number
  1105.  
  1106. ;    q := lookup(c,followers[p])
  1107.     lxi    h,followers
  1108.     dad    b    ; add twice 00nn to HL
  1109.     dad    b    ; HL->(word)->followers of "b"
  1110.     mov    a,m
  1111.     inx    h
  1112.     mov    h,m
  1113.     mov    l,a    ; HL->followers of "b"
  1114. makeloop:
  1115.     mov    a,m    ; A = possible follower
  1116.     cmp    varClo    ; is this it?
  1117.     jz    makepool; (yes)
  1118.     inr    b    ; no, increment "q"
  1119.     inx    h    ; ..and point to next candidate
  1120.     ora    a    ; was that 00 = end of list?
  1121.     jnz    makeloop; (no, continue)
  1122. makepool:
  1123.  
  1124. ;    if (q > 7) then return 0
  1125.     mov    a,b
  1126.     cpi    8    ; did we find c in follower-list?
  1127.     jnc    makedone; (no, exit with A not a pair code)
  1128.  
  1129. ;    return 80h + (p shiftleft 3) + q
  1130.     mov    a,c
  1131.     add a ! add a ! add a
  1132.     ora    b
  1133.     ori    80h
  1134.  
  1135. makedone:
  1136. ;end makepair
  1137.     pop    h
  1138.     pop    d
  1139.     pop    b
  1140.     ret
  1141.  
  1142. ;===============================================================
  1143. ; doruncode: the logic for forming a run-code, after the pseudo-
  1144. ; code but moved out of line for clarity.  On arrival, we know
  1145. ; that b=c and therefore c isn't end of file.  Regs HL are used
  1146. ; for variable "n" at first, since we could count a run of more
  1147. ; than 256 bytes.
  1148.  
  1149. doruncode:
  1150.     push    psw
  1151.     push    h
  1152. ;     n := 2
  1153.     lxi    h,2
  1154.  
  1155. ;     loop
  1156. runloop:
  1157.  
  1158. ;         c := readone
  1159.     call    readtoC
  1160.  
  1161. ;     while (c < 256) and (b = c)
  1162.     call    cmpBC    ; checks both conditions
  1163.     jnz    runover
  1164.  
  1165. ;         n := n + 1
  1166.     inx    h
  1167.     jmp    runloop
  1168. runover:
  1169. ;     end loop
  1170.  
  1171.     push    d    ; save DE over loop
  1172.     lxi    d,17    ; ..and carry 17 in it
  1173. ;     while (n >= 17) do
  1174. ;         fputbyte(FFh,outfile)
  1175. ;         fputbyte(b,outfile)
  1176. ;         n := n-17
  1177. ;     end while
  1178. putloop:
  1179.     ora    a    ; (clear carry)
  1180.     dsbc    d    ; decrement n by 17
  1181.     jc    putover ; ..and stop if n < 17
  1182.     mvi    a,Run17
  1183.     fputbyte outfile,@A
  1184.     mov    a,varBlo
  1185.     fputbyte outfile,@A
  1186.     jmp    putloop
  1187. putover:
  1188.     mov    a,l    ; A now has residual "n"
  1189.     add    e    ; put back the 17-too-much
  1190.     pop    d    ; and restore DE
  1191.  
  1192. ;     if (n > 0) then
  1193.     jz    rundone
  1194.  
  1195. ;         if (n > 1) then
  1196.     cpi    2
  1197.     jc    runsolo
  1198.  
  1199. ;         x := F0h + n-2
  1200. ;         fputbyte(x,outfile)
  1201.     sbi    2
  1202.     ori    RunBase
  1203.     fputbyte outfile,@A
  1204. ;         endif
  1205. runsolo:
  1206.  
  1207. ;         fputbyte(b,outfile)
  1208.     mov    a,varBlo
  1209.     fputbyte outfile,@A
  1210.  
  1211. ;     endif
  1212. rundone:
  1213.     pop    h
  1214.     pop    psw
  1215.     ret
  1216.  
  1217.     end
  1218. olo:
  1219.  
  1220. ;         fputbyte(b,outfile)
  1221.     mov    a,varBlo
  1222.     fputbyte outfile,@A
  1223.  
  1224. ;     endif;===============================================================
  1225. ;
  1226. ;        UNPACK    infile    outfile
  1227. ;
  1228. ; Read a file created by PACK and restore it to its original
  1229. ; condition.
  1230. ;
  1231. ; Abort messages
  1232. ;    file-open messages
  1233. ;    usage message
  1234. ;    "Input file was not created by PACK."
  1235. ;    "Impossible input value -- error in PACK."
  1236. ;
  1237. ; Modules
  1238. ;    CHKOPS
  1239. ;    OPENUT (OPENIN, OPENOU)
  1240. ;
  1241. ; History:
  1242. ; initial code 17 July 84
  1243. ; Copyright (C) 1985 M&T Publishing Co. all rights reserved
  1244. ;===============================================================
  1245.     maclib    environ
  1246.     dseg
  1247. usage:
  1248.  db AsciiTAB,'UNPACK  infile  outfile'
  1249.  db AsciiCR,AsciiLF
  1250.  db 'Input file "infile" must have been created by the PACK'
  1251.  db AsciiCR,AsciiLF
  1252.  db 'program.  Its contents are restored to their original'
  1253.  db AsciiCR,AsciiLF
  1254.  db 'form and written as "outfile."'
  1255.  db AsciiCR,AsciiLF
  1256.  db '$'
  1257.  
  1258. notpacked:
  1259.  db 'Input file not prepared by PACK.$'
  1260.  
  1261. impossible:
  1262.  db 'Impossible input value -- error in PACK.$'
  1263.  
  1264. infile: filedef 128    ; small input buffer
  1265. outfile: filedef 16384    ; big buffer for speed
  1266.  
  1267. Literally equ    0E8h    ; prefix for nonascii byte
  1268. CRLF    equ    0E9h    ; code for CR, LF pair
  1269. CRLFTAB equ    0EAh    ; code for CR, LF, TAB
  1270. ; EBh through EEh uncommitted
  1271. EndFlag equ    0EFh    ; code for physical end of file
  1272. RunBase equ    0F0h    ; base code for a run of 3 or more
  1273. Run18    equ    0FFh    ; code for a run of 18
  1274.  
  1275. Verflag equ    0FFh    ; prefix for version
  1276. Version equ    74h    ; month/year in hex for version check
  1277.  
  1278.     cseg
  1279.  
  1280.     extrn    CHKOPS,OPENIN,OPENOU
  1281.  
  1282.     prolog
  1283.  
  1284. ; chkops(1,2) { one or two operands }
  1285.     mvi    b,1    ; at least one,
  1286.     mvi    c,2    ; not more than 2, operands
  1287.     lxi    d,usage
  1288.     call    CHKOPS
  1289.  
  1290. ; openin(1,infile) { first names infile }
  1291.     mvi    a,1
  1292.     lxi    d,infile
  1293.     call    OPENIN
  1294.  
  1295. ; openou(2,outfile,infile) { 2nd is null or names outfile }
  1296.     mvi    a,2
  1297.     lxi    b,infile
  1298.     lxi    d,outfile
  1299.     call    OPENOU
  1300.  
  1301. ; check for the version code
  1302.  
  1303.     lxi    d,infile
  1304.     fgetbyte @D
  1305.     cpi    VerFlag
  1306.     abort    nz,notpacked
  1307.     fgetbyte @D
  1308.     cpi    Version
  1309.     abort    nz,notpacked
  1310.  
  1311.     call    process ; process-loop out of line
  1312.  
  1313.     fclose    outfile
  1314.     ret
  1315.  
  1316. ;===============================================================
  1317. ; process: the main loop, from the pseudo-code plan.  The case
  1318. ; structure is implemented using a table that contains one entry
  1319. ; for each possible input byte.  Each entry is the offset from
  1320. ; "casetop" to the "case---" label appropriate to that byte.
  1321.  
  1322.     dseg
  1323. casetable:
  1324.  
  1325. ; note: the following uses of REPT revealed a bug in RMAC 1.1.
  1326. ; If the repetition value is between 61h and 7Ah inclusive, REPT
  1327. ; performs 20h too few repetitions (i.e. 41h to 5Ah). The IF
  1328. ; statement after the REPT checks for this and compensates.
  1329.  
  1330. count    set    1+07Fh-0 ; 0..7f = ascii characters
  1331.     rept    count
  1332.     db    toascii  ; "to..." labels defined later
  1333.     endm
  1334.  
  1335. count    set    1+0E7h-80h ; 80..E7 = pair codes
  1336. temp    set    $
  1337.     rept    count
  1338.     db    topair
  1339.     endm
  1340.  if ($-temp) lt count    ; then we didn't get enough repeats
  1341.     rept    count-($-temp)    ; make up the lack
  1342.     db    topair
  1343.     endm
  1344.  endif
  1345.     db    tononasc ; E8 = nonascii follows
  1346.     db    tocrlf     ; E9 = CR, LF
  1347.     db    tocltab  ; EA = CR, LF, TAB
  1348.  
  1349.     rept    1+0EEh-0EBh ; EB..EF = impossible
  1350.     db    toerror
  1351.     endm
  1352.  
  1353.     db    toerror  ; EF = endfile shouldn't come here
  1354.  
  1355.     rept    1+0FFh-0F0h ; F0..FF = runcodes
  1356.     db    torun
  1357.     endm
  1358.  
  1359.     cseg
  1360. process:
  1361.     push    psw
  1362.     push    b
  1363.     push    d
  1364.     push    h
  1365.  
  1366. ;next := fgetbyte(infile)
  1367.     lxi    d,infile
  1368.     fgetbyte @D
  1369.     mov    b,a        ; carry "next" in B
  1370.  
  1371.     lxi    d,outfile    ; carry DE->outfile
  1372.  
  1373. ;repeat
  1374. toploop:
  1375.  
  1376. ;    case (next) of
  1377.     lxi    h,casetable
  1378.     mov    a,b
  1379.     addhla        ; HL -> class of byte in A
  1380.     mov    a,m    ; get it to A
  1381.     lxi    h,cases
  1382.     addhla        ; HL-> code of case action
  1383.     pchl        ; go do it
  1384.  
  1385. cases:
  1386.  
  1387. ;{ascii}    0..7Fh : fputbyte(next,outfile)
  1388. caseascii:
  1389. toascii equ    caseascii-cases
  1390.  
  1391.     mov    a,b
  1392.     fputbyte @D,@A
  1393.     jmp    casend
  1394.  
  1395. ;{pairs}    80..E7h: decode the pair as b,c
  1396. ;             fputbyte(b,outfile)
  1397. ;             fputbyte(c,outfile)
  1398. casepair:
  1399. topair    equ    casepair-cases
  1400.  
  1401.     mov    a,b
  1402.     call    decode    ; decode A to B,C
  1403.     mov    a,b
  1404.     fputbyte @D,@A
  1405.     mov    a,c
  1406.     fputbyte @D,@A
  1407.     jmp    casend
  1408.  
  1409. ;{nonascii} E8h    : next := fgetbyte(infile)
  1410. ;             fputbyte(next,outfile)
  1411. casenonasc:
  1412. tononasc equ    casenonasc-cases
  1413.  
  1414.     fgetbyte infile
  1415.     fputbyte @D,@A
  1416.     jmp    casend
  1417.  
  1418. ;{CRLF}     E9h    : fputbyte(CR,outfile)
  1419. ;             fputbyte(LF,outfile)
  1420. casecrlf:
  1421. tocrlf    equ    casecrlf-cases
  1422.  
  1423.     mvi    a,AsciiCR
  1424.     fputbyte @D,@A
  1425.     mvi    a,AsciiLF
  1426.     fputbyte @D,@A
  1427.     jmp    casend
  1428.  
  1429. ;(CLTAB}    EAh    : fputbyte(CR,outfile)
  1430. ;             fputbyte(LF,outfile)
  1431. ;             fputbyte(TAB,outfile)
  1432. casecltab:
  1433. tocltab equ    casecltab-cases
  1434.  
  1435.     mvi    a,AsciiCR
  1436.     fputbyte @D,@A
  1437.     mvi    a,AsciiLF
  1438.     fputbyte @D,@A
  1439.     mvi    a,AsciiTAB
  1440.     fputbyte @D,@A
  1441.     jmp    casend
  1442.  
  1443. ;{runcode}  F0..FFh: n := 2 + low four bits of next
  1444. ;             next := fgetbyte(infile)
  1445. ;             do n times: fputbyte(next,outfile)
  1446. caserun:
  1447. torun    equ    caserun-cases
  1448.  
  1449.     mov    a,b
  1450.     ani    0Fh    ; A = low bits of runcode
  1451.     adi    2    ; ..plus 2
  1452.     mov    b,a    ; save loop count in B
  1453.     fgetbyte infile
  1454. running:
  1455.     fputbyte @D,@A
  1456.     djnz    running
  1457.     jmp    casend
  1458.  
  1459. ; the "impossible" input is also a case
  1460. caserror:
  1461. toerror equ    caserror-cases
  1462.     abort    ,impossible
  1463.  
  1464. ;    end case.
  1465. casend:
  1466.  
  1467. ;    next := fgetbyte(infile)
  1468.     fgetbyte infile
  1469.     mov    b,a
  1470.  
  1471. ;until (next = EFh)
  1472.     cpi    EndFlag
  1473.     jnz    toploop
  1474.  
  1475.     pop    h
  1476.     pop    d
  1477.     pop    b
  1478.     pop    psw
  1479.     ret
  1480.  
  1481. ;===============================================================
  1482. ; decode(paircode in A to characters in B, C) -- decoding is
  1483. ; done by using the values in the paircode to index tables of
  1484. ; letters.  The code is 1aaaabbb.  The first letter of the pair
  1485. ; is firstab[aaaa] while the second is followtab[aaaa,bbb].
  1486.  
  1487.     dseg
  1488. firstab:
  1489.     db    ' etaoinshrdlu'
  1490. followtab:
  1491.     db    't aiocsw'
  1492.     db    ' rsndcmt'
  1493.     db    'h eorias'
  1494.     db    'nt lrmcs'
  1495.     db    ' nrfupmd'
  1496.     db    'ntsclofg'
  1497.     db    ' dtgeaso'
  1498.     db    ' tesia.u'
  1499.     db    'ea iotr.'
  1500.     db    'ea oisty'
  1501.     db    ' eios.a,'
  1502.     db    'e lioydv'
  1503.     db    'tslrmned'
  1504.     cseg
  1505. decode:
  1506.     push    h
  1507.     push    psw    ; save copy of paircode
  1508.  
  1509. ; get the 4-bit number "aaaa" to the low four bits of the
  1510. ; register and isolate it.
  1511.     rar ! rar ! rar
  1512.     ani    0Fh
  1513.  
  1514. ; use it to select the first letter
  1515.     lxi    h,firstab
  1516.     addhla
  1517.     mov    b,m
  1518.  
  1519. ; use the whole 7-bits aaaabbb to index the 2nd letter
  1520.     pop    psw
  1521.     ani    7Fh    ; get rid of high bit
  1522.     lxi    h,followtab
  1523.     addhla
  1524.     mov    c,m
  1525.  
  1526.     pop    h
  1527.     ret
  1528. aaabbb to index the 2nd letter
  1529.     pop    psw
  1530.     ani    7Fh    ; get rid of high bit
  1531.     lxi    h,followtab
  1532.     addhla
  1533.     ;===============================================================
  1534. ;
  1535. ;        TABBIT    input  output
  1536. ;
  1537. ; Reads an ASCII file and converts sequences of blanks to tabs
  1538. ; wherever possible.  Also deletes trailing blanks on a line.
  1539. ;
  1540. ; Abort messages
  1541. ;    file-open messages
  1542. ;    usage message
  1543. ;
  1544. ; Modules
  1545. ;    CHKOPS
  1546. ;    OPENUT (OPENIN, OPENOU)
  1547. ;
  1548. ; History
  1549. ; Initial code 6 July 1984
  1550. ; Copyright (C) 1985 M&T Publishing Co. all rights reserved
  1551. ;===============================================================
  1552.  
  1553.     maclib    environ
  1554.  
  1555.     dseg
  1556. usage:
  1557.  db AsciiTAB,'TABBIT  infile  outfile'
  1558.  db AsciiCR,AsciiLF
  1559.  db 'Tabbit reads the input file and converts sequences of'
  1560.  db AsciiCR,AsciiLF
  1561.  db 'blanks to tabs where possible.  It also deletes blanks'
  1562.  db AsciiCR,AsciiLF
  1563.  db 'at the ends of lines.'
  1564.  db AsciiCR,AsciiLF
  1565.  db 'The input file should be all-ASCII, and its data should'
  1566.  db AsciiCR,AsciiLF
  1567.  db 'not be intended for further processing before printing.'
  1568.  db AsciiCR,AsciiLF,'$'
  1569.  
  1570. input:    filedef 128    ; small input buffer
  1571.  
  1572. output: filedef 16384    ; big output buffer for speed
  1573.  
  1574.     cseg
  1575.     prolog
  1576.  
  1577.     extrn    CHKOPS,OPENIN,OPENOU
  1578.  
  1579.     mvi    b,1    ; at least one operand
  1580.     mvi    c,2    ; but not more than 2
  1581.     lxi    d,usage
  1582.     call    CHKOPS    ; chkops(min,max,usage)
  1583.  
  1584.     mvi    a,1    ; 1st operand is input
  1585.     lxi    d,input
  1586.     call    OPENIN
  1587.  
  1588.     mvi    a,2    ; 2nd is output (may be null)
  1589.     lxi    b,input ; default filespec is "input"
  1590.     lxi    d,output
  1591.     call    OPENOU
  1592.  
  1593.     call    Process ; do the main loop
  1594.     fclose    output    ; close the output file
  1595.     ret        ; and end
  1596.  
  1597. ;======= Body of program (from pseudo-code) ========
  1598. Process:
  1599.  
  1600. ;.column := 0
  1601.  
  1602.     lxi    b,0    ; carry column in BC
  1603.     lxi    d,input ; carry DE->input file
  1604.  
  1605. ;.repeat
  1606. mainloop:
  1607.  
  1608. ;.....x := fgetchar(input)
  1609.  
  1610.     fgetchar @D
  1611.  
  1612. ;.....count := 0
  1613.  
  1614.     lxi    h,0    ; count in HL
  1615.  
  1616. ;.....while (x = AsciiBlank)
  1617. readblank:
  1618.     cpi    AsciiBlank
  1619.     jnz    notblank
  1620.  
  1621. ;.........count := count + 1
  1622. ;.........x := fgetchar(input)
  1623.  
  1624.     inx    h
  1625.     fgetchar @D
  1626.  
  1627. ;.....end while
  1628.     jmp    readblank
  1629. notblank:
  1630.  
  1631. ;.....if (x <> AsciiCR) then
  1632.     cpi    AsciiCR
  1633.     jz    isCR
  1634.     push    psw    ; save the byte "x"
  1635.     push    d    ; save ->input, free up DE
  1636.  
  1637. ;.........n := 8 - ( column mod 8 )
  1638. ; note: since the expression needs only the low bits of
  1639. ; the count, we can reorder it to (-(column mod 8)) + 8
  1640. ; and do it all in the A-register.
  1641.  
  1642.     mov    a,c    ; low-order bits of column
  1643.     ani    0111b    ; A = column mod 8
  1644.     neg    a    ; A = -(column mod 8)
  1645.     adi    8    ; A = (-(column mod 8))+8
  1646.     mov    e,a
  1647.     mvi    d,0    ; DE = 8-(column mod 8)
  1648.  
  1649. ;.........while (count >= n)
  1650. tabloop:
  1651.     cmpbw    @H,@D    ; flags := count-n
  1652.     jc    tabend    ; count < n
  1653.  
  1654. ;.............fputchar(output,AsciiTAB)
  1655.  
  1656.     mvi    a,AsciiTAB
  1657.     fputchar output,@A
  1658.  
  1659. ;.............column := column + n
  1660. ;.............count := count - n
  1661.  
  1662.     ora    a    ; clear carry
  1663.     dsbc    d    ; count := count-n
  1664.     xchg        ; (DE=count, HL=n)
  1665.     dad    b    ; HL = column+n
  1666.     mov b,h !mov c,l; move it back to BC
  1667.     xchg        ; (restore HL=count, DE=junk)
  1668.  
  1669. ;.............n := 8
  1670.  
  1671.     lxi    d,8
  1672.  
  1673. ;.........end while
  1674.     jmp    tabloop
  1675. tabend:
  1676.  
  1677. ;.........while (count > 0)
  1678. blankloop:
  1679.     mov a,h ! ora l ; test HL (count) for zero
  1680.     jz    blankend
  1681.  
  1682. ;.............fputchar(output,AsciiBlank)
  1683.  
  1684.     mvi    a,AsciiBlank
  1685.     fputchar output,@A
  1686.  
  1687. ;.............column := column + 1
  1688. ;.............count := count - 1
  1689.  
  1690.     inx    b
  1691.     dcx    h
  1692.  
  1693. ;.........end while
  1694.     jmp    blankloop
  1695. blankend:
  1696. ;.....end if
  1697.     pop    d
  1698.     pop    psw
  1699. isCR:
  1700.  
  1701. ;.....if (x < AsciiBlank) then { control char }
  1702.     cpi    AsciiBlank
  1703.     jnc    notCC
  1704.  
  1705. ;.........if   (x = AsciiCR) then
  1706. ;..................column := 0
  1707.     cpi    AsciiCR
  1708.     jnz    notCR
  1709.     lxi    b,0
  1710.     jmp    writex
  1711. notCR:
  1712.  
  1713. ;.........elif (x = AsciiBS) and (column > 0) then
  1714. ;..................column := column - 1
  1715.     cpi    AsciiBS
  1716.     jnz    notBS
  1717.     mov    h,a    ; save "x"
  1718.     mov a,b !ora c    ; test column for zero
  1719.     mov    a,h    ; restore "x"
  1720.     jz    writex    ; (column = 0, don't back up)
  1721.     dcx    b
  1722.     jmp    writex
  1723. notBS:
  1724.  
  1725. ;.........elif (x = AsciiTAB) then
  1726. ;..................column := (column OR 0111b) + 1
  1727.     cpi    AsciiTAB
  1728.     jnz    writex
  1729.     mov    h,a    ; save "x"
  1730.     mov    a,c
  1731.     ori    0111b
  1732.     mov    c,a    ; BC = column OR 0111b
  1733.     inx    b    ; ..plus one
  1734.     mov    a,h
  1735.     jmp    writex
  1736. ;.........endif
  1737. notCC:
  1738.  
  1739. ;.....else if (x < AsciiDEL) then { printable }
  1740. ;.........column := column + 1
  1741.     cpi    AsciiDEL
  1742.     jnc    writex
  1743.     inx    b
  1744. ;.....endif
  1745. writex:
  1746.  
  1747. ;.....fputchar(output,x)
  1748.  
  1749.     fputchar output,@A
  1750.  
  1751. ;.until (end of input)
  1752.     cpi    CpmEof
  1753.     jnz    mainloop
  1754.  
  1755.     ret
  1756.     end
  1757. ritex:
  1758.  
  1759. ;.....fputchar(output,x)
  1760.  
  1761.     fputchar output,@A
  1762.  
  1763. ;.until (end of input)
  1764.     cpi    CpmEof;===============================================================
  1765. ;
  1766. ;        UNTAB  infile  outfile    [tabinc]
  1767. ;
  1768. ; Read infile, convert tabs to spaces, write as outfile. Assumes
  1769. ; a regular tab increment of tabinc (default is 8 if [tabinc])
  1770. ; not given.
  1771. ;
  1772. ; Note: the option [tabinc] must be a separate token and must
  1773. ; not contain embedded spaces or commas.
  1774. ;
  1775. ; Abort messages
  1776. ;    file-open messages
  1777. ;    usage message
  1778. ;    "option must be [nn] where "nn" is a decimal
  1779. ;     number between 1 and 255."
  1780. ;
  1781. ; Modules
  1782. ;    CHKOPS
  1783. ;    OPENUT (OPENIN, OPENOU)
  1784. ;
  1785. ; History:
  1786. ; initial code 10 July 84
  1787. ; Copyright (C) 1985 M&T Publishing Co. all rights reserved
  1788. ;===============================================================
  1789.     maclib    environ
  1790.     dseg
  1791. usage:
  1792.  db AsciiTAB,'UNTAB  infile  outfile [nn]'
  1793.  db AsciiCR,AsciiLF
  1794.  db 'Reads ascii file "infile," converts tabs to spaces, and'
  1795.  db AsciiCR,AsciiLF
  1796.  db 'writes "outfile."  Tab-conversion assumes a regular tab'
  1797.  db AsciiCR,AsciiLF
  1798.  db 'increment of "nn" with a default of 8 (normal CP/M) when'
  1799.  db AsciiCR,AsciiLF
  1800.  db 'the option "[nn]" is omitted.'
  1801.  db AsciiCR,AsciiLF
  1802.  db '$'
  1803.  
  1804. infile: filedef 128    ; small input buffer
  1805. outfile: filedef 16384    ; big buffer for speed
  1806.  
  1807. tabincr: ds    1    ; space for tab increment
  1808. opcount: ds    1    ; save number of operands
  1809.  
  1810.     cseg
  1811.  
  1812.     extrn    CHKOPS,OPENIN,OPENOU
  1813.  
  1814.     prolog
  1815.  
  1816. ; chkops(1,3) { one to three operands }
  1817.     mvi    b,1    ; at least one,
  1818.     mvi    c,3    ; not more than 3, operands
  1819.     lxi    d,usage
  1820.     call    CHKOPS    ; check, get count
  1821.     sta    opcount ; ..of operands and save
  1822.  
  1823. ; openin(1,infile) { first names infile }
  1824.     mvi    a,1
  1825.     lxi    d,infile
  1826.     call    OPENIN
  1827.  
  1828. ; openou(2,outfile,infile) { 2nd is null or names outfile }
  1829.     mvi    a,2
  1830.     lxi    d,outfile
  1831.     lxi    b,infile ; (default file)
  1832.     call    OPENOU
  1833.  
  1834. ; extract tab-increment from option to tabincr
  1835.     lda    opcount
  1836.     call    getincr ; do it in a subroutine
  1837.     sta    tabincr
  1838.  
  1839.     call    process ; do the work
  1840.  
  1841.     lxi    d,outfile
  1842.     fclose    @D
  1843.     ret
  1844.  
  1845. ;===============================================================
  1846. ; getincr(op#) returns increment -- extract a number from
  1847. ; the option [incr] if we can find it, return in A.
  1848.  
  1849.     dseg
  1850. badop:
  1851.  db 'option must be [nn] where "nn" is a decimal number'
  1852.  db AsciiCR,AsciiLF
  1853.  db 'between 1 and 255.'
  1854.  db AsciiCR,AsciiLF
  1855.  db '$'
  1856.     cseg
  1857. getincr:
  1858.     push    h
  1859.     push    d
  1860.     push    b
  1861.  
  1862.     tailtokn @A    ; DE->given operand string
  1863.     ldax    d
  1864.     cpi    '['    ; start of option?
  1865.     mvi    a,8    ; (assume not)
  1866.     jnz    default
  1867.  
  1868.     inx    d    ; yes, step over bracket
  1869.     stradbw @Dupdate; extract digits to word in HL
  1870.  
  1871. ; result of stradbw is zero in two cases: if the number
  1872. ; was actually zero ([000]) or if there were no decimal
  1873. ; digits ([abc]).
  1874.  
  1875.     mov a,h ! ora l ; check for zero...
  1876.     abort    z,badop
  1877.     mov a,h ! ora a ; check for HL > 255...
  1878.     abort    nz,badop
  1879.  
  1880.     mov    a,l    ; put increment in A
  1881. default:
  1882.     pop    b
  1883.     pop    d
  1884.     pop    h
  1885.     ret
  1886.  
  1887. ;===============================================================
  1888. ; process: the main loop, after the pseudo-code, moved out of
  1889. ; line for clarity.  As part of the main-line, we don't bother
  1890. ; to save the registers.
  1891.  
  1892. process:
  1893.     lxi    d,0    ; carry "column" in DE
  1894.  
  1895. ; repeat
  1896. procloop:
  1897.  
  1898. ;   x := fgetchar(infile)
  1899.     fgetchar infile
  1900.  
  1901. ;   if (x = AsciiTAB) then
  1902.     cpi    AsciiTAB
  1903.     jnz    notTab
  1904.  
  1905. ;     n := tabincr - (column mod tabincr)
  1906.     lda    tabincr ; A = tabincr = divisor
  1907.     mov h,d ! mov l,e ; HL = column = dividend
  1908.     div816    @H,@A    ; HL = HL/A, A = remainder
  1909.     neg    a    ; A = -(column mod tabincr)
  1910.     lxi    h,tabincr
  1911.     add    m    ; A = tabincr-(column mod tabincr)
  1912.     mov    b,a    ; put in B as loop-count
  1913.  
  1914. ;     do n times: fputchar(output,AsciiBlank)
  1915. ;     column := column + n
  1916.     mvi    a,AsciiBlank
  1917. outblank:
  1918.     fputchar outfile,@A
  1919.     inx    d    ; increment column for each
  1920.     djnz    outblank
  1921. ; note: at the end of this then-section we know we didn't
  1922. ; have CpmEof (we had a tab) so we can short-circuit the
  1923. ; loop test and continue at the top of the loop
  1924.     jmp    procloop
  1925.  
  1926. ;  else
  1927. notTab:
  1928.  
  1929. ;    fputchar(output,x)
  1930.     fputchar outfile,@A
  1931. ;    adjust column for effect of x (from tabbit)
  1932. ;      if (x < AsciiBlank) then { control char }
  1933.     cpi    AsciiBlank
  1934.     jnc    notCC
  1935.  
  1936. ;      if   (x = AsciiCR) then
  1937. ;         column := 0
  1938.     cpi    AsciiCR
  1939.     jnz    notCR
  1940.     lxi    d,0
  1941.     jmp    endloop
  1942. notCR:
  1943.  
  1944. ;      elif (x = AsciiBS) and (column > 0) then
  1945. ;         column := column - 1
  1946.     cpi    AsciiBS
  1947.     jnz    endloop
  1948.     mov    h,a    ; save "x"
  1949.     mov a,d !ora e    ; test column for zero
  1950.     mov    a,h    ; restore "x"
  1951.     jz    endloop ; (column = 0, don't back up)
  1952.     dcx    d
  1953.     jmp    endloop
  1954. notCC:
  1955. ;     else if (x < AsciiDEL) then { printable }
  1956. ;    column := column + 1
  1957.     cpi    AsciiDEL
  1958.     jnc    endloop
  1959.     inx    d
  1960. endloop:
  1961.  
  1962. ; until (x = CpmEof)
  1963.     cpi    CpmEof
  1964.     jnz    procloop
  1965.  
  1966.     ret
  1967. lumn := column + 1
  1968.     cpi    AsciiDEL
  1969.     jnc    endloop
  1970.     inx    d
  1971. endloop:
  1972.     name    'ANTNEW'
  1973. ;===============================================================
  1974. ;
  1975. ;    ANTNEW    antname
  1976. ;
  1977. ; This command creates the 3 files of a new anthology as
  1978. ; antname.ANT, antname.ANX, and antname.ANY.  One (empty) data
  1979. ; record is written to antname.ANT so that it will be visibly
  1980. ; in existence.  One record of all-zeros is written to both
  1981. ; directory files.  This creates a valid directory containing
  1982. ; no information.
  1983. ;
  1984. ; If any file of these names exists, the command terminates
  1985. ; with an error message and does nothing.
  1986. ;
  1987. ; messages:
  1988. ;    usage message
  1989. ;    abort messages of ANTSET (in ANTPRE.ASM)
  1990. ;    abort "You must erase the existing anthology first."
  1991. ;
  1992. ; history:
  1993. ; remember to close the darn files 8/2/84
  1994. ; initial code 8/1/84
  1995. ; Copyright (C) 1985 M&T Publishing Co. all rights reserved
  1996. ;===============================================================
  1997.     maclib    environ
  1998.  
  1999.     common    /ANTCOM/
  2000. ; This common area definition is included in all, or most
  2001. ; anthology programs.  It defines the directory in storage.
  2002. ; The filedefs are assembled in module ANTSUP.
  2003.  
  2004. AntHdr    equ    $    ; following words precede directory
  2005. SizeR    ds    2    ; size of array R (128-multiple)
  2006. SpanR    ds    2    ; # of 128-byte records over R
  2007. SizeF    ds    2    ; size of array FS (ditto)
  2008. SpanF    ds    2    ; # of 128-byte records over FS
  2009. AlFiles ds    2    ; count of allocated files
  2010. Frecs    ds    2    ; count of free records
  2011. AntHdrLen equ    $-AntHdr ; bytes written at head of file
  2012. Base    ds    2    ; ->base of dir. (array R)
  2013. TopR    ds    2    ; ->low free byte
  2014. BotF    ds    2    ; ->bottom byte of FS
  2015. TopF    ds    2    ; ->byte after directory
  2016.  
  2017. SizeDir equ    16384    ; in-core size of directory
  2018. FSsize    equ    14    ; offset to size in FS entry
  2019. FSlen    equ    16    ; size of an FS entry
  2020.  
  2021. AntDat    ds    FcrLen    ; data file antname.ANT
  2022. AntDirX ds    FcrLen    ; directory copy antname.ANX
  2023. AntDirY ds    FcrLen    ; directory copy antname.ANY
  2024. AntSeq    ds    FcrLen    ; sequential file in/out
  2025.     cseg ; end of common
  2026.  
  2027.     dseg
  2028. record    ds    128    ; link will fill with zeros
  2029.  
  2030. exists:
  2031.   strconst 'You must erase the existing anthology first.$'
  2032.  
  2033. usage:
  2034.   db AsciiTAB
  2035.   db 'ANTNEW  antname'
  2036.   db AsciiCR,AsciiLF
  2037.   db 'Creates a new anthology as "antname."  That operand'
  2038.   db AsciiCR,AsciiLF
  2039.   db 'must be a valid filename, and may contain a drive letter'
  2040.   db AsciiCR,AsciiLF
  2041.  if CpmLevel gt 22h
  2042.   db 'and/or a file password'
  2043.   db AsciiCR,AsciiLF
  2044.  endif
  2045.   db 'but a filetype is not necessary and will be ignored.'
  2046.   db AsciiCR,AsciiLF
  2047.   db 'Any existing anthology of that name on that drive must'
  2048.   db AsciiCR,AsciiLF
  2049.   db 'erased by you before; this command won''t replace it.'
  2050.   db '$'
  2051.     cseg
  2052.  
  2053.     extrn    ANTSET
  2054.  
  2055.     prolog
  2056.     lxi    d,usage
  2057.     call    ANTSET    ; returns token-count
  2058.     cpi    2    ; if we got more than 1,
  2059.     abort    nc,usage ; quit with usage message
  2060.  
  2061.     lxi    d,AntDat
  2062.     call    makeit
  2063.     lxi    d,AntDirX
  2064.     call    makeit
  2065.     lxi    d,AntDirY
  2066.     call    makeit
  2067.  
  2068.     ret
  2069.  
  2070. makeit: ; test DE->file to see if it exists, and create it
  2071.  
  2072.     freset    @D
  2073.     abort    nz,exists
  2074.  
  2075.     frewrite @D
  2076.     fputblok @D,record,128
  2077.     fclose    @D
  2078.     ret
  2079.  
  2080.     end
  2081. f it exists, and create it
  2082.  
  2083.     freset    @D
  2084.     abort    nz;===============================================================
  2085. ;
  2086. ;    ANTDIR    antname  filename.typ
  2087. ;
  2088. ; Lists selected (or all, if "filename.typ" is omitted) members
  2089. ; of anthology "antname."  The display has one line per member,
  2090. ; showing the member's size in 128-byte records and its name.
  2091. ; It is followed by a summary line showing total records for
  2092. ; the members displayed, total allocated to the anthology, and
  2093. ; total allocated but not in use.
  2094. ;
  2095. ; messages:
  2096. ;    aborts from ANTSET, ANTOPE, ANTLOA, ANTMRK
  2097. ;    usage message
  2098. ; history:
  2099. ; initial code 6 August 1984
  2100. ; Copyright (C) 1985 M&T Publishing Co. all rights reserved
  2101. ;===============================================================
  2102.     maclib    environ
  2103.     extrn    ANTSET,ANTOPE,ANTLOA,ANTMRK,ANTNMK
  2104.  
  2105.     common    /ANTCOM/
  2106. ; This common area definition is included in all, or most
  2107. ; anthology programs.  It defines the directory in storage.
  2108. ; The filedefs are assembled in module ANTSUP.
  2109.  
  2110. AntHdr    equ    $    ; following words precede directory
  2111. SizeR    ds    2    ; size of array R (128-multiple)
  2112. SpanR    ds    2    ; # of 128-byte records over R
  2113. SizeF    ds    2    ; size of array FS (ditto)
  2114. SpanF    ds    2    ; # of 128-byte records over FS
  2115. AlFiles ds    2    ; count of allocated files
  2116. Frecs    ds    2    ; count of free records
  2117. AntHdrLen equ    $-AntHdr ; bytes written at head of file
  2118. Base    ds    2    ; ->base of dir. (array R)
  2119. TopR    ds    2    ; ->low free byte
  2120. BotF    ds    2    ; ->bottom byte of FS
  2121. TopF    ds    2    ; ->byte after directory
  2122.  
  2123. SizeDir equ    16384    ; in-core size of directory
  2124. FSsize    equ    14    ; offset to size in FS entry
  2125. FSlen    equ    16    ; size of an FS entry
  2126.  
  2127. AntDat    ds    FcrLen    ; data file antname.ANT
  2128. AntDirX ds    FcrLen    ; directory copy antname.ANX
  2129. AntDirY ds    FcrLen    ; directory copy antname.ANY
  2130. AntSeq    ds    FcrLen    ; sequential file in/out
  2131.     cseg ; end of common
  2132.  
  2133.     dseg
  2134. totrecs dw    0    ; count of records listed
  2135. screen: msgfile
  2136.  
  2137. header: strconst <AsciiCR,'records  filename',AsciiCR,AsciiCR>
  2138. divide: strconst <'--------',AsciiCR>
  2139. lpof:    strconst ' (of'
  2140. inuse:    strconst ' in use;'
  2141. unused: strconst ' allocated and unused)'
  2142.  
  2143. usage:
  2144.  db AsciiTAB,'ANTDIR  antname  filename.typ'
  2145.  db AsciiCR,AsciiLF
  2146.  db 'Displays the names of files held in anthology "antname."'
  2147.  db AsciiCR,AsciiLF
  2148.  db 'If the second operand is omitted, all files are shown.'
  2149.  db AsciiCR,AsciiLF
  2150.  db 'The second operand may use CP/M-style wildcards.'
  2151.  db AsciiCR,AsciiLF,'$'
  2152.     cseg
  2153.  
  2154.     prolog
  2155. ; Set up the anthology files for use, and find out how many
  2156. ; command tokens there are.  We support either 1 or 2 -- if
  2157. ; there is but 1, a request for the 2nd one will get us the
  2158. ; null string instead, which ANTMRK can handle.
  2159.  
  2160.     lxi    d,usage
  2161.     call    ANTSET
  2162.     cpi    3
  2163.     abort    nc,usage
  2164.  
  2165. ; Get the directory open and ready for use.
  2166.  
  2167.     call    ANTOPE
  2168.     call    ANTLOA
  2169.  
  2170. ; Display a blank line and the column-header.
  2171.  
  2172.     fputstr screen,header
  2173.  
  2174. ; Mark all the members of interest, returning the count in HL.
  2175. ; If there are zero matches, proceed direct to the totals line.
  2176.  
  2177.     lxi    h,0
  2178.     shld    totrecs     ; clear total records
  2179.     tailtokn 2
  2180.     call    ANTMRK
  2181.     mov b,h ! mov c,l    ; set up count in BC
  2182.     mov a,b ! ora c     ; is count zero?
  2183.     jz    lastline    ; (yes, skip the details)
  2184.  
  2185. ; Display detail lines for all the marked members.
  2186.  
  2187.     lhld    TopF        ; Scan from oldest down
  2188. loop:
  2189.     call    ANTNMK        ; HL->next marked entry down
  2190.     call    detail        ; display it
  2191.     dcx    b        ; count it
  2192.     mov a,b ! ora c     ; and if there are more,
  2193.     jnz    loop        ; ..continue
  2194.  
  2195. ; Display the totals.
  2196.  
  2197. lastline:
  2198.     call    totals
  2199.     ret
  2200.  
  2201.  
  2202. ; Display(HL->entry): display the size and name of this
  2203. ; member -- the size as a decimal number in a 7-byte field,
  2204. ; a space, and the filename.
  2205.  
  2206. detail:
  2207.     push    psw
  2208.     push    d
  2209.     push    h
  2210.  
  2211.     lxi    d,FSsize
  2212.     dad    d        ; HL->S[f]
  2213.     mov a,m ! inx h
  2214.     mov h,m ! mov l,a    ; HL = S[f]
  2215.     xchg
  2216.     lhld    totrecs
  2217.     dad    d        ; accumulate total
  2218.     shld    totrecs
  2219.     xchg
  2220.  
  2221.     lxi    d,screen
  2222.     mvi    a,7        ; field-width
  2223.     fputbwad @D,@H,@A    ; write number
  2224.     fputchar @D,AsciiBlank    ; one space
  2225.     pop    h        ; HL->filename string
  2226.     fputline @D,@H        ; finish the line
  2227.  
  2228.     pop    d
  2229.     pop    psw
  2230.     ret
  2231.  
  2232. ; Totals: display "rrrr (of tttt; fff allocated but unused)"
  2233.  
  2234. totals:
  2235.     lxi    d,screen
  2236.     lxi    h,divide
  2237.     fputstr @D,@H        ; divider below bytes column
  2238.  
  2239.     lhld    totrecs     ; display total records
  2240.     mvi    a,7        ; ..in 7-byte field
  2241.     fputbwad @D,@H,@A
  2242.  
  2243.     lxi    h,lpof
  2244.     fputstr @D,@H        ; nnnnn (of
  2245.  
  2246.     lhld    SizeR        ; total allocated is SizeR/2
  2247.     xra    a        ; (clear carry, field size 0)
  2248.     rarr    h
  2249.     rarr    l        ; 0 >> H >> L
  2250.     fputbwad @D,@H,@A    ; .ANT size in minimum width
  2251.  
  2252.     lxi    h,inuse
  2253.     fputstr @D,@H
  2254.  
  2255.     lhld    Frecs        ; total allocated-but-unused
  2256.     fputbwad @D,@H,@A
  2257.  
  2258.     lxi    h,unused
  2259.     fputline @D,@H
  2260.  
  2261.     ret
  2262.  
  2263.     end
  2264. tstr @D,@H
  2265.  
  2266.     lhld    Frecs        ; total allocated-but-unused
  2267.     fputbwad @D,@H,@A
  2268.  
  2269.     lxi    h,unused
  2270.     fputline;===============================================================
  2271. ;
  2272. ;    ANTGET    antname  filespec
  2273. ;
  2274. ; Retrieves selected members of anthology "antname."  When the
  2275. ; "filespec" operand is ambiguous, retrieves each matching
  2276. ; member-name.    The drivecode and password of "filespec" apply
  2277. ; to all members retrieved.
  2278. ;
  2279. ; messages:
  2280. ;    FILESPEC...done
  2281. ;    No matching files.
  2282. ;    aborts from ANTSET, ANTOPE, ANTLOA, ANTMRK
  2283. ;    usage message
  2284. ; history:
  2285. ; initial code 7 August 1984
  2286. ; Copyright (C) 1985 M&T Publishing Co. all rights reserved
  2287. ;===============================================================
  2288.     maclib    environ
  2289.     extrn    ANTSET    ; set up operands
  2290.     extrn    ANTOPE    ; open anthology files
  2291.     extrn    ANTLOA    ; load directory
  2292.     extrn    ANTMRK    ; mark matching files
  2293.     extrn    ANTNMK    ; get next marked file
  2294.     extrn    ANTND    ; next data record number
  2295.     extrn    ANTOUT    ; copy record to AntSeq
  2296.  
  2297.     common    /ANTCOM/
  2298. ; This common area definition is included in all, or most
  2299. ; anthology programs.  It defines the directory in storage.
  2300. ; The filedefs are assembled in module ANTSUP.
  2301.  
  2302. AntHdr    equ    $    ; following words precede directory
  2303. SizeR    ds    2    ; size of array R (128-multiple)
  2304. SpanR    ds    2    ; # of 128-byte records over R
  2305. SizeF    ds    2    ; size of array FS (ditto)
  2306. SpanF    ds    2    ; # of 128-byte records over FS
  2307. AlFiles ds    2    ; count of allocated files
  2308. Frecs    ds    2    ; count of free records
  2309. AntHdrLen equ    $-AntHdr ; bytes written at head of file
  2310. Base    ds    2    ; ->base of dir. (array R)
  2311. TopR    ds    2    ; ->low free byte
  2312. BotF    ds    2    ; ->bottom byte of FS
  2313. TopF    ds    2    ; ->byte after directory
  2314.  
  2315. SizeDir equ    16384    ; in-core size of directory
  2316. FSsize    equ    14    ; offset to size in FS entry
  2317. FSlen    equ    16    ; size of an FS entry
  2318.  
  2319. AntDat    ds    FcrLen    ; data file antname.ANT
  2320. AntDirX ds    FcrLen    ; directory copy antname.ANX
  2321. AntDirY ds    FcrLen    ; directory copy antname.ANY
  2322. AntSeq    ds    FcrLen    ; sequential file in/out
  2323.     cseg ; end of common
  2324.  
  2325.     dseg
  2326. screen: msgfile
  2327. nofile: strconst 'No matching files.'
  2328. dots:    strconst '...'
  2329. done:    strconst <'done',AsciiCR>
  2330.  
  2331. usage:
  2332.  db AsciiTAB,'ANTGET  antname  filespec'
  2333.  db AsciiCR,AsciiLF
  2334.  db 'Retrieves the members that match "filespec" from anthology'
  2335.  db AsciiCR,AsciiLF
  2336.  db '"antname" as independent files.  The drive and password of'
  2337.  db AsciiCR,AsciiLF
  2338.  db '"filespec" apply to all members retrieved.'
  2339.  db AsciiCR,AsciiLF,'$'
  2340.     cseg
  2341.  
  2342.     prolog
  2343. ; Set up the anthology files for use, and find out how many
  2344. ; command tokens there are.  We require 2.
  2345.  
  2346.     lxi    d,usage
  2347.     call    ANTSET
  2348.     cpi    2
  2349.     abort    nz,usage
  2350.  
  2351. ; Get the directory open and ready for use.
  2352.  
  2353.     call    ANTOPE
  2354.     call    ANTLOA
  2355.  
  2356. ; Mark all the members of interest, returning the count in HL.
  2357. ; If there are zero matches, say so and exit.
  2358.  
  2359.     tailtokn 2        ; DE->operand string
  2360.     call    ANTMRK
  2361.     mov b,h ! mov c,l    ; set up count in BC
  2362.     mov a,b ! ora c     ; is count zero?
  2363.     jnz    gotsome     ; (no, proceed)
  2364.     lxi    d,screen
  2365.     lxi    h,nofile
  2366.     fputline @D,@H
  2367.     jmp    fini
  2368.  
  2369. ; Copy out all the marked members.
  2370.  
  2371. gotsome:
  2372.     lxi    d,screen
  2373.     lhld    TopF        ; Scan from oldest down
  2374. loop:
  2375.     call    ANTNMK        ; HL->next marked entry down
  2376.     fputstr @D,@H
  2377.     fputstr @D,dots     ; document our progress
  2378.     call    copy        ; copy the file
  2379.     fputstr @D,done
  2380.     dcx    b        ; count it
  2381.     mov a,b ! ora c     ; and if there are more,
  2382.     jnz    loop        ; ..continue
  2383.  
  2384. fini:
  2385.     ret
  2386.  
  2387. ; Copy(HL->entry): Set up AntSeq with the filename and type
  2388. ; from the entry, and open it for output.  Then copy all its
  2389. ; records from the .ANT data file.
  2390.  
  2391. copy:
  2392.     push    psw
  2393.     push    b
  2394.     push    d
  2395.     push    h
  2396.  
  2397.     lxi    d,AntSeq
  2398.     fassign @D,@H,,0110b ; assign filename and type only
  2399.     frewrite @D        ; prepare for output
  2400.  
  2401. ;    nrecs := S[f]
  2402. ;    recno := 0
  2403. ;    while (nrecs > 0)
  2404. ;        recno := nextdat(f,recno)
  2405. ;        copyout(recno)
  2406. ;        nrecs := nrecs - 1
  2407. ;    end while
  2408.  
  2409.     lxi    d,FSsize
  2410.     dad    d        ; HL->S[f]
  2411.     mov c,m ! inx h
  2412.     mov b,m         ; BC=S[f]
  2413.     pop h ! push h        ; restore HL->F[f]
  2414.  
  2415.     lxi    d,0        ; DE holds record number
  2416.  
  2417. coploop:
  2418.     mov a,b ! ora c
  2419.     jrz    copover
  2420.     call    ANTND
  2421.     call    ANTOUT
  2422.     dcx    b
  2423.     jmp    coploop
  2424.  
  2425. copover:
  2426.     lxi    d,AntSeq
  2427.     fclose    @D
  2428.     pop    h
  2429.     pop    d
  2430.     pop    b
  2431.     pop    psw
  2432.     ret
  2433.  
  2434.     end
  2435. ND
  2436.     call    ANTOU    name    'ANTPUT'
  2437. ;===============================================================
  2438. ;
  2439. ;    ANTPUT    antname  filespec
  2440. ;
  2441. ; Adds all files that match "filespec" to anthology "antname,"
  2442. ; replacing any that already exist there.
  2443. ;
  2444. ; messages
  2445. ;    usage message
  2446. ;    FRUMMAGE...checking...done
  2447. ;    FRUMMAGE is not a valid filespec
  2448. ;    FRUMMAGE -- no disk file found
  2449. ;    FRUMMAGE -- anthology files may not be put in one
  2450. ;    aborts from ANTLOA, ANTSAV, ANTPRE (ANTSET and
  2451. ;    ANTOPE), and ANTSUP (ANTADD, ANTFRE, ANTNF, ANTINP)
  2452. ;
  2453. ;
  2454. ; history
  2455. ; initial code 8/2/84
  2456. ; Copyright (C) 1985 M&T Publishing Co. all rights reserved
  2457. ;===============================================================
  2458.  
  2459.     maclib    environ
  2460.  
  2461.     extrn    ANTSET    ; set up antname
  2462.     extrn    ANTOPE    ; open anthology files
  2463.     extrn    ANTLOA    ; load directory
  2464.     extrn    ANTFIN    ; lookup filename
  2465.     extrn    ANTFRE    ; free records of a file
  2466.     extrn    ANTADD    ; add filename
  2467.     extrn    ANTND    ; next owned record of f
  2468.     extrn    ANTNF    ; next free record for f
  2469.     extrn    ANTINP    ; copy record into anth.
  2470.     extrn    ANTSAV    ; commit directory to disk
  2471.  
  2472.     common    /ANTCOM/
  2473. ; This common area definition is included in all, or most
  2474. ; anthology programs.  It defines the directory in storage.
  2475. ; The filedefs are assembled in module ANTSUP.
  2476.  
  2477. AntHdr    equ    $    ; following words precede directory
  2478. SizeR    ds    2    ; size of array R (128-multiple)
  2479. SpanR    ds    2    ; # of 128-byte records over R
  2480. SizeF    ds    2    ; size of array FS (ditto)
  2481. SpanF    ds    2    ; # of 128-byte records over FS
  2482. AlFiles ds    2    ; count of allocated files
  2483. Frecs    ds    2    ; count of free records
  2484. AntHdrLen equ    $-AntHdr ; bytes written at head of file
  2485. Base    ds    2    ; ->base of dir. (array R)
  2486. TopR    ds    2    ; ->low free byte
  2487. BotF    ds    2    ; ->bottom byte of FS
  2488. TopF    ds    2    ; ->byte after directory
  2489.  
  2490. SizeDir equ    16384    ; in-core size of directory
  2491. FSsize    equ    14    ; offset to size in FS entry
  2492. FSlen    equ    16    ; size of an FS entry
  2493.  
  2494. AntDat    ds    FcrLen    ; data file antname.ANT
  2495. AntDirX ds    FcrLen    ; directory copy antname.ANX
  2496. AntDirY ds    FcrLen    ; directory copy antname.ANY
  2497. AntSeq    ds    FcrLen    ; sequential file in/out
  2498.     cseg ; end of common
  2499.  
  2500.     dseg
  2501.  
  2502. screen: msgfile
  2503.  
  2504. usage:
  2505.  db AsciiTAB,'ANTPUT antname filespec'
  2506.  db AsciiCR,AsciiLF
  2507.  db 'Adds all files that match "filespec" to the anthology'
  2508.  db AsciiCR,AsciiLF
  2509.  db 'named "antname." Files that already exist in the anthology'
  2510.  db AsciiCR,AsciiLF
  2511.  db 'are replaced.$'
  2512.     cseg
  2513.  
  2514. ;===============================================================
  2515. ; Main line of ANTPUT.
  2516.  
  2517.     prolog
  2518.     lxi    d,usage
  2519.     call    ANTSET
  2520.     cpi    2    ; require 2 operands
  2521.     abort    nz,usage
  2522.  
  2523.     call    ANTOPE    ; open all 3 files
  2524.     call    ANTLOA    ; load the directory
  2525.  
  2526.     tailtokn 2
  2527.     call    listall ; list all files, A := count
  2528.     ora    a    ; any file found?
  2529.     rz        ; (no, we're done)
  2530.     mov    b,a    ; yes, set loop count
  2531. Putloop:
  2532.     call    setnext ; set up next file
  2533.     call    doput    ; ..and bring it in
  2534.     djnz    PutLoop
  2535.  
  2536.     call    ANTSAV
  2537. Putover:
  2538.     ret
  2539.  
  2540. ;===============================================================
  2541. ; Listall(DE->operand): Check the operand string and prepare an
  2542. ; array of ready filedefs, one for every matching disk file.
  2543. ; Return the count of files in A.
  2544.  
  2545.     dseg
  2546. listbase dw    0    ; ->found files
  2547. listptr dw    0    ; ->next file
  2548. maxfile equ    100    ; most files we allow (less than 256)
  2549. specsize equ    13    ; max length of "filename.typ"
  2550. listsize equ    specsize*maxfile ; space for maximum list
  2551. workfile filedef 128    ; filedef to receive names
  2552. ngspec: strconst ' is not a valid filespec.'
  2553. nomatch: strconst ' -- no disk file found.'
  2554. operand: dw    0    ; ->command operand
  2555.     cseg
  2556.  
  2557. Listall:
  2558.     push    b
  2559.     push    d
  2560.     push    h
  2561.  
  2562. ; Assign the operand to AntSeq, which puts its drivecode and
  2563. ; password there permanently, and also prepares AntSeq as the
  2564. ; input to fdirbegn and fdircont.
  2565.  
  2566.     xchg        ; HL->string
  2567.     shld    operand ; (save for later msgs)
  2568.     lxi    d,AntSeq
  2569.     fassign @D,@H
  2570.     jnz    LA1    ; (it was ok)
  2571.     lxi    d,screen
  2572.     fputstr @D,@Hupdate
  2573.     lxi    h,ngspec
  2574.     fputline @D,@Hupdate
  2575.     xra    a    ; count of zero
  2576.     jmp    LAdone
  2577.  
  2578. ; Allocate space to hold maxfile filedefs and save its address
  2579. LA1:    lxi    b,listsize
  2580.     dslow    @B
  2581.     shld    listbase
  2582.     shld    listptr
  2583.  
  2584. ; Search the disk directory for the first (or only) file that
  2585. ; matches AntSeq.  If none are found, display a message and
  2586. ; return a count of zero.
  2587.  
  2588.     lxi    h,workfile    ; target filedef
  2589.     fdirbegn @D,@H        ; find and assign
  2590.     jnz    LA2        ; (there is at least 1)
  2591.     lxi    d,screen
  2592.     lhld    operand
  2593.     fputstr @D,@Hupdate
  2594.     lxi    h,nomatch
  2595.     fputline @D,@Hupdate
  2596.     xra    a
  2597.     jmp    LAdone
  2598.  
  2599. ; At least one matching file was found.  In this loop, save
  2600. ; the filename.typ string of the matching file in a list
  2601. ; and try for another.
  2602. LA2:
  2603.     mvi    b,0        ; initial count of found
  2604.     lhld    listbase    ; carry target in HL
  2605. LAloop:
  2606.     inr    b        ; count this file
  2607.     mvi    a,maxfile
  2608.     cmp    b        ; don't go too far!
  2609.     jz    LAloopz     ; (found max, stop)
  2610.     mvi    m,0        ; make a null string
  2611.     fgetspec workfile,@Hupdate,0110b ; (name and type)
  2612.     inx    h        ; step over null to next string
  2613.     fdircont AntSeq,workfile ; try for another
  2614.     jnz    LAloop
  2615. LAloopz:
  2616.  
  2617. ; Ok, we found B files and listptr->the first one.
  2618.     mov    a,b        ; put count in A
  2619. LAdone:
  2620.     pop    h
  2621.     pop    d
  2622.     pop    b
  2623.     ret
  2624.  
  2625. ;===============================================================
  2626. ; setnext: assign the next filename.typ from our list into the
  2627. ; AntSeq filedef ready to use.
  2628.  
  2629. setnext:
  2630.     push    d
  2631.     push    h
  2632.     lxi    d,AntSeq
  2633.     lhld    listptr
  2634.     fassign @D,@Hupdate,,0110b ; assign name.typ only
  2635.     inx    h    ; step over null to next string
  2636.     shld    listptr
  2637.     pop    h
  2638.     pop    d
  2639.     ret
  2640.  
  2641. ;===============================================================
  2642. ; doput: put one file into the anthology.  The file has been
  2643. ; checked as valid and unambiguous, has been assigned to AntSeq,
  2644. ; and is known to be a real disk file.
  2645.  
  2646.     dseg
  2647. fstr:    strspace 12    ; room for "filename.typ"
  2648. type:    strspace 4    ; room for just ".typ"
  2649. dots:    strconst '...'
  2650. chkg:    strconst 'checking...'
  2651. done:    strconst 'done'
  2652. isant:    strconst ' -- anthology files may not be put in one.'
  2653. typetab: strtable 3
  2654.     strentry '.ANT'
  2655.     strentry '.ANX'
  2656.     strentry '.ANY'
  2657.     cseg
  2658.  
  2659. doput:
  2660.     push    psw
  2661.     push    b
  2662.     push    d
  2663.     push    h
  2664.  
  2665. ; Get the file opened.
  2666.  
  2667.     lxi    d,AntSeq ; DE->filedef
  2668.     freset    @D    ; ..open for input
  2669.  
  2670. ; Extract the "filename.typ" string which will be its
  2671. ; anthology directory key, and ".typ" with which we
  2672. ; can check for an anthology.
  2673.  
  2674.     lxi    h,type
  2675.     mvi    m,0
  2676.     fgetspec @D,@H,0100b    ; just the type
  2677.     lxi    h,fstr    ; HL->string
  2678.     mvi    m,0    ; make that HL->null string
  2679.     fgetspec @D,@H,0110b    ; filename and type
  2680.  
  2681. ; Put up the filename and type on the screen
  2682.  
  2683.     lxi    d,screen
  2684.     fputstr @D,@H    ; put up FRUMMAGE on screen
  2685.  
  2686. ; Check to make sure it isn't part of an anthology.
  2687.  
  2688.     lxi    d,type
  2689.     strlook @D,typetab ; check for illegal types
  2690.     jrnz    notant    ; (it doesn't end in ".AN?")
  2691.  
  2692. ; The file does end in .AN?, complain and give up on it.
  2693.  
  2694.     lxi    d,screen
  2695.     fputline @D,isant ; it does, complain and
  2696.     jmp    DPdone
  2697.  
  2698. ; We have an open file that isn't an anthology.  Put up the
  2699. ; three dots that mean we're reading it.
  2700.  
  2701. notant:
  2702.     lxi    d,screen
  2703.     fputstr @D,dots
  2704.     lxi    d,fstr    ; DE->"filename.typ"
  2705.  
  2706. ;    f := find(fstr)
  2707. ;    if (f=0) then    {it's a new file}
  2708. ;        f := add(fstr)
  2709. ;    else        {it exists already}
  2710. ;        delete(f)
  2711. ;    endif
  2712.  
  2713.     call    ANTFIN    ; find(DE->str) gives HL=f
  2714.     mov a,h ! ora l ; was it found?
  2715.     jnz    DPexists; (yes)
  2716.     call    ANTADD    ; add(DE->str) gives HL=f
  2717.     jmp    DP3
  2718. DPexists:
  2719.     call    ANTFRE    ; free(HL=f)
  2720. DP3:
  2721.  
  2722. ;    recno := 0
  2723. ;    nrecs := 0
  2724. ;    while (not eof(AntSeq)) do
  2725. ;        recno := nextfree(f,recno)
  2726. ;        copyin(recno)
  2727. ;        nrecs := nrecs + 1
  2728. ;    end while
  2729.  
  2730.     lxi    d,0    ; carry recno in DE
  2731.     lxi    b,0    ; carry nrecs in BC
  2732.             ; HL already = f
  2733.  
  2734. DPloop1:
  2735.     feof?    AntSeq
  2736.     jz    DPloop1z
  2737.  
  2738.     call    ANTNF
  2739.     call    ANTINP
  2740.     inx    b
  2741.     jmp    DPloop1
  2742. DPloop1z:
  2743.  
  2744. ;    S[f] := nrecs
  2745.  
  2746.     push    h    ; save ->file entry
  2747.     lxi    d,FSsize
  2748.     dad    d    ; HL->S[f]
  2749.     mov    m,c
  2750.     inx    h
  2751.     mov    m,b    ; ..set to count of records
  2752.     pop    h    ; HL->F[f] again
  2753.  
  2754. ; The "checkpoint" function forces all CP/M-buffered blocks
  2755. ; of a file onto disk and updates the disk directory.
  2756.  
  2757.     fcheckpt AntDat
  2758.  
  2759. ; To check the file, we don't need to "read" it in the sense
  2760. ; of getting each record to a buffer of our own.  The seek
  2761. ; operation refills the filedef buffer to contain the sought
  2762. ; data, so all we have to do is seek to every record.  That
  2763. ; will force re-reading all the disk sectors we wrote to.
  2764.  
  2765.     fputstr screen,chkg
  2766.  
  2767.     lxi    d,0    ; record number in DE
  2768.             ; HL still has "f"
  2769.             ; BC still has S[f]
  2770. DPloop2:
  2771.     mov a,b ! ora c ; while nrec > 0
  2772.     jrz    DPloop2z
  2773.  
  2774.     call    ANTND    ; DE gets next record #
  2775.     xchg        ; move it to HL
  2776.     frecseek AntDat,@H
  2777.     xchg
  2778.     dcx    b
  2779.     jmp    DPloop2
  2780. DPloop2z:
  2781.  
  2782.     fputline screen,done
  2783.  
  2784. DPdone:
  2785.     pop    h
  2786.     pop    d
  2787.     pop    b
  2788.     pop    psw
  2789.     ret
  2790.  
  2791.     end
  2792. H
  2793. ;===============================================================
  2794. ;
  2795. ;    ANTERA    antname  filename.typ
  2796. ;
  2797. ; Deletes selected members of anthology "antname."  When the
  2798. ; "filename.typ" operand is ambiguous, displays each matching
  2799. ; member-name and requests confirmation.
  2800. ;
  2801. ; messages:
  2802. ;    FILENAME.TYP -- delete (y/n)?
  2803. ;    aborts from ANTSET, ANTOPE, ANTLOA, ANTMRK, ANTSAV
  2804. ;    usage message
  2805. ; history:
  2806. ; initial code 6 August 1984
  2807. ; Copyright (C) 1985 M&T Publishing Co. all rights reserved
  2808. ;===============================================================
  2809.     maclib    environ
  2810.     extrn    ANTSET    ; set up operands
  2811.     extrn    ANTOPE    ; open anthology files
  2812.     extrn    ANTLOA    ; load directory
  2813.     extrn    ANTMRK    ; mark matching files
  2814.     extrn    ANTNMK    ; get next marked file
  2815.     extrn    ANTFRE    ; delete a file's records
  2816.     extrn    ANTSAV    ; save the directory.
  2817.  
  2818.     common    /ANTCOM/
  2819. ; This common area definition is included in all, or most
  2820. ; anthology programs.  It defines the directory in storage.
  2821. ; The filedefs are assembled in module ANTSUP.
  2822.  
  2823. AntHdr    equ    $    ; following words precede directory
  2824. SizeR    ds    2    ; size of array R (128-multiple)
  2825. SpanR    ds    2    ; # of 128-byte records over R
  2826. SizeF    ds    2    ; size of array FS (ditto)
  2827. SpanF    ds    2    ; # of 128-byte records over FS
  2828. AlFiles ds    2    ; count of allocated files
  2829. Frecs    ds    2    ; count of free records
  2830. AntHdrLen equ    $-AntHdr ; bytes written at head of file
  2831. Base    ds    2    ; ->base of dir. (array R)
  2832. TopR    ds    2    ; ->low free byte
  2833. BotF    ds    2    ; ->bottom byte of FS
  2834. TopF    ds    2    ; ->byte after directory
  2835.  
  2836. SizeDir equ    16384    ; in-core size of directory
  2837. FSsize    equ    14    ; offset to size in FS entry
  2838. FSlen    equ    16    ; size of an FS entry
  2839.  
  2840. AntDat    ds    FcrLen    ; data file antname.ANT
  2841. AntDirX ds    FcrLen    ; directory copy antname.ANX
  2842. AntDirY ds    FcrLen    ; directory copy antname.ANY
  2843. AntSeq    ds    FcrLen    ; sequential file in/out
  2844.     cseg ; end of common
  2845.  
  2846.     dseg
  2847. screen: confile
  2848. Ambig:    db    0    ; set to '?' if we must prompt
  2849. query:    strconst ' -- delete (y/n)? '
  2850. anslen    equ    10    ; max answer allowed
  2851. answer: strspace anslen
  2852. nofile: strconst 'No matching files.'
  2853.  
  2854. usage:
  2855.  db AsciiTAB,'ANTERA  antname  filename.typ'
  2856.  db AsciiCR,AsciiLF
  2857.  db 'Deletes member "filename.typ" from anthology "antname."'
  2858.  db AsciiCR,AsciiLF
  2859.  db 'If the second operand is ambiguous, each member that'
  2860.  db AsciiCR,AsciiLF
  2861.  db 'matches it is shown and you are asked to confirm its'
  2862.  db AsciiCR,AsciiLF
  2863.  db 'deletion.  Reply Y to delete, anything else to leave it.'
  2864.  db AsciiCR,AsciiLF,'$'
  2865.     cseg
  2866.  
  2867.     prolog
  2868. ; Set up the anthology files for use, and find out how many
  2869. ; command tokens there are.  We require 2.
  2870.  
  2871.     lxi    d,usage
  2872.     call    ANTSET
  2873.     cpi    2
  2874.     abort    nz,usage
  2875.  
  2876. ; Get the directory open and ready for use.
  2877.  
  2878.     call    ANTOPE
  2879.     call    ANTLOA
  2880.  
  2881. ; There is a difference between an explicit filename.typ that
  2882. ; matches one member and an ambiguous one that just happens
  2883. ; to match only one.  ANTMRK doesn't tell us which happened,
  2884. ; so we do a redundant fassign here just to find out if the
  2885. ; operand is ambiguous.
  2886.  
  2887.     tailtokn 2
  2888.     xchg
  2889.     lxi    d,AntSeq
  2890.     fassign @D,@H
  2891.     xchg
  2892.     sta    Ambig        ; = "?" if ambiguous
  2893.  
  2894. ; Mark all the members of interest, returning the count in HL.
  2895. ; If there are zero matches, say so and exit.
  2896.  
  2897.     call    ANTMRK
  2898.     mov b,h ! mov c,l    ; set up count in BC
  2899.     mov a,b ! ora c     ; is count zero?
  2900.     jnz    gotsome     ; (no, proceed)
  2901.     lxi    d,screen
  2902.     lxi    h,nofile
  2903.     fputline @D,@H
  2904.     jmp    done
  2905.  
  2906. ; Delete all the marked members.
  2907.  
  2908. gotsome:
  2909.     lhld    TopF        ; Scan from oldest down
  2910. loop:
  2911.     call    ANTNMK        ; HL->next marked entry down
  2912.     call    confirm     ; get confirmation if nec.
  2913.     cz    delete        ; delete if permitted
  2914.     dcx    b        ; count it
  2915.     mov a,b ! ora c     ; and if there are more,
  2916.     jnz    loop        ; ..continue
  2917.  
  2918. ; Update the directory to disk
  2919.  
  2920.     call    ANTSAV
  2921. done:
  2922.     ret
  2923.  
  2924. ; Confirm(HL->entry): Get confirmation from the user, if
  2925. ; necessary, that this entry should be deleted.
  2926.  
  2927. confirm:
  2928.     push    b
  2929.     push    d
  2930.     push    h
  2931.     lda    ambig
  2932.     cpi    '?'        ; was command ambiguous?
  2933.     jrz    askuser     ; (yes, ask the question)
  2934.     xra    a        ; no, no confirmation needed
  2935.     jr    confirmed
  2936. askuser:
  2937.     lxi    d,screen
  2938.     fputstr @D,@H        ; FILENAME.TYP
  2939.     lxi    h,query
  2940.     fputstr @D,@H        ; ...-- delete (y/n)?
  2941.     lxi    h,answer
  2942.     mvi    m,0        ; clear answer field
  2943.     lxi    b,anslen
  2944.     fgetstr @D,@H,@B
  2945.     mov    a,m
  2946.     toupper @A
  2947.     cpi    'Y'
  2948. confirmed:
  2949.     pop    h
  2950.     pop    d
  2951.     pop    b
  2952.     ret
  2953.  
  2954. ; delete(HL->entry) Free this entry's records, make its name
  2955. ; the null string, and decrement AlFiles.
  2956.  
  2957. delete:
  2958.     call    ANTFRE
  2959.     mvi    m,0
  2960.     push    h
  2961.     lhld    AlFiles
  2962.     dcx    h
  2963.     shld    AlFiles
  2964.     pop    h
  2965.     ret
  2966.  
  2967.     end
  2968. nd decrement AlFiles.
  2969.  
  2970. delete:
  2971.     call    ANTFRE
  2972.     mvi    m,0
  2973.     push    h
  2974.     lhld    AlFiles
  2975.     dcx    h; Copyright (C) 1985 M&T Publishing Co. all rights reserved
  2976.  
  2977. ; HOWBIG: report the size of the transient program area to
  2978. ; the console in decimal and hex -- and show off the
  2979. ; numeric conversion function calls.
  2980.  
  2981.     maclib environ
  2982.     dseg
  2983. string    strspace 40
  2984. msg1    strconst ' ('
  2985. msg2    strconst 'h) bytes of storage free'
  2986. user    confile
  2987.     cseg
  2988.  
  2989.     prolog
  2990.     lxi    b,0        ; HL= space remaining after
  2991.     space?    @B        ; allocation of zero bytes
  2992.     lxi    d,string    ; DE->string area
  2993.     strbwad @Dupdate,@H,0    ; "ddddd
  2994.     strappnd @Dupdate,msg1    ;     (
  2995.     strbwax @Dupdate,@H    ;      xxxx
  2996.     lxi    h,msg2        ;          ) bytes"
  2997.     strappnd @Dupdate,@Hupdate
  2998.     lxi    d,user
  2999.     lxi    h,string
  3000.     fputstr @D,@Hupdate
  3001.     ret
  3002.  
  3003.     end
  3004. x
  3005.     lxi    h,msg2        ;          ) bytes"
  3006.     strappnd @Dupdate,@Hupdate
  3007.     lxi    d,user
  3008.     lxi    h;===============================================================
  3009. ; Copyright (C) 1985 M&T Publishing Co. all rights reserved
  3010. ;
  3011. ;        SQASM  infile outfile
  3012. ;
  3013. ; This utility reads infile (which ought to be an assembly
  3014. ; source file) and deletes from it
  3015. ;    - all blank lines
  3016. ;    - all semicolon comment lines
  3017. ;    - all semicolon comments at ends of lines
  3018. ;    - all redundant whitespace
  3019. ; and writes the remaining lines onto outfile.
  3020. ;
  3021. ; Such crude processing is intended for macro libraries like
  3022. ; ENVIRON.LIB.    Assembly time of a small program that uses
  3023. ; ENVIRON is cut in half by applying sqasm to the macro library.
  3024. ;
  3025. ; This version is implemented using a finite-state automaton;
  3026. ; it replaces a prior version that used spaghetti-jumps to do
  3027. ; the same work.
  3028. ;
  3029.  
  3030.     maclib    environ
  3031.     extrn    CHKOPS    ; checks operands, gives usage msg
  3032.     extrn    OPENIN    ; utility input open module
  3033.     extrn    OPENOU    ; open output with default module
  3034.  
  3035.     dseg
  3036.  
  3037. con    confile     ; for messages
  3038.  
  3039. infile    filedef 1024    ; one-sector input buffer
  3040. outfile filedef 16384    ; huge output buffer for speed
  3041.  
  3042. usage:
  3043.  db 'SQASM squashes assembly source files.  Syntax is:'
  3044.  db AsciiCR,AsciiLF
  3045.  db AsciiTAB,'SQASM infile outfile'
  3046.  db AsciiCR,AsciiLF
  3047.  db 'The output contains the input but stripped of all blank,'
  3048.  db AsciiCR,AsciiLF
  3049.  db 'comment-only and null lines, and of all comments and'
  3050.  db AsciiCR,ASciiLF
  3051.  db 'extra blanks and tabs.'
  3052.  db AsciiCR,AsciiLF
  3053.  db '$'
  3054.  
  3055.     cseg
  3056.     prolog
  3057.  
  3058. ; Save command tokens and check usage
  3059.  
  3060.     mvi    b,1    ; we can live with only "infile"
  3061.     mvi    c,2    ; but max tokens is 2.
  3062.     lxi    d,usage
  3063.     call    CHKOPS
  3064.  
  3065. ; Assign, open input file
  3066.  
  3067.     lxi    d,infile    ; file to assign
  3068.     mvi    a,1        ; operand token number
  3069.     call    OPENIN        ; ..do it
  3070.  
  3071. ; Assign, open output file
  3072.  
  3073.     lxi    b,infile    ; default filespec here
  3074.     lxi    d,outfile    ; file to assign
  3075.     mvi    a,2        ; operand token
  3076.     call    OPENOU        ; ..do it
  3077.  
  3078. ; Main loop: read bytes from infile and use them to drive the
  3079. ; FSA.    For FSA theory see any text on compiler design; for
  3080. ; notes on this one, see below.
  3081.  
  3082.     lxi    h,S0        ; start in state 0
  3083.     jmp    A0        ; and start on action 0
  3084.  
  3085. ; Action 4 is to write an exclamation mark, a blank, and
  3086. ; then do action 1.
  3087. A4:    lxi    d,outfile
  3088.     mvi    a,'!'
  3089.     fputchar @D,@A
  3090.     mvi    a,' '
  3091.     fputchar @D,@A
  3092.     jmp    A1
  3093. ; Action 3 is to write an exclamation mark then do Action 1
  3094. A3:    lxi    d,outfile
  3095.     mvi    a,'!'
  3096.     fputchar @D,@A
  3097.     jmp    A1
  3098. ; Action 2 is to write a blank then do Action 1
  3099. A2:    lxi    d,outfile
  3100.     mvi    a,' '
  3101.     fputchar @D,@A
  3102.     jmp    A1
  3103. ; Action 1 is to write the current character and do Action 0
  3104. A1:    lxi    d,outfile
  3105.     mov    a,b
  3106.     fputchar @D,@A
  3107.     jmp    A0
  3108. ; Action 0 is to get the next input byte and cycle the FSA
  3109. A0:    lxi    d,infile
  3110.     fgetchar @D
  3111.     jrz    endfile ; (quit on eof)
  3112.     mov    b,a    ; save copy of input char for A1
  3113.     xchg        ; save current state in DE
  3114.     lxi    h,class ; base of class table
  3115.     ani    07fh    ; clear hi bit of input char if on
  3116.     addhla        ; hl->class[char]
  3117.     mov    a,m    ; a := class[char]
  3118.     xchg        ; hl->state
  3119.     addhla        ; hl->state[class]
  3120.     mov e,m ! inx h ! mov d,m ! inx h ; DE=action
  3121.     push    d    ; save ->next action on stack
  3122.     mov e,m ! inx h ! mov d,m ; DE = next state
  3123.     xchg        ; HL = new state
  3124.     ret        ; go do action A0/1/2/3
  3125.  
  3126. endfile:
  3127.     fclose    outfile
  3128.     ret
  3129.  
  3130.     dseg
  3131. ; The class-table is used to classify input bytes into one of
  3132. ; six classes:
  3133. ;    0 = characters not otherwise classified
  3134. ;    1 = the TAB and the BLANK
  3135. ;    2 = the apostrophe (single quote)
  3136. ;    3 = the semicolon
  3137. ;    4 = the exclamation mark (rmac statement delimiter)
  3138. ;    5 = the CR that ends a line
  3139. ; class numbers are multiplied by 4 to index the 4-byte
  3140. ; entries of the FSA matrix.
  3141. class:
  3142.     rept    8        ; 8 times
  3143.     dw    0,0,0,0,0,0,0,0 ; 16 bytes of 0 = 128 0's
  3144.     endm
  3145. zclass    equ    $
  3146.     org    class + AsciiTAB
  3147.     db    1*4
  3148.     org    class + AsciiBlank
  3149.     db    1*4
  3150.     org    class + ''''
  3151.     db    2*4
  3152.     org    class + ';'
  3153.     db    3*4
  3154.     org    class + '!'
  3155.     db    4*4
  3156.     org    class + AsciiCR
  3157.     db    4*5
  3158.     org    zclass
  3159.  
  3160. ;   The FSA matrix defines an array with 7 rows which are called
  3161. ; "states."  The automaton is always "in" a particular "state,"
  3162. ; i.e. at A0, HL always points to some row.
  3163. ;   What the rows contain are six, 4-byte entries.  Each contains
  3164. ; the address of an action, A3/2/1/0, and the address of a new
  3165. ; state (row).    To operate the FSA means, to index the current
  3166. ; state by the class of the current input character, do the
  3167. ; action named in that entry, and move to the new state named
  3168. ; in that entry.  That's all there is to it.
  3169.  
  3170. S0:
  3171. ; State 0 is the initial state for any physical line.  Here we
  3172. ; delect null and comment-only lines.
  3173.     dw    A1,S2    ; other: copy byte, go to S2
  3174.     dw    A0,S0A    ; blank: ignore, go to S0A
  3175.     dw    A1,S4    ; quote: copy, go to S4
  3176.     dw    A0,S0C    ; semic: ignore, to S0C
  3177.     dw    A0,S0    ; exclm: ignore, stay here
  3178.     dw    A0,S0    ; CR: ignore, stay here
  3179. S0A:
  3180. ; State 0A is for lines that begin with white-space.  They may
  3181. ; yet prove to be comment-only or all-blank, but if a token
  3182. ; starts, we want to begin it with one blank.
  3183.     dw    A2,S2    ; other: copy blank+byte, S2
  3184.     dw    A0,S0A    ; blank: ignore, stay here
  3185.     dw    A2,S4    ; quote: copy blank+quote, S4
  3186.     dw    A0,S0C    ; semic: ignore, S0C
  3187.     dw    A0,S0    ; exclm: ignore, restart line
  3188.     dw    A0,S0    ; CR: ignore, restart line
  3189. S0C:
  3190. ; State 0C is entered for a comment that heads a physical
  3191. ; line or is preceded only by spaces.  Just toss everything
  3192. ; to a statement boundary.
  3193.     dw    A0,S0C    ; other: skip, stay here
  3194.     dw    A0,S0C    ; blank: skip, stay here
  3195.     dw    A0,S0C    ; quote: skip, stay here
  3196.     dw    A0,S0C    ; semic: skip, stay here
  3197.     dw    A0,S0    ; exclm: skip, leave comment state
  3198.     dw    A0,S0    ; CR: skip, S0
  3199. S1:
  3200. ; State 1 is the opening of a new logical statement, from seeing
  3201. ; an exclam after copying some output.    The exclam has NOT been
  3202. ; copied yet -- if it is followed by useful data we generate it
  3203. ; with A3.
  3204.     dw    A3,S2    ; other: copy exclam+byte, S2
  3205.     dw    A0,S1A    ; blank: ignore, S1A
  3206.     dw    A3,S4    ; quote: copy exclam+quote, S4
  3207.     dw    A0,S5    ; semic: ignore, S5
  3208.     dw    A0,S1    ; exclm: ignore, stay here
  3209.     dw    A1,S0    ; CR: copy it, S0
  3210. S1A:
  3211. ; State 1A, like 0A, remembers that this logical statement
  3212. ; began with a blank.
  3213.     dw    A4,S2    ; other: copy exclam+blank+byte, S2
  3214.     dw    A0,S1A    ; blank: ignore, stay here
  3215.     dw    A4,S4    ; quote: exclam+blank+quote,S4
  3216.     dw    A0,S5    ; semic: ignore, S5
  3217.     dw    A0,S1    ; exclm: ignore, S1 again
  3218.     dw    A1,S0    ; CR: copy it, S0
  3219. S2:
  3220. ; State 2 is entered for any useful assembly token other than
  3221. ; a quoted string.  Stay in it, copying "other" bytes, to the
  3222. ; next delimiter.
  3223.     dw    A1,S2    ; other: copy, stay here
  3224.     dw    A0,S3    ; blank: ignore, S3
  3225.     dw    A1,S4    ; quote: copy, S4
  3226.     dw    A0,S5    ; semic: ignore, S5
  3227.     dw    A0,S1    ; exclm: ignore, S1
  3228.     dw    A1,S0    ; CR: copy, S0
  3229. S3:
  3230. ; State 3 is entered when a blank/tab follows any useful token.
  3231. ; The blank has NOT been copied yet, and won't be unless we
  3232. ; find another token.  Then we'll use A2 to generate it.
  3233.     dw    A2,S2    ; other: blank+byte, S2
  3234.     dw    A0,S3    ; blank: ignore, stay here
  3235.     dw    A2,S4    ; quote: blank+quote, S4
  3236.     dw    A0,S5    ; semic: ignore, S5
  3237.     dw    A0,S1    ; exclm: ignore, S1
  3238.     dw    A1,S0    ; CR: copy, S0
  3239. S4:
  3240. ; State 4 is where we process tokens that are quoted strings.
  3241. ; Since we don't have to interpret them, we can treat double
  3242. ; quotes ('x''y') as multiple quote strings ('x' and 'y').
  3243.     dw    A1,S4    ; other: copy, stay here
  3244.     dw    A1,S4    ; blank: copy, stay here
  3245.     dw    A1,S2    ; quote: copy, go to S2
  3246.     dw    A1,S4    ; semic: copy, stay here
  3247.     dw    A1,S4    ; exclm: copy, stay here
  3248.     dw    A1,S0    ; CR: copy, S0 (bad rmac syntax)
  3249. S5:
  3250. ; State 5 is entered for a comment that follows useful tokens.
  3251. ; There differences from S0C are that, since some output has
  3252. ; been produced, a CR has to be copied and an exclam should
  3253. ; send us to S1 not S0.
  3254.     dw    A0,S5    ; other: skip, stay here
  3255.     dw    A0,S5    ; blank: skip, stay here
  3256.     dw    A0,S5    ; quote: skip, stay here
  3257.     dw    A0,S5    ; semic: skip, stay here
  3258.     dw    A0,S1    ; exclm: skip, S1
  3259.     dw    A1,S0    ; CR: copy, S0
  3260.  
  3261.     end
  3262. 5    ; quote: skip, stay here
  3263.     dw    A0,S5    ; semic: skip, stay here
  3264.