home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / programs / ppspell / spell11.asm < prev    next >
Encoding:
Assembly Source File  |  1994-07-13  |  23.8 KB  |  1,145 lines
  1.     .TITLE "A poor person's spelling checker"
  2.     .PAGE 96,84
  3. ;
  4.     .EPOP
  5.     .ZOP
  6.     .PABS
  7.     .PHEX
  8.     .XLINK
  9.     ASEG
  10. ;
  11. ;    version 1.1  (04/30/82)  (Jim Byram)
  12. ;    Changed last instruction of GBYTE1 from OR A to AND 7FH
  13. ;    to clear high bit of text character as well as to reset
  14. ;    carry.  Necessary to scan WordStar files.
  15. ;    Changed all unconditional JR instructions to JP to speed
  16. ;    execution.  Moved BDOS calls in-line.
  17. ;    Added file output using routines from SD-42.ASM.  Words
  18. ;    not matched are written to console and (optionally) to
  19. ;    the printer and/or to a file named SPELL.LEX.  The file
  20. ;    is created on the default drive if it did not previously
  21. ;    exist.  If it did exist, the new list of unmatched words
  22. ;    is appended to the file.  This feature allows generation
  23. ;    of word lists which can be sorted and edited and then
  24. ;    added to your MASTER.LEX.
  25. ;    Added command line options for file and printer output.
  26. ;
  27. ;    version 1.0  (Alan Bomberger)
  28. ;
  29. ;    Bomberger, Alan.  1982.  A poor person's spelling
  30. ;    checker. Dr. Dobb's Journal 7(4):42-53. (DDJ #66)
  31. ;
  32. ;    Released for NON COMMERCIAL USE ONLY
  33. ;       (c)  1981  Alan Bomberger
  34. ;
  35. ;    USAGE:  [d:]spell [d:]filename.typ [fp]
  36. ;
  37. ;        spell filename.typ    --> output to console
  38. ;
  39. ;        spell filename.typ f  --> ..and to file
  40. ;
  41. ;        spell filename.typ p  --> ..or to printer
  42. ;
  43. ;        spell filename.typ fp --> output to all three
  44. ;
  45. ;    The input file is checked using the lexicon files and
  46. ;    misspelled words (i.e., unmatched words) are printed in
  47. ;    the order they appear in the text.
  48. ;
  49. ;    The input file is broken down into a word list and the
  50. ;    user is prompted to enter the name of each lexicon to
  51. ;    be scanned.
  52. ;
  53. ;    Note -- a lexicon is a list of words usually separated
  54. ;    by <crlf>.  The words comprising a lexicon may be in
  55. ;    any order, but program execution is much faster if all
  56. ;    lexicon words are UPPER CASE.
  57. ;
  58. ;    The word list will fill all available memory so only
  59. ;    very large documents will require more than one pass
  60. ;    of the lexicons.
  61. ;
  62. BOOT    EQU    0
  63. BDOS    EQU    5
  64. ;
  65. PCHAR    EQU    2
  66. LISTC    EQU    5
  67. PSTRING    EQU    9
  68. RSTRING    EQU    10
  69. OPENF    EQU    15
  70. CLOSEF    EQU    16
  71. SRCHF    EQU    17
  72. READF    EQU    20
  73. WRITEF    EQU    21
  74. MAKEF    EQU    22
  75. SETDMA    EQU    26
  76. ;
  77. FCB    EQU    5CH
  78. FCB2    EQU    6CH
  79. BUFF1    EQU    80H
  80. ;
  81. CR    EQU    0DH
  82. LF    EQU    0AH
  83. BELL    EQU    7
  84. ;
  85.     ORG    100H
  86. ;
  87. SPELIT:
  88.     LD    SP,STACK    ; a new stack pointer
  89.     LD    A,(FCB2+1)    ; check for output options
  90.     CP    " "        ; any options?
  91.     JR    Z,NOOPT
  92.     CALL    CHKOPT        ; yes, determine which
  93.     LD    A,(FCB2+2)    ; check for second option
  94.     CP    " "        ; another option?
  95.     JR    Z,NOOPT
  96.     CALL    CHKOPT        ; yes, determine which
  97. NOOPT:
  98.     LD    DE,COPYR
  99.     LD    C,PSTRING
  100.     CALL    BDOS
  101.     CALL    OPENIN        ; open input files
  102.     CALL    ZCHN        ; zap chains
  103. BUILDL:
  104.     CALL    GWORD        ; get the next word of text
  105.     JR    C,ENDIN        ; no more left, check spelling
  106.     CALL    SEARCH        ; see if in word list
  107.     JR    NC,BUILDL    ; yes, it is
  108.     CALL    ADDW        ; no, so add it in
  109. ;
  110. ;    "WORK" contains the address of the last word put into
  111. ;    the word list.  See if this word is past the threshold
  112. ;    of memory.
  113. ;
  114.     CALL    COMPARE
  115.     JR    NC,BUILDL    ; no, so continue
  116.     LD    HL,NUMWDC+2    ; mark as incomplete
  117.     LD    (HL),"*"
  118.     CALL    SPELL        ; check the current list
  119.     CALL    PTABLE        ; print the misspelled words
  120.     LD    IX,COMWDL    ; the last of the common words
  121.     SET    WFLGSL,(IX+WFLGS) ; mark this as the last in list
  122.     LD    C,6
  123.     LD    B,0
  124.     LD    DE,NUMWD
  125.     LD    HL,ZCOUNT    ; zero counter
  126.     LDIR
  127.     CALL    ZCHN        ; zap chains
  128.     JP    BUILDL        ; and get next word
  129. ENDIN:
  130.     CALL    SPELL        ; check spelling of words in list
  131.     LD    DE,FCB
  132.     LD    C,CLOSEF
  133.     CALL    BDOS        ; close up input file
  134.     CALL    OUTPUT        ; print the words not in lexicon
  135.     JP    CLZOUT        ; close output file and exit
  136. ;
  137. ;    chkopt
  138. ;
  139. ;    determine whether file and/or printer output selected
  140. ;    any unrecognized options will be ignored
  141. ;
  142. CHKOPT:
  143.     CP    "F"        ; file output wanted?
  144.     JR    NZ,NOTF        ; no, what about printer?
  145.     LD    A,0
  146.     LD    (FOPFLG),A    ; set flag
  147.     RET
  148. NOTF:
  149.     CP    "P"        ; printer output wanted?
  150.     RET    NZ        ; no
  151.     LD    A,0
  152.     LD    (POPFLG),A    ; set flag
  153.     RET
  154. ;
  155. ;    compare
  156. ;
  157. ;    compare the value in work with "endmem"
  158. ;
  159. COMPARE:
  160.     LD    HL,WORK        ; address of last word
  161.     LD    A,(ENDMEM)    ; end of memory
  162.     SUB    (HL)
  163.     LD    A,(ENDMEM+1)
  164.     INC    HL
  165.     SBC    A,(HL)        ; double precision subtract
  166.     RET
  167. ;
  168. ;    openin
  169. ;
  170. ;    open input file and locate end of memory
  171. ;
  172. OPENIN:
  173.     LD    DE,FCB        ; input file
  174.     LD    C,OPENF
  175.     CALL    BDOS
  176.     LD    DE,NINPUT    ; in case not there
  177.     INC    A
  178.     JR    Z,FAILED    ; no file
  179.     LD    A,128
  180.     LD    (IBP),A        ; set so 1st call gets disk record
  181. ;
  182. ;    find end of memory
  183. ;
  184.     LD    HL,(6)        ; address of bdos
  185.     LD    BC,64        ; a margin
  186.     OR    A        ; clear carry
  187.     SBC    HL,BC        ; subtract margin
  188.     LD    (ENDMEM),HL
  189.     RET
  190. FAILED:
  191.     LD    C,PSTRING
  192.     CALL    BDOS
  193.     JP    BOOT        ; quit now
  194. ;
  195. ;    gword
  196. ;
  197. ;    get next word in text into cword
  198. ;    carry flag on means end of input
  199. ;
  200. GWORD:
  201.     LD    A,128
  202.     LD    (CFLAGS),A    ; set this word as last
  203.     LD    DE,0        ; length of word
  204. GWORDL:
  205.     CALL    GBYTE        ; get next byte of text
  206.     JR    C,GWORDE    ; end of input
  207.     LD    BC,(DELIML)    ; length of delimiter table
  208.     LD    HL,DELIMT    ; the table
  209.     CPIR            ; is it a delimiter?
  210.     JR    Z,DELIM        ; yes
  211.     LD    BC,(ALPHAL)
  212.     LD    HL,ALPHA    ; is it alphabetic?
  213.     CPIR
  214.     JR    NZ,GWORDL    ; no, skip it
  215.     CP    "a"        ; is it lower case
  216.     JR    C,GWORDU    ; no
  217.     CP    "{"        ; lower
  218.     JR    NC,GWORDU
  219.     AND    5FH        ; make all upper case
  220. GWORDU:
  221.     LD    HL,CWORD+4    ; place to build word
  222.     ADD    HL,DE
  223.     LD    (HL),A        ; put byte in word
  224.     INC    E        ; new length
  225.     LD    A,E
  226.     LD    (CLEN),A    ; update in word entry
  227.     CP    30        ; how long is word?
  228.     JR    Z,GWORDT    ; too long a word
  229.     JP    GWORDL        ; loop
  230. DELIM:
  231.     LD    A,E        ; current length
  232.     CP    0
  233.     JR    Z,GWORDL    ; skip leading delimiters
  234.     OR    A        ; zero carry
  235. GWORDE:
  236.     RET
  237. GWORDT:
  238.     LD    DE,LNGWD1    ; first part of text
  239.     LD    C,PSTRING
  240.     CALL    BDOS
  241.     LD    DE,CWORD+4
  242.     LD    C,PSTRING
  243.     CALL    BDOS
  244.     LD    DE,LNGLX2    ; second part
  245.     LD    C,PSTRING
  246.     CALL    BDOS
  247.     OR    A
  248.     JP    GWORDE
  249. ;
  250. ;    getbyte
  251. ;
  252. ;    get next byte of text
  253. ;    carry flag on for end of file
  254. ;
  255. GBYTE:
  256.     PUSH    DE
  257.     LD    A,(IBP)
  258.     CP    128        ; do we need another buffer full?
  259.     JR    NZ,GBYTE1    ; no
  260.     LD    DE,FCB
  261.     LD    C,READF
  262.     CALL    BDOS        ; read a block
  263.     CP    0        ; did it ok?
  264.     SCF            ; in case not
  265.     JR    NZ,GBYTER    ; end of file return
  266. GBYTE1:
  267.     LD    E,A        ; has current byte index to fetch
  268.     LD    D,0        ; double precision
  269.     LD    HL,BUFF1
  270.     ADD    HL,DE
  271.     INC    A        ; next index
  272.     LD    (IBP),A
  273.     LD    A,(HL)        ; get byte
  274.     CP    1AH        ; check for end
  275.     SCF            ; in case it is
  276.     JR    Z,GBYTER    ; yes
  277.     AND    7FH        ; clear carry and set bit 7 to 0
  278. GBYTER:
  279.     POP    DE
  280.     RET
  281. ;
  282. ;    search
  283. ;
  284. ;    search word list for match with cword
  285. ;
  286. ;    on return ix will point to matched entry or last in list
  287. ;    carry on if no match
  288. ;
  289. ;    searc1 is the entry when searching on a chain
  290. ;
  291. SEARCH:
  292.     LD    IX,WORDS    ; start of list
  293. SEARC1:                ; entry if starting with chain
  294. SLOOP:
  295.     LD    A,(CLEN)    ; length of current word
  296.     CP    (IX+WLEN)    ; must be same as list entry
  297.     JR    NZ,NEXTW    ; try next entry
  298.     CALL    CLC        ; compare
  299.     JR    Z,MATCH        ; it is a match
  300. NEXTW:
  301.     BIT    WFLGSL,(IX+WFLGS) ; is this the last entry?
  302.     JR    NZ,NMATCH    ; yes, then no match
  303.     LD    A,(IX+WCHN)    ; get chain pointer
  304.     LD    (WORK),A
  305.     LD    A,(IX+WCHN1)    ; both parts
  306.     LD    (WORK+1),A
  307.     CP    0        ; this is high order (zero only if end)
  308.     JR    Z,NMATCH    ; end of chain
  309.     LD    IX,(WORK)
  310.     JP    SLOOP
  311. MATCH:
  312.     OR    A        ; clear carry
  313.     JP    SRET
  314. NMATCH:
  315.     SCF            ; set carry
  316. SRET:
  317.     RET
  318. ;
  319. ;    clc
  320. ;
  321. ;    compare logical character
  322. ;    cword with list entry pointed to by ix
  323. ;    a contains length
  324. ;
  325. CLC:
  326.     PUSH    IX
  327.     LD    C,A        ; length for down count
  328.     LD    HL,CWORD+4    ; compare here
  329. CLCL:
  330.     LD    A,(IX+WORD)    ; first character
  331.     CP    (HL)        ; is it?
  332.     JR    NZ,CLCE        ; no, stop
  333.     INC    HL
  334.     INC    IX
  335.     DEC    C
  336.     JR    NZ,CLCL        ; not end so continue
  337. CLCE:
  338.     POP    IX
  339.     RET
  340. ;
  341. ;    addw
  342. ;
  343. ;    add word to list
  344. ;    word is in cword and ix points to last entry
  345. ;
  346. ADDW:
  347.     LD    (WORK),IX    ; save
  348.     LD    IY,(WORK)    ; old position
  349.     LD    A,0
  350.     LD    (CCHN),A
  351.     LD    (CCHN1),A    ; zero chain pointer
  352.     RES    WFLGSL,(IX+WFLGS) ; clear this is last entry flag
  353.     LD    B,0
  354.     LD    A,(IX+WLEN)    ; get length of last word
  355.     ADD    A,4
  356.     LD    C,A        ; include chain and stuff
  357.     ADD    IX,BC        ; skip over last entry
  358.     LD    (WORK),IX
  359.     LD    A,(WORK)    ; get low byte
  360.     LD    (IY+WCHN),A    ; to chain
  361.     LD    A,(WORK+1)
  362.     LD    (IY+WCHN1),A    ; to chain
  363.     LD    A,(CLEN)
  364.     ADD    A,4
  365.     LD    C,A
  366.     LD    HL,CWORD    ; source
  367.     LD    (WORK),IX
  368.     LD    DE,(WORK)    ; can't get there from here
  369.     LDIR            ; move it
  370.     CALL    COUNTW        ; bump count
  371.     RET
  372. ;
  373. ;    spell
  374. ;
  375. ;    check each lexicon word with list entries
  376. ;    mark correct (found) words in list
  377. ;
  378. SPELL:
  379.     LD    DE,NUMWD
  380.     LD    C,PSTRING
  381.     CALL    BDOS        ; inform of number of words
  382.     CALL    SETCHN        ; set up chains
  383.     LD    DE,BUFF2    ; switch buffers
  384.     LD    C,SETDMA
  385.     CALL    BDOS
  386. NEXTLEX:
  387.     CALL    GETLEX        ; get a lexicon file
  388.     JR    C,SPELLR    ; none, so return
  389.     LD    DE,LFCB        ; get lexicon file
  390.     LD    C,OPENF
  391.     CALL    BDOS
  392.     LD    DE,NOLEX    ; in case not there
  393.     INC    A
  394.     JR    NZ,GOTLEX    ; it is a valid lexicon
  395.     LD    C,PSTRING
  396.     CALL    BDOS        ; it is not a valid lexicon
  397.     JP    NEXTLEX        ; try again
  398. GOTLEX:
  399.     LD    DE,LFCB        ; lexicon fcb
  400.     LD    C,READF
  401.     CALL    BDOS        ; read first record
  402.     CP    0        ; did it
  403.     JR    NZ,ENDL        ; quick exit
  404.     LD    DE,CHECKM    ; tell customer
  405.     LD    C,PSTRING
  406.     CALL    BDOS        ; that we begin
  407.     LD    A,0
  408.     LD    (IBPL),A
  409.     LD    (COMP),A    ; say not compacted
  410.     LD    A,(BUFF2)    ; first of compacted
  411.     CP    0FFH
  412.     JR    NZ,SPELLL
  413.     LD    A,1
  414.     LD    (COMP),A    ; set compacted
  415.     LD    (IBPL),A    ; skip ff
  416. SPELLL:
  417.     CALL    LWORD        ; get a word in cword
  418.     JR    C,ENDL        ; end of lexicon
  419.     LD    IX,CWORD
  420.     CALL    GETCHN        ; get correct chain for this word
  421.     LD    E,(HL)        ; low order byte
  422.     INC    HL
  423.     LD    D,(HL)        ; high order byte
  424.     LD    (WORK),DE    ; get first word in list
  425.     LD    IX,(WORK)    ; place to start
  426.     LD    A,(WORK+1)
  427.     CP    0
  428.     JR    Z,SPELLL    ; if zero no words this letter
  429.     CALL    SEARC1        ; look for word in chain
  430.     JR    C,SPELLL    ; did not find it
  431.     SET    WFLGSC,(IX+WFLGS) ; mark spelled correctly
  432.     JP    SPELLL        ; and loop
  433. ENDL:
  434.     LD    DE,LFCB        ; close
  435.     LD    C,CLOSEF
  436.     CALL    BDOS
  437.     JP    NEXTLEX        ; get another lexicon
  438. SPELLR:
  439.     LD    DE,BUFF1    ; reset dma
  440.     LD    C,SETDMA
  441.     CALL    BDOS        ; in case more input
  442.     RET
  443. ;
  444. ;    getlex
  445. ;
  446. ;    get a lexicon file from the customer
  447. ;    if none requested (null input) return with carry flag on
  448. ;
  449. GETLEX:
  450.     LD    DE,ASKLEX
  451.     LD    C,PSTRING
  452.     CALL    BDOS        ; type prompt
  453.     CALL    ANSWER        ; get answer
  454.     JR    C,GETLXR    ; return, no lexicon
  455.     CALL    BLDFCB        ; build a new fcb
  456.     OR    A        ; clear carry
  457. GETLXR:
  458.     RET
  459. ;
  460. ;    answer
  461. ;
  462. ;    get answer to question in buff2
  463. ;
  464. ANSWER:    LD    DE,BUFF2
  465.     LD    A,80
  466.     LD    (BUFF2),A
  467.     LD    C,RSTRING
  468.     CALL    BDOS        ; get answer
  469.     LD    A,(BUFF2+1)    ; get length of answer
  470.     CP    0        ; see if any
  471.     SCF            ; none
  472.     JR    Z,ANSWRT    ; quit now
  473.     OR    A        ; clear carry
  474. ANSWRT:
  475.     RET
  476. ;
  477. ;    bldfcb
  478. ;
  479. ;    build an fcb from information in buff2
  480. ;    assumes file type of .LEX
  481. ;
  482. BLDFCB:
  483.     LD    HL,DEFFCB    ; the default fcb
  484.     LD    DE,LFCB        ; goes here
  485.     LD    BC,16        ; move this much
  486.     LDIR            ; move it
  487.     XOR    A        ; get a zero
  488.     LD    (LFCBCR),A    ; zero this as well
  489.     LD    HL,BUFF2+2
  490.     LD    A,(BUFF2+1)    ; get number of bytes in name
  491.     LD    C,A        ; b is zero from block above
  492. BLLOOP:
  493.     LD    A,(HL)        ; get a byte
  494.     CP    " "        ; is it a blank?
  495.     JR    NZ,NOBLK    ; no
  496.     INC    HL
  497.     DEC    C
  498.     JR    NZ,BLLOOP    ; skip leading blanks
  499.     JP    BLDRET        ; return with bad fcb
  500. NOBLK:
  501.     INC    HL        ; skip disk name if present
  502.     LD    A,(HL)        ; get suspected ":"
  503.     DEC    HL        ; back to first character
  504.     CP    ":"        ; is it a disk name?
  505.     JR    NZ,NODSK    ; no, just a name
  506.     LD    A,(HL)        ; get disk name
  507.     AND    0FH        ; to cp/m standards
  508.     LD    (LFCBDN),A    ; to fcb
  509.     INC    HL
  510.     INC    HL        ; skip name and ":"
  511.     DEC    C
  512.     JR    Z,BLDRET    ; quit with bad fcb
  513.     DEC    C
  514.     JR    Z,BLDRET    ; quit with bad fcb
  515. NODSK:
  516.     LD    DE,LFCBFN    ; place for name
  517.     LD    A,8        ; max length at this point
  518.     CP    C        ; are we ok?
  519.     JR    Z,BLDRET    ; no, so leave blank
  520. FILELP:
  521.     LD    A,(HL)
  522.     CP    "."        ; this is end (we ignore)
  523.     JR    Z,BLDRET
  524.     CP    " "        ; also end
  525.     JR    Z,BLDRET    ; and this
  526.     CP    "a"        ; lower case alpha?
  527.     JR    C,FILEL1    ; no
  528.     AND    5FH        ; make upper
  529. FILEL1:
  530.     LD    (DE),A        ; put in fcb
  531.     INC    DE
  532.     INC    HL
  533.     DEC    C
  534.     JR    NZ,FILELP    ; loop
  535. BLDRET:
  536.     RET
  537. ;
  538. ;    lword
  539. ;
  540. ;    get a lexicon word
  541. ;    carry flag on if end of lexicon
  542. ;
  543. LWORD:
  544.     LD    DE,0        ; length of word
  545. LWORDL:
  546.     CALL    LCHAR        ; get char from file
  547.     JR    C,LWORDR    ; if end
  548.     CP    LF        ; skip these if present
  549.     JR    Z,LWORDL
  550.     CP    " "
  551.     JR    Z,LWORDL    ; skip blanks in lexicon
  552.     CP    CR        ; end of word
  553.     JR    Z,LWORDE    ; done
  554.     CP    1AH        ; end
  555.     JR    Z,LWORDF    ; set carry and return
  556.     CP    "a"        ; lower case?
  557.     JR    C,LWORDU    ; no, upper
  558.     CP    "{"
  559.     JR    NC,LWORDU
  560.     AND    5FH        ; make sure upper case
  561. LWORDU:
  562.     LD    HL,CWORD+4    ; place to put it
  563.     ADD    HL,DE
  564.     LD    (HL),A        ; build word
  565.     INC    E        ; bump count
  566.     LD    A,E
  567.     LD    (CLEN),A
  568.     CP    30        ; how long?
  569.     JR    Z,LWORDT    ; too long
  570.     JP    LWORDL        ; get more bytes
  571. LWORDE:
  572.     LD    A,E        ; check for null word
  573.     CP    0        ; any so far?
  574.     JR    Z,LWORDL    ; no, so continue
  575.     OR    A        ; clear carry
  576. LWORDR:
  577.     RET
  578. LWORDF:
  579.     SCF
  580.     JP    LWORDR        ; return
  581. LWORDT:
  582.     LD    DE,LNGLX1    ; first part
  583.     LD    C,PSTRING
  584.     CALL    BDOS
  585.     LD    DE,CWORD+4
  586.     LD    C,PSTRING
  587.     CALL    BDOS
  588.     LD    DE,LNGLX2    ; second part
  589.     LD    C,PSTRING
  590.     CALL    BDOS
  591.     OR    A
  592.     JP    LWORDR
  593. ;
  594. ;    lchar
  595. ;
  596. ;    get a character from lexicon (compacted or not)
  597. ;
  598. LCHAR:
  599.     LD    A,(COMP)    ; is it a compacted lexicon?
  600.     CP    0        ; well?
  601.     JR    NZ,LCHARC    ; yes
  602.     CALL    LBYTE        ; no, get a byte
  603.     RET            ; and return
  604. ;
  605. LCHARC:
  606.     CALL    GNIB        ; get a nibble
  607.     JR    C,LCHARE    ; end already
  608.     CP    0FH        ; is it a flag?
  609.     JR    Z,LCHARS    ; yes, second set of letters
  610.     LD    C,16        ; size of table
  611.     LD    HL,T1        ; in table one
  612. LCHAR1:
  613.     CP    C
  614.     JR    NC,LCHARE    ; too big
  615.     LD    B,0
  616.     LD    C,A
  617.     ADD    HL,BC
  618.     JP    LCHARG        ; got it
  619. LCHARE:
  620.     LD    DE,BADLEX
  621.     LD    C,PSTRING
  622.     CALL    BDOS
  623.     SCF
  624.     RET            ; say end of lexicon
  625. LCHARS:
  626.     CALL    GNIB
  627.     JR    C,LCHARE
  628.     LD    C,14        ; search length
  629.     LD    HL,T2
  630.     JP    LCHAR1        ; loop here
  631. LCHARG:
  632.     LD    A,(HL)
  633.     OR    A        ; clear carry
  634.     RET
  635. ;
  636. ;    gnib
  637. ;
  638. ;    get a nibble from compacted lexicon
  639. ;
  640. GNIB:
  641.     LD    A,(LRNIB)
  642.     CP    1        ; left or right?
  643.     JR    Z,GNIBR        ; right
  644.     LD    A,1
  645.     LD    (LRNIB),A
  646.     CALL    LBYTE        ; get a byte
  647.     JR    C,GNIBR        ; report carry
  648.     LD    (BYTE),A
  649.     SRL    A
  650.     SRL    A
  651.     SRL    A
  652.     SRL    A        ; put left in lower
  653.     OR    A        ; clear carry
  654.     RET
  655. GNIBR:
  656.     LD    A,0
  657.     LD    (LRNIB),A
  658.     LD    A,(BYTE)
  659.     AND    0FH
  660.     RET
  661. ;
  662. ;    lbyte
  663. ;
  664. ;    get a byte from lexicon file
  665. ;    carry flag on for end of file
  666. ;
  667. LBYTE:
  668.     PUSH    DE
  669.     LD    A,(IBPL)    ; get buffer pointer
  670.     CP    128        ; at end?
  671.     JR    NZ,LBYTE1    ; no
  672.     LD    DE,LFCB        ; fcb for lexicon
  673.     LD    C,READF
  674.     CALL    BDOS
  675.     CP    0        ; did it work?
  676.     SCF            ; in case not
  677.     JR    NZ,LBYTER    ; return with carry if end
  678. LBYTE1:
  679.     LD    E,A        ; position in buffer
  680.     LD    D,0
  681.     LD    HL,BUFF2
  682.     ADD    HL,DE        ; correct byte
  683.     INC    A        ; for next time
  684.     LD    (IBPL),A
  685.     LD    A,(HL)        ; get the byte
  686.     OR    A        ; clear carry
  687. LBYTER:
  688.     POP    DE
  689.     RET
  690. ;
  691. ;    count words
  692. ;
  693. COUNTW:
  694.     LD    HL,NUMWDC    ; get lowest byte
  695.     LD    A,":"        ; a test for too large
  696. COUNTL:
  697.     INC    (HL)
  698.     CP    (HL)        ; see if too big
  699.     RET    NZ        ; no
  700.     LD    (HL),"0"    ; yes, set to 0
  701.     DEC    HL
  702.     JP    COUNTL        ; backup and try again
  703. ;
  704. ;    zchn
  705. ;
  706. ;    zero chain headers
  707. ;
  708. ZCHN:
  709.     LD    A,0        ; get a zero
  710.     LD    C,54        ; number
  711.     LD    HL,ALPHC    ; place
  712. ZCHNL:
  713.     LD    (HL),0
  714.     INC    HL
  715.     DEC    C
  716.     JR    NZ,ZCHNL
  717.     RET
  718. ;
  719. ;    getchn
  720. ;
  721. ;    get address of chain head of word pointed to by ix
  722. ;
  723. GETCHN:
  724.     LD    A,(IX+WORD)    ; first char
  725.     LD    B,0
  726.     LD    HL,ALPHC    ; first chain head
  727.     CP    "A"        ; first
  728.     JR    C,CHNOTH    ; lower use other
  729.     CP    "["
  730.     JR    NC,CHNOTH    ; greater use other
  731. GETCHA:
  732.     AND    1FH        ; mask
  733.     DEC    A
  734.     SLA    A        ; double it
  735.     LD    C,A        ; displacement
  736.     ADD    HL,BC
  737.     RET
  738. CHNOTH:
  739.     LD    A,"["
  740.     JP    GETCHA        ; use last chain
  741. ;
  742. ;    setchn
  743. ;
  744. ;    scans word list and rechains it by letter
  745. ;
  746. SETCHN:
  747.     LD    IX,WORDS    ; place to start
  748. SETCH0:
  749.     CALL    GETCHN        ; get the correct header
  750.     LD    A,0        ; get a zero
  751. SETCHL:
  752.     INC    HL        ; to high order byte
  753.     CP    (HL)
  754.     JR    NZ,NXTCHN    ; not this one
  755.     LD    (WORK),IX    ; goes here
  756.     LD    DE,(WORK)    ; get it
  757.     LD    (HL),d
  758.     DEC    HL
  759.     LD    (HL),E
  760.     LD    (IX+WCHN),A    ; zero forward
  761.     LD    (IX+WCHN1),A
  762.     JP    SETCHW        ; next word
  763. NXTCHN:
  764.     LD    D,(HL)
  765.     DEC    HL
  766.     LD    E,(HL)
  767.     EX    DE,HL
  768.     INC    HL
  769.     INC    HL        ; to chain portion of word
  770.     JP    SETCHL
  771. SETCHW:
  772.     BIT    WFLGSL,(IX+WFLGS)
  773.     JR    NZ,SETCHR    ; return
  774.     LD    A,(IX+WLEN)
  775.     ADD    A,4
  776.     LD    C,A
  777.     LD    B,0
  778.     ADD    IX,BC
  779.     JP    SETCH0
  780. SETCHR:
  781.     RET
  782. ;
  783. ;    output
  784. ;
  785. ;    create or open output file for unmatched words
  786. ;
  787. OUTPUT:
  788.     LD    A,(FOPFLG)    ; is file output active?
  789.     OR    A
  790.     JP    NZ,PTABLE    ; no, begin console output
  791.     LD    DE,OUTBUF    ; set dma for output buffer
  792.     LD    C,SETDMA
  793.     CALL    BDOS
  794. ;
  795. ;    first pass on file append
  796. ;    prepare SPELL.LEX to receive new or appended output
  797. ;
  798.     LD    DE,OUTFCB    ; does file already exist?
  799.     LD    C,SRCHF
  800.     PUSH    DE
  801.     CALL    BDOS
  802.     POP    DE
  803.     INC    A
  804.     JR    NZ,OPENIT    ; yes, open it for processing
  805.     LD    C,MAKEF
  806.     CALL    BDOS        ; no, create the output file
  807. ;
  808.     INC    A
  809.     JP    NZ,PTABLE    ; continue if open successful
  810. ;
  811. ;    if make or open fails, declare error
  812. ;
  813. OPNERR:
  814.     CALL    ERXIT
  815.     DB    CR,LF,"OPEN$"
  816. ;
  817. WRTERR:
  818.     CALL    ERXIT
  819.     DB    CR,LF,"WRITE$"
  820. ;
  821. ;    openit
  822. ;
  823. ;    output file already exists - open it and position to
  824. ;    the last record of the last extent
  825. ;
  826. OPENIT:
  827.     LD    C,OPENF
  828.     PUSH    DE
  829.     CALL    BDOS        ; open 1st extent of output file
  830.     POP    DE
  831.     INC    A
  832.     JR    Z,OPNERR    ; bad deal if 1st won't open
  833. OPNMOR:
  834.     LD    A,(OUTFCB+15)
  835.     CP    128
  836.     JR    C,RDLAST    ; if rc <128, this is last extent
  837.     LD    HL,OUTFCB+12
  838.     INC    (HL)        ; else, bump to next extent
  839.     LD    C,OPENF
  840.     PUSH    DE
  841.     PUSH    HL
  842.     CALL    BDOS        ; and try to open it
  843.     POP    HL
  844.     POP    DE
  845.     INC    A
  846.     JR    NZ,OPNMOR    ; open extents until no more
  847.     DEC    (HL)        ; then, reopen preceding extent
  848.     LD    C,OPENF
  849.     PUSH    DE
  850.     CALL    BDOS
  851.     POP    DE
  852.     LD    A,(OUTFCB+15)    ; get rc for the last extent
  853. ;
  854. ;    rdlast
  855. ;
  856. ;    at this point, outfcb is opened to the last extent of
  857. ;    the file, so read in the last record of the last extent
  858. ;
  859. RDLAST:
  860.     OR    A        ; is this extent empty?
  861.     JR    Z,PTABLE    ; yes, start a clean slate
  862.     DEC    A        ; normalize record count
  863.     LD    (OUTFCB+32),A    ; set record number to read
  864.     LD    C,READF
  865.     PUSH    DE
  866.     CALL    BDOS        ; and read last record of file
  867.     POP    DE
  868.     OR    A        ; was read successful?
  869.     JR    Z,RDOK        ; yes, go scan for eof mark
  870. ;
  871. ;    if read or append fails, declare error
  872. ;
  873. APERR:
  874.     CALL    ERXIT
  875.     DB    CR,LF,"APPEND$"
  876. ;
  877. ;    rdok
  878. ;
  879. ;    we now have the last record of the file in our buffer
  880. ;
  881. ;    scan the last record for the eof mark, indicating where
  882. ;    we can start adding data
  883. ;
  884. RDOK:
  885.     LD    HL,OUTBUF    ; point to start of output buffer
  886.     LD    B,128        ; get length of output buffer
  887. SCAN:
  888.     LD    A,(HL)
  889.     CP    "Z"-40H        ; have we found end of file?
  890.     JR    Z,RESCR        ; yes, save pointers and reset cr
  891.     INC    HL
  892.     DEC    B
  893.     JR    NZ,SCAN        ; no, keep looking til end of buffer
  894. ;
  895. ;    rescr    reset current record
  896. ;
  897. ;    if we find an explicit eof mark in the last buffer (or an
  898. ;    implied eof if the last record is full), move the fcb record
  899. ;    and extent pointers back to correct for the read operation
  900. ;    so that our first write operation will effectively replace
  901. ;    the last record of the spell.lex file
  902. ;
  903. RESCR:
  904.     PUSH    HL        ; save eof buffer pointer
  905.     PUSH    BC        ; save eof buffer remaining
  906.     LD    HL,OUTFCB+32    ; get current record again
  907.     DEC    (HL)        ; dock it
  908.     JP    P,SAMEXT    ; if cr >=0, still in same extent
  909.     LD    HL,OUTFCB+12    ; else, move to previous extent
  910.     DEC    (HL)
  911.     LD    C,OPENF
  912.     CALL    BDOS        ; then, reopen the previous extent
  913.     INC    A
  914.     JR    Z,APERR        ; append error if we can't reopen
  915.     LD    A,(OUTFCB+15)    ; position to last record of extent
  916.     DEC    A
  917.     LD    (OUTFCB+32),A
  918. SAMEXT:
  919.     POP    AF        ; recall where eof is in buffer
  920.     LD    (BUFCNT),A    ; and set buffer counter
  921.     POP    HL        ; recall next buffer pointer
  922.     LD    (BUFPNT),HL    ; set pointer for first addition
  923. ;
  924. ;    ptable
  925. ;
  926. ;    print misspelled words from list
  927. ;
  928. PTABLE:
  929.     LD    B,0
  930.     LD    IX,WORDS    ; start
  931. PTLOOP:
  932.     BIT    WFLGSC,(IX+WFLGS) ; is this one correct?
  933.     JR    NZ,PNEXT    ; yes, don't print it
  934.     CALL    PWORD        ; print the word
  935. PNEXT:
  936.     BIT    WFLGSL,(IX+WFLGS)
  937.     JR    NZ,PTABR
  938.     LD    A,(IX+WLEN)    ; get length this entry
  939.     ADD    A,4
  940.     LD    C,A
  941.     ADD    IX,BC
  942.     JP    PTLOOP        ; try again
  943. PTABR:
  944.     RET
  945. ;
  946. ;    pword
  947. ;
  948. ;    print word pointed to by ix
  949. ;
  950. PWORD:
  951.     PUSH    IX
  952.     LD    B,(IX+WLEN)
  953. PWLOOP:
  954.     LD    E,(IX+WORD)    ; a character
  955.     CALL    TYPE
  956.     DEC    B
  957.     JR    Z,CRLF
  958.     INC    IX        ; next character
  959.     JP    PWLOOP
  960. CRLF:
  961.     LD    E,CR
  962.     CALL    TYPE
  963.     LD    E,LF
  964.     CALL    TYPE
  965.     POP    IX
  966.     RET
  967. ;
  968. ;    type
  969. ;
  970. ;    output character in e to console and (optionally) to
  971. ;    output file and/or to printer
  972. ;
  973. TYPE:
  974.     PUSH    BC
  975.     PUSH    DE        ; save the character to output
  976.     LD    C,PCHAR
  977.     CALL    BDOS        ; send it to console
  978.     POP    DE        ; restore the output character
  979.     LD    B,E        ; save character to b
  980.     LD    A,(FOPFLG)    ; is file output active?
  981.     OR    A
  982.     JR    NZ,NOWRIT    ; no, bypass file output
  983. ;
  984. ;    file output mode active
  985. ;
  986. ;    make sure we have room in buffer to add next character
  987. ;
  988. ;    if buffer full, write out current record first and then
  989. ;    start a new record with current character
  990. ;
  991.     LD    HL,(BUFPNT)    ; get current buffer pointer
  992.     LD    A,(BUFCNT)    ; get buffer capacity remaining
  993.     OR    A
  994.     JR    NZ,PUTBUF    ; continue if buffer not full
  995.     LD    DE,OUTFCB    ; otherwise, write current buffer
  996.     LD    C,WRITEF
  997.     PUSH    BC
  998.     CALL    BDOS        ; (call must save character in b)
  999.     POP    BC
  1000.     OR    A
  1001.     JP    NZ,WRTERR    ; error exit if disk full or r/o
  1002.     LD    HL,OUTBUF    ; reset buffer pointer
  1003.     LD    A,128        ; reset buffer capacity
  1004. ;
  1005. PUTBUF:
  1006.     LD    (HL),B        ; shove char to next buffer position
  1007.     INC    HL        ; bump buffer pointer
  1008.     LD    (BUFPNT),HL    ; and save it
  1009.     DEC    A        ; dock count of chars left in buffer
  1010.     LD    (BUFCNT),A    ; and save it
  1011. NOWRIT:
  1012.     LD    E,B
  1013.     LD    C,LISTC        ; set up list output call
  1014.     LD    A,(POPFLG)    ; is printer output active?
  1015.     OR    A
  1016.     CALL    Z,BDOS        ; yes, list character on printer
  1017.     POP    BC
  1018.     RET
  1019. ;
  1020. ;    clzout
  1021. ;
  1022. ;    we've finished all of our outputting
  1023. ;    flush the remainder of the output buffer and close the
  1024. ;    file before making our exit
  1025. ;
  1026. CLZOUT:
  1027.     LD    A,(FOPFLG)    ; is file output active?
  1028.     OR    A
  1029.     JP    NZ,BOOT        ; no, exit from program
  1030.     LD    HL,BUFCNT
  1031.     LD    A,(HL)        ; get # of unflushed chars in buffer
  1032.     OR    A        ; if bufcnt=128, empty so set sign bit
  1033.     JP    M,CLOZE        ; close spell.lex if buffer is empty
  1034.     JR    Z,FLUSH        ; write last record if buffer full
  1035. ;
  1036.     LD    HL,(BUFPNT)    ; else, pad unused buffer with ctrl-zs
  1037. PUTAGN:
  1038.     LD    (HL),"Z"-40H
  1039.     INC    HL
  1040.     DEC    A
  1041.     JR    NZ,PUTAGN    ; continue until buffer filled out
  1042. ;
  1043. FLUSH:
  1044.     LD    DE,OUTFCB    ; flush the last output buffer
  1045.     LD    C,WRITEF
  1046.     CALL    BDOS
  1047.     OR    A
  1048.     JP    NZ,WRTERR
  1049. CLOZE:
  1050.     LD    DE,OUTFCB    ; close the output file
  1051.     LD    C,CLOSEF
  1052.     CALL    BDOS
  1053.     JP    BOOT        ; exit
  1054. ;
  1055. ;    erxit
  1056. ;
  1057. ;    abort program on output file error and define error
  1058. ;
  1059. ERXIT:
  1060.     POP    DE        ; get pointer to message string
  1061.     LD    C,PSTRING
  1062.     CALL    BDOS        ; print it
  1063.     LD    DE,DSKERR    ; print " ERROR"
  1064.     LD    C,PSTRING
  1065.     CALL    BDOS
  1066.     JP    BOOT        ; exit
  1067. ;
  1068. ;
  1069.     DS    64
  1070. STACK:    DS    1
  1071. ENDMEM:    DS    2
  1072. DEFFCB:    DB    0,"        LEX",0,0,0,0
  1073. LFCB:    DS    33
  1074. LFCBCR    EQU    LFCB+32
  1075. LFCBEX    EQU    LFCB+12
  1076. LFCBS1    EQU    LFCB+13
  1077. LFCBS2    EQU    LFCB+14
  1078. LFCBRC    EQU    LFCB+15
  1079. LFCBDN    EQU    LFCB+0
  1080. LFCBFN    EQU    LFCB+1
  1081. LFCBFT    EQU    LFCB+9
  1082. IBP:    DS    1
  1083. IBPL:    DS    1
  1084. WORK:    DS    2
  1085. BYTE:    DS    1
  1086. LRNIB:    DB    0
  1087. COMP:    DB    0
  1088. BUFF2:    DS    128
  1089. ZCOUNT:    DB    "0000  "
  1090. NUMWD:    DB    "0000   distinct words in text.",CR,LF,"$"
  1091. NUMWDC    EQU    NUMWD+3
  1092. LNGLX1:    DB    "Lexicon word '$"
  1093. LNGLX2:    DB    "' longer than 29 characters.",CR,LF,"$"
  1094. LNGWD1:    DB    "Text word '$"
  1095. BADLEX:    DB    "Error in compacted lexicon.",CR,LF,"$"
  1096. NINPUT:    DB    "Input file not specified or non-existant.",CR,LF,"$"
  1097. NOLEX:    DB    CR,LF,"Lexicon file not specified or non-existant."
  1098.     DB    CR,LF,"$"
  1099. CHECKM:    DB    CR,LF,"Begin spelling check pass...",CR,LF,"$"
  1100. ASKLEX:    DB    "Enter lexicon file name (.LEX assumed) or 'return' "
  1101.     DB    BELL,CR,LF,"$"
  1102. COPYR:    DB    CR,LF,"Poor Person Speller (c) 1981, Alan Bomberger"
  1103.     DB    CR,LF,CR,LF,"$"
  1104. CWORD:    DS    34
  1105.     DB    "$"
  1106. CFLAGS    EQU    CWORD
  1107. CLEN    EQU    CWORD+1
  1108. CCHN    EQU    CWORD+2
  1109. CCHN1    EQU    CWORD+3
  1110. WFLGS    EQU    0
  1111. WLEN    EQU    1
  1112. WCHN    EQU    2
  1113. WCHN1    EQU    3
  1114. WORD    EQU    4
  1115. WFLGSL    EQU    7
  1116. WFLGSC    EQU    6
  1117. WFLGSP    EQU    5
  1118. ;
  1119. FOPFLG:    DB    "F"        ; file output option flag
  1120. POPFLG:    DB    "P"        ; printer output option flag
  1121. ;
  1122. BUFPNT: DW    OUTBUF        ; next location in output buffer
  1123. BUFCNT: DB    128        ; number bytes left in output buffer
  1124. OUTFCB:    DB    0,"SPELL   LEX"
  1125.     DB    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  1126. OUTBUF:    DS    128        ; output file buffer
  1127. DSKERR: DB    " ERROR",CR,LF,"$"
  1128. ;
  1129. DELIMT:    DB    " .,:;'""-?!/()[]{}",CR,LF,9
  1130.     DB    0,0,0,0,0,0,0,0
  1131. DELIML:    DB    DELIML-DELIMT-8,0
  1132. ALPHA:    DB    "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  1133.     DB    "abcdefghijklmnopqrstuvwxyz"
  1134.     DB    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  1135. ALPHAL:    DB    ALPHAL-ALPHA-20,0
  1136. T1:    DB    "EISNATR"
  1137.     DB    "OLDCUGP",CR
  1138. T2:    DB    "MHBYFVW"
  1139.     DB    "KZXQJ",1AH
  1140. ALPHC:    DS    54
  1141. WORDS:
  1142. COMWDL:    DB    192,1,0,0,"A"
  1143.  
  1144.     END    100H
  1145.