home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / RCPM / LUX80.ARK / LUXDIR12.MAC < prev    next >
Text File  |  1987-02-02  |  13KB  |  607 lines
  1. ;    LUXDIR12.MAC    LUX Utility DIR transient        01-23-84
  2. ;
  3. ;  Copyright 1983 by Steven R. Holtzclaw and entered into the public domain.
  4. ;
  5. ;    Modification history in reverse order:
  6. ;
  7. ; 01-23-84    Small formatting changes - Added documentation header.
  8. ; LUXDIR12    Mark Howard
  9. ;
  10. ; 11-26-83    Original version ??
  11. ; LUXDIR11
  12. ;
  13. ;
  14.       .Z80
  15.     ASEG
  16.     ORG    100H
  17. ;
  18. CR    EQU    0DH
  19. LF    EQU    0AH
  20. ;
  21. DBUF    EQU    80H        ; default buffer
  22. FCB    EQU    05CH        ; default fcb
  23. FCB2    EQU    06CH
  24. MAXCOL    EQU    4        ; number of dir columns
  25. FENCE    EQU    '|'        ; fence character
  26. ;
  27. BEGIN:    LD    HL,0
  28.     ADD    HL,SP
  29.     LD    (STAKER+1),HL    
  30.     LD    A,(FCB2+1)    ; any files specified ?
  31.     CP    020H        ; space?
  32.     JR    NZ,BEGN2    ; ...no - continue
  33.     LD    HL,FCB2+1    ; index fcb2 filename
  34.     LD    A,'?'        ; wildcard
  35.     LD    B,11        ; 11 bytes to fill
  36. BEGN1:    LD    (HL),A        ; put a byte
  37.     INC    HL        ; next byte
  38.     DJNZ    BEGN1        ; do all 11 bytes
  39. ;
  40. BEGN2:    LD    HL,FCB
  41.     LD    DE,FCB1
  42.     LD    BC,12
  43.     LDIR            ; move to local fcb
  44.     LD    DE,DBUF        ; set default dma address
  45.     LD    C,26
  46.     CALL    5
  47.     LD    DE,FCB1        ; index .fcb for search
  48.     LD    C,17
  49.     CALL    5        ; search for first
  50.     INC    A
  51.     JP    Z,NOFILE    ; barf if not found
  52.     LD    DE,FCB1        ; index fcb for open
  53.     LD    C,15
  54.     CALL    5        ; open the file for input
  55.     XOR    A
  56.     LD    (DIRS),A    ; set dir sector count = 0
  57.     LD    (COL),A        ; set column count to 0
  58.     LD    HL,(6)        ; get bdos location
  59.     LD    DE,ORDER    ; get end of our program
  60.     SBC    HL,DE        ; available free memory
  61. ;
  62. ; calculate the approximate max number of directory entries
  63. ;
  64.     LD    B,4        ; loop here 4 times
  65. DIVLOP:    SRL    H
  66.     RR    L        ; * 2
  67.     DJNZ    DIVLOP        ; hl=hl/16
  68.     LD    (MAXDIR),HL    ; set the max number of dirs
  69.     ADD    HL,HL
  70.     LD    DE,ORDER
  71.     ADD    HL,DE        ; calculate the start of name table
  72.     LD    (NAMBUF),HL    ; base location for name table
  73.     LD    (TBLOC),HL    ; dito
  74.     CALL    ILPRT
  75.     DEFB    13,10
  76.     DEFB    'LBR directory for ',0
  77.     CALL    PFLNAM        ; print the file name
  78.     CALL    ILPRT
  79.     DEFB    13,10,10,0
  80. GETLP:    CALL    RDBLOK        ; get a block
  81.     LD    A,(DIRS)    ; increment
  82.     INC    A        ; directory
  83.     LD    (DIRS),A    ; and sector count
  84.     LD    HL,DBUF        ; point to first entry
  85.     LD    A,(HL)        ; get status byte
  86.     OR    A
  87.     JP    Z,STATOK    ; skip if active
  88. ;
  89. ; the first entry of this sector is inactive.
  90. ; if its not sector 1, all's well.  if it is,
  91. ; we dont have a lbr file!
  92. ;
  93.     LD    A,(DIRS)
  94.     DEC    A
  95.     JP    NZ,ENT2        ; skip if not first sector
  96.     CALL    ILPRT
  97.     DEFB    CR,LF
  98.     DEFB    'Directory error in ',0
  99.     CALL    PFLNAM        ; print the filename
  100.     CALL    ILPRT
  101.     DEFB    13,10,0
  102.     JP    EXIT
  103. ;
  104. STATOK:    LD    A,(DIRS)    ; check if first entry
  105.     DEC    A
  106.     JP    NZ,NOTD        ; skip if not 1st sector
  107.     LD    HL,DBUF+14    ; get lbr directory size...
  108.     LD    A,(HL)        ; ...into a
  109.     LD    (DIRSIZ),A    ; save dir size...
  110.     JP    ENT2        ; ...and skip
  111. ;
  112. NOTD:    LD    HL,DBUF+00H
  113.     CALL    ADDBUF
  114. ENT2:    LD    HL,DBUF+20H    ; point to second entry
  115.     CALL    ADDBUF        ; process it
  116. ENT3:    LD    HL,DBUF+40H    ; third entry
  117.     CALL    ADDBUF
  118. ENT4:    LD    HL,DBUF+60H    ; last entry for this sector
  119.     CALL    ADDBUF
  120.     LD    A,(DIRS)    ; get # of sectors done
  121.     LD    HL,DIRSIZ    ; compare with...
  122.     CP    (HL)        ; ...total directory size
  123.     JP    NZ,GETLP    ; loop if not finished...
  124.     JP    SPRINT        ; ...else sort and print the directory
  125. ;
  126. ; add a member name to nambuf names queue
  127. ;
  128. ADDBUF:    LD    A,(HL)        ; get status
  129.     OR    A
  130.     RET    NZ        ; skip if empty/inactive
  131.     INC    HL
  132.     LD    A,(HL)        ; get first byte of member name
  133.     OR    A
  134.     RET    Z        ; skip if a null entry
  135.     PUSH    HL        ; save dbuff pointer
  136.     LD    DE,FCB2+1    ; index 
  137.     LD    B,11        ; 11 characters to compare
  138. ADDBU1:    LD    A,(DE)        ; get character from fcb2
  139.     CP    '?'        ; '?' matches all
  140.     JR    Z,ADDBU2
  141.     CP    (HL)        ; same a command line
  142.     JR    NZ,ADDBU3    ; ...no - skip this entry
  143. ADDBU2:    INC    HL
  144.     INC    DE
  145.     DJNZ    ADDBU1        ; loop for 11 character compares
  146.     POP    HL
  147.     LD    BC,(COUNT)    ; dump entry counter
  148.     INC    BC
  149.     LD    (COUNT),BC
  150.     LD    DE,(NAMBUF)    ; get destination of move
  151.     LD    BC,11        ; 11 character file name
  152.     LDIR            ; move it
  153.     INC    HL        ; point to file size
  154.     INC    HL
  155.     LD    BC,2        ; 2 byte file size
  156.     LDIR            ; move it
  157.     LD    (NAMBUF),DE    ; save destination of next move
  158.     RET
  159. ADDBU3:    POP    HL        ; balance stack
  160.     RET
  161. ; 
  162. ; sort and print
  163. ; 
  164. SPRINT:    LD    HL,(COUNT)    ; get file name count
  165.     LD    (MAXNUM),HL    ; set number of times to print
  166.     LD    (MEMBRS),HL    ; set total number of members
  167.     LD    A,L
  168.     OR    H        ; any found?
  169.     JP    Z,DONE        ; exit if no files found
  170.     PUSH    HL        ; save file count
  171.     LD    (SUPSPC),A    ; enable leading zero suppression
  172. ; 
  173. ; 
  174. ; initialize the order table
  175. ; 
  176.     LD    HL,(TBLOC)    ; get start of name table
  177.     EX    DE,HL        ; into de
  178.     LD    HL,ORDER    ; point to order table
  179.     LD    BC,13        ; entry length
  180. ; 
  181. BLDORD:    LD    (HL),E        ; save low order address
  182.     INC    HL
  183.     LD    (HL),D        ; save high order address
  184.     INC    HL
  185.     EX    DE,HL        ; table addr to hl
  186.     ADD    HL,BC        ; point to next entry
  187.     EX    DE,HL
  188.     EX    (SP),HL        ; save tbl addr, fetch loop counter
  189.     DEC    HL        ; count down loop
  190.     LD    A,L
  191.     OR    H        ; more?
  192.     EX    (SP),HL        ; (restore tbl addr, save counter)
  193.     JP    NZ,BLDORD    ; yes, go do another one
  194.     POP    HL        ; clean loop counter off stack
  195.     LD    HL,(COUNT)    ; get count
  196.     LD    (SCOUNT),HL    ; save as # to sort
  197.     DEC    HL        ; only 1 entry?
  198.     LD    A,L
  199.     OR    H
  200.     JP    Z,DONE        ; yes, so skip sort
  201. ; 
  202. ; 
  203. ; this sort routine is adapted from software tools by kernigan and
  204. ; plaugher.
  205. ; 
  206. SORT:    LD    HL,(SCOUNT)    ; number of entries
  207. ; 
  208. SORT0:    OR    A        ; clear carry
  209.     LD    A,H        ; gap=gap/2
  210.     RRA    
  211.     LD    H,A
  212.     LD    A,L
  213.     RRA    
  214.     LD    L,A
  215.     OR    H        ; is it zero?
  216.     JP    Z,DONE        ; then none left
  217.     LD    A,L        ; make gap odd
  218.     OR    1
  219.     LD    L,A
  220.     LD    (GAP),HL
  221.     INC    HL        ; i=gap+1
  222. ; 
  223. SORT2:    LD    (VARI),HL
  224.     EX    DE,HL
  225.     LD    HL,(GAP)
  226.     LD    A,E        ; varj=i-gap
  227.     SUB    L
  228.     LD    L,A
  229.     LD    A,D
  230.     SBC    A,H
  231.     LD    H,A
  232. ; 
  233. SORT3:    LD    (VARJ),HL
  234.     EX    DE,HL
  235.     LD    HL,(GAP)    ; jg=varj+gap
  236.     ADD    HL,DE
  237.     LD    (VARJG),HL
  238.     LD    A,12        ; compare 12 chars
  239.     CALL    COMPARE        ; compare (varj) and (jg)
  240.     JP    P,SORT5        ; if a(varj)<=a(jg)
  241.     LD    HL,(VARJ)
  242.     EX    DE,HL
  243.     LD    HL,(VARJG)
  244.     CALL    SWAP        ; exchange a(varj) and a(jg)
  245.     LD    HL,(VARJ)    ; varj=varj-gap
  246.     EX    DE,HL
  247.     LD    HL,(GAP)
  248.     LD    A,E
  249.     SUB    L
  250.     LD    L,A
  251.     LD    A,D
  252.     SBC    A,H
  253.     LD    H,A
  254.     JP    M,SORT5        ; if varj>0    goto l3
  255.     OR    L        ; check for zero
  256.     JP    Z,SORT5
  257.     JP    SORT3
  258. ; 
  259. SORT5:    LD    HL,(SCOUNT)    ; for later
  260.     EX    DE,HL
  261.     LD    HL,(VARI)    ; i=i+1
  262.     INC    HL
  263.     LD    A,E        ; if i<=n goto l2
  264.     SUB    L
  265.     LD    A,D
  266.     SBC    A,H
  267.     JP    P,SORT2
  268.     LD    HL,(GAP)
  269.     JP    SORT0
  270. ; 
  271. ; new compare routine
  272. ; 
  273. COMPARE:
  274.     LD    BC,ORDER-2
  275.     ADD    HL,HL
  276.     ADD    HL,BC
  277.     EX    DE,HL
  278.     ADD    HL,HL
  279.     ADD    HL,BC
  280.     EX    DE,HL
  281.     LD    C,(HL)
  282.     INC    HL
  283.     LD    B,(HL)
  284.     EX    DE,HL
  285.     LD    E,(HL)
  286.     INC    HL
  287.     LD    D,(HL)
  288.     EX    DE,HL
  289.     LD    E,A        ; count
  290. ; 
  291. CMPLPE:    LD    A,(HL)
  292.     AND    7FH
  293.     LD    D,A
  294.     LD    A,(BC)
  295.     AND    7FH
  296.     CP    D
  297.     INC    BC
  298.     INC    HL
  299.     RET    NZ
  300.     DEC    E
  301.     JP    NZ,CMPLPE
  302.     RET    
  303. ; 
  304. ; 
  305. ; swap entries in the order table
  306. ; 
  307. SWAP:    LD    BC,ORDER-2    ; table base
  308.     ADD    HL,HL        ; *2
  309.     ADD    HL,BC        ; + base
  310.     EX    DE,HL
  311.     ADD    HL,HL        ; *2
  312.     ADD    HL,BC        ; + base
  313.     LD    C,(HL)
  314.     LD    A,(DE)
  315.     EX    DE,HL
  316.     LD    (HL),C
  317.     LD    (DE),A
  318.     INC    HL
  319.     INC    DE
  320.     LD    C,(HL)
  321.     LD    A,(DE)
  322.     EX    DE,HL
  323.     LD    (HL),C
  324.     LD    (DE),A
  325.     RET    
  326. ; 
  327. ; sort is all done - print entries
  328. ; 
  329. DONE:
  330. PLOOP:    LD    HL,(MAXNUM)    ; get number of entries to print
  331.     LD    A,H
  332.     OR    L
  333.     JP    Z,PLOOP6    ; if all done
  334. ;
  335. PLOOP1:    LD    HL,ORDER    ; index order
  336.     LD    E,(HL)        ; get entry lsb
  337.     INC    HL        ; next
  338.     LD    D,(HL)        ; get entry msb
  339.     INC    HL        ; next
  340.     LD    (PLOOP1+1),HL    ; set next order address
  341.     EX    DE,HL        ; hl scans the entry
  342. ;
  343.     LD    B,8        ; 8 character file name
  344. PLOOP2:    LD    A,(HL)        ; get a byte
  345.     CALL    CTYPE        ; print it
  346.     INC    HL        ; next character
  347.     DJNZ    PLOOP2        ; do 8 characters
  348.     LD    A,'.'
  349.     CALL    CTYPE        ; print the seperator
  350.     LD    B,3        ; 3 character file name
  351. PLOOP3:    LD    A,(HL)        ; get a byte
  352.     CALL    CTYPE        ; print it
  353.     INC    HL        ; next character
  354.     DJNZ    PLOOP3        ; do 3 characters
  355.     LD    E,(HL)        ; get the number of sectors into de
  356.     INC    HL
  357.     LD    D,(HL)
  358.     EX    DE,HL        ; put number into hl
  359.     CALL    ADDTOT        ; add to total sectors
  360.     LD    B,3
  361. PLOOP4:    SRL    H
  362.     RR    L
  363.     DJNZ    PLOOP4
  364.     INC    HL        ; round up to nearest k
  365.     CALL    PNUMB1        ; print hl as 5-digit decimal
  366.     CALL    ILPRT        ; print the "s" in "sectors"
  367.     DEFB    'k',0
  368.     LD    C,6        ; bdos direct function call
  369.     LD    E,0FFH
  370.     CALL    5        ; get keyboard character
  371.     CP    3        ; control c?
  372.     JP    Z,EXIT        ; ...yes - abort
  373.     LD    HL,(MAXNUM)
  374.     DEC    HL
  375.     LD    (MAXNUM),HL    ; bump counter down
  376.     LD    A,(COL)        ; increment...
  377.     INC    A        ; ...column count
  378.     LD    (COL),A
  379.     CP    MAXCOL        ; reached max column?
  380.     JR    NZ,PLOOP5    ; not yet - back to caller
  381.     XOR    A        ; reached max column...
  382.     LD    (COL),A        ; ...set it to zero...
  383.     CALL    CRLF        ; ...and start a new line
  384.     JP    PLOOP
  385. PLOOP5:    LD    A,L
  386.     OR    H
  387.     JP    Z,PLOOP
  388.     CALL    ILPRT
  389.     DEFB    ' ',FENCE,' ',0
  390.     JP    PLOOP
  391. ;
  392. PLOOP6:    LD    HL,(SECTRS)    ; get sector count
  393.     LD    A,L
  394.     OR    H        ; test for no files
  395.     JR    NZ,PLOO6A    ; ...if there are any sectors in .lbr
  396.     CALL    ILPRT
  397.     DEFB    'No file(s)',0
  398.     JP    EXIT
  399. ;
  400. PLOO6A:    CALL    ILPRT
  401.     DEFB    13,10,13,10,'This file contains ',0
  402.     LD    HL,(MEMBRS)
  403.     CALL    PNUMB0
  404.     CALL    ILPRT
  405.     DEFB    ' members in ',0
  406.     LD    HL,(SECTRS)
  407.     CALL    PNUMB0
  408.     CALL    ILPRT
  409.     DEFB    ' active sectors for a total of ',0
  410.     LD    HL,(SECTRS)
  411.     LD    B,3
  412. PLOOP7:    SRL    H
  413.     RR    L
  414.     DJNZ    PLOOP7
  415.     INC    HL
  416.     CALL    PNUMB0
  417.     CALL    ILPRT
  418.     DEFB    'k',13,10,0
  419.     JP    EXIT
  420. ;
  421. RDBLOK:    LD    DE,DBUF
  422.     LD    C,26
  423.     CALL    5
  424.     LD    DE,FCB1        ; point to our fcb
  425.     LD    C,20
  426.     CALL    5
  427.     OR    A
  428.     RET    Z
  429.     CALL    ILPRT
  430.     DEFB    13,10,'Premature eof in file',13,10,0
  431.     JP    EXIT        ; abort
  432. ;
  433. ADDTOT:    PUSH    HL        ; save sector count
  434.     EX    DE,HL        ; keep sector count in 'DE' for the add
  435.     LD    HL,(SECTRS)
  436.     ADD    HL,DE
  437.     LD    (SECTRS),HL    ; put number back
  438.     JR    NC,ADDTO1    ; if no overflow
  439.     LD    A,(SECTRS+2)    ; get sectors msb
  440.     INC    A        ; + 1
  441.     LD    (SECTRS+2),A    ; put ot back
  442. ADDTO1:    POP    HL        ; restore sector count
  443.     RET            ; return to caller
  444.     
  445. ;
  446. NOFILE:    CALL    ILPRT
  447.     DEFB    CR,LF
  448.     DEFB    'No such file on disk',CR,LF,0
  449.     JP    EXIT
  450. ;
  451. EXIT:
  452. STAKER:    LD    SP,STACK
  453.     RET
  454. ;
  455. PFLNAM:    LD    HL,FCB1+1
  456.     LD    B,8        ; 8 character file name
  457. PFLNA1:    LD    A,(HL)        ; get character
  458.     CP    020H        ; space ?
  459.     CALL    NZ,CTYPE    ; no - print the character
  460.     INC    HL        ; next character
  461.     DJNZ    PFLNA1        ; do 8 characters
  462.     LD    A,'.'
  463.     CALL    CTYPE
  464.     LD    B,3        ; 3 character file type
  465. PFLNA2:    LD    A,(HL)        ; get character
  466.     CP    020H        ; space ?
  467.     CALL    NZ,CTYPE    ; no - print the character
  468.     INC    HL        ; next character
  469.     DJNZ    PFLNA2        ; do 3 characters
  470.     RET
  471. ;
  472. ; write a string of characters to the crt
  473. ;
  474. ILPRT:    EX    (SP),HL        ; save return address/get character pointer
  475. ILPRT1:    LD    A,(HL)        ; get a byte
  476.     OR    A        ; test it
  477.     JR    Z,ILPRT2    ; null - end of string
  478.     CALL    CTYPE        ; else type the character
  479.     INC    HL        ; next character
  480.     JR    ILPRT1        ; loop for more
  481. ILPRT2:    EX    (SP),HL        ; restore return address
  482.     RET            ; return to caller
  483. ;
  484. CTYPE:    PUSH    AF        ; save all registers
  485.     PUSH    BC
  486.     PUSH    DE
  487.     PUSH    HL
  488.     AND    07FH        ; be sure its ascii
  489.     LD    E,A        ; into 'E'
  490.     LD    C,6        ; cpm direct console function
  491.     CALL    5
  492.     POP    HL        ; restore all registers
  493.     POP    DE
  494.     POP    BC
  495.     POP    AF
  496.     RET            ; return to caller
  497. ;
  498. CRLF:    LD    A,13
  499.     CALL    CTYPE
  500.     LD    A,10
  501.     JR    CTYPE
  502. ;
  503. PUTRG    MACRO    
  504.     PUSH    BC        ; save bc, de, hl
  505.     PUSH    DE
  506.     PUSH    HL
  507.     ENDM    
  508. GETRG    MACRO    
  509.     POP    HL        ; restore hl, de, bc
  510.     POP    DE
  511.     POP    BC
  512.     ENDM    
  513. ;
  514. PNUMB0:
  515.     PUSH    AF        ; save all regs
  516.     PUTRG    
  517.     LD    A,1        ; a=1
  518.     LD    (LSFLG0),A    ; turn on leading <sp>
  519.     LD    (SPCFLG),A
  520.     JR    PHDC
  521. ;
  522. ;
  523. ;    print hl as decimal characters w/leading spaces in 5-char field
  524. ;
  525. PNUMB1:    PUSH    AF        ; save all regs
  526.     PUTRG    
  527.     LD    A,1        ; a=1
  528.     LD    (LSFLG0),A    ; turn on leading <sp>
  529.     LD    A,0
  530.     LD    (SPCFLG),A
  531. ;
  532. PHDC:    LD    DE,1000        ; print 1000'S
  533.     CALL    PHDC1
  534.     LD    DE,100        ; print 100'S
  535.     CALL    PHDC1
  536.     LD    DE,10        ; print 10'S
  537.     CALL    PHDC1
  538.     LD    A,L        ; print 1'S
  539.     ADD    A,'0'        ; convert to ascii
  540.     CALL    CTYPE
  541.     GETRG            ; restore all regs
  542.     POP    AF
  543.     RET    
  544. ;
  545. LSFLG0:    DEFS    1        ; leading <sp> flag
  546. ;    
  547. ;  divide hl by de and print quotient with leading <sp>s
  548. ;
  549. PHDC1:    LD    C,0        ; set count
  550. PHDC2:    LD    A,L        ; sub e from l
  551.     SUB    E
  552.     LD    L,A        ; result in l
  553.     LD    A,H        ; sub d from h w/borrow
  554.     SBC    A,D
  555.     LD    H,A        ; result in h
  556.     JP    C,PHDC3        ; done if carry set (further borrow)
  557.     INC    C        ; incr count
  558.     JP    PHDC2
  559. PHDC3:    LD    A,L        ; add e to l
  560.     ADD    A,E
  561.     LD    L,A        ; result in l
  562.     LD    A,H        ; add d to h w/carry
  563.     ADC    A,D
  564.     LD    H,A        ; result in h
  565.     LD    A,C        ; get result
  566.     OR    A        ; check for zero
  567.     JP    NZ,PHDC4
  568.     LD    A,(LSFLG0)    ; check for leading <sp>
  569.     OR    A        ; print value if not (a=0)
  570.     JP    Z,PHDC4
  571.     LD    A,(SPCFLG)
  572.     OR    A
  573.     RET    NZ
  574.     LD    A,' '        ; print <sp>
  575.     CALL    CTYPE
  576.     RET    
  577. PHDC4:    XOR    A        ; turn off leading <sp>
  578.     LD    (LSFLG0),A
  579.     LD    A,C        ; get value
  580.     ADD    A,'0'        ; convert to ascii
  581.     CALL    CTYPE
  582.     RET    
  583. ;
  584. SPCFLG:    DEFB    0
  585. SECTRS:    DEFB    0,0,0
  586. MAXNUM:    DEFW    0
  587. MAXDIR:    DEFW    0
  588. NAMBUF:    DEFW    0
  589. MEMBRS:    DEFW    0
  590. DIRS:    DEFB    0        ; # of dir sectors processed
  591. DIRSIZ:    DEFB    0        ; # of total dir sectors
  592. COL:    DEFB    0        ; column count
  593. SUPSPC:    DEFB    0
  594. TBLOC:    DEFW    0
  595. COUNT:    DEFW    0
  596. SCOUNT:    DEFW    0
  597. GAP:    DEFW    0
  598. VARI:    DEFW    0
  599. VARJ:    DEFW    0
  600. VARJG:    DEFW    0
  601. FCB1:    DEFS    36
  602.     DEFS    50        ; 25 level stack
  603. STACK:    DEFW    0        ; save cp/m stack pointer here
  604. ORDER    EQU    $
  605. ;
  606.     END
  607.