home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / utils / filcpy / rpl.lbr / RPL.FZR / RPL.FOR
Encoding:
Text File  |  1987-02-15  |  17.3 KB  |  741 lines
  1.     subroutine rpl
  2.  
  3. C.. RPL - Replace File Copy.
  4. C..
  5. C.. Copyright (c) 1987, Richard A. Holmes (aka Holmes Compleat Computing)
  6. C.. 4845 San Sebastian Avenue
  7. C.. Las Vegas, Nevada 89121
  8. C.. (702) 458-4933
  9. C..
  10. C.. Public domain.  Permission is hereby granted for non-commercial use
  11. C.. and distribution of this program.  No warranties, guarantees or promises
  12. C.. are made as to its functioning.  It works for me.  If you find it 
  13. C.. useful, you may feel free to send $5.00 to the above address.
  14. C..
  15. C.. This program is used to copy a disk file to another disk file.
  16. C.. If the destination file already exists, it will be overwritten with
  17. C.. the new one.  It is neither first deleted and then created, nor is 
  18. C.. any renaming performed.  This is useful to copy new versions of 
  19. C.. programs onto a carefully laid out disk.  If the new file is longer
  20. C.. than the old one, first (nominally) 4K of disk space is reserved
  21. C.. (presumably on the inner tracks) and then the new sectors will
  22. C.. come from CP/Ms standard allocation of disk space.  If the old file
  23. C.. is longer than the new file, unused sectors will exist at the end
  24. C.. of the file.
  25.  
  26. C.. If you modify this code, please don't use REAL variables or
  27. C.. any sort of FORTRAN Reads or Writes.
  28.  
  29.     include rpl.dcl
  30.     integer fcount
  31.     include rpl.blk
  32.     data fcount /0/, nomore /.false./
  33.  
  34. C.. Say hi.
  35.     call strout('RPL - Replace Copy V1.0 $')
  36.     call strend('   (c) 1987, Holmes Compleat Computing$')
  37. C.. General program initialization.
  38.     call inirun
  39. C.. Copy the file(s).
  40. 100    continue
  41.     call setfil(nomore)
  42.     if (nomore) go to 200
  43.     call cpyini
  44.     call copy
  45.     fcount = fcount + 1
  46.     if (ambig) go to 100
  47.  
  48. C.. That's all folks.
  49. 200    continue
  50.     call endrun
  51.     end
  52.  
  53.  
  54.     subroutine copy
  55.  
  56. C.. This feller does the copying of the file.
  57.  
  58.     integer size,inrec,outrec,maxsec,curptr,cur1,cursec
  59.     byte rsectr,stat,wsectr
  60.     include rpl.dcl
  61.     include rpl.blk
  62.  
  63. C.. Open the input file.
  64.     call setusr(iuser)
  65.     call opin
  66. C.. Open the output file.
  67.     call setusr(ouser)
  68.     call opout
  69. C.. Initialize the counters.
  70.     maxsec = 100
  71.     inrec = -1
  72.     outrec = -1
  73. 90    continue
  74.     call setusr(iuser)
  75.     curptr = -128
  76.     cursec = 0
  77. 100    continue
  78.     curptr = curptr + 128
  79.     if (curptr.ge.12800) go to 110
  80.     inrec = inrec + 1
  81.     stat = rsectr(curptr,inrec)
  82.     if (stat.lt.0) go to 900
  83.     if (stat.gt.0) go to 800
  84.     cursec = cursec + 1
  85.     go to 100
  86.  
  87. C.. The buffer filled up.  Write it to disk.
  88. 110    continue
  89.     call setusr(ouser)
  90.     curptr = -128
  91.     do 120 i = 1,maxsec
  92.     outrec = outrec + 1
  93.     curptr = curptr + 128
  94.     stat = wsectr(curptr,outrec)
  95.     if (stat.ne.0) go to 700
  96. 115    continue
  97. 120    continue
  98.     go to 90
  99.  
  100. C.. Error on writing.
  101. 700    continue
  102.     call ioerr(stat)
  103.     call chrout(10)
  104.     call chrout(13)
  105.     call strout (' Unknown I/O error $')
  106.     call decbyt(stat)
  107.     call strout(' in writing sector $')
  108.     call decint(outrec)
  109.     call strend('$')
  110.     call endrun
  111.  
  112. C.. Error on reading.
  113. 800    continue
  114.     call ioerr(stat)
  115.     call strout (' Unknown I/O error $')
  116.     call decbyt(stat)
  117.     call strout(' in reading sector $')
  118.     call decint(outrec)
  119.     call strend('$')
  120.     call endrun
  121.  
  122. C.. End of file on input.  Flush out the buffer.
  123. 900    continue
  124.     call setusr(ouser)
  125.     inrec = inrec - 1
  126.     if (curptr.le.0) go to 920
  127.     curptr = -128
  128.  
  129.     do 910 i = 1,cursec
  130.     curptr = curptr + 128
  131.     outrec = outrec + 1
  132.     stat = wsectr(curptr,outrec)
  133.     if (stat.ne.0) go to 700
  134. 910    continue
  135.  
  136. C.. Close the output file.
  137. 920    continue
  138.     call setusr(ouser)
  139.     call clout
  140. C.. Report on status of copy.
  141.     if (insize.eq.osize) go to 930
  142.     call strout('  --  $')
  143.     if (insize.gt.osize) go to 940
  144.     if ((osize-insize).ne.1) go to 925
  145.     call strend('1 unused sector exists.$')
  146.     go to 990
  147.  
  148. 925    continue    
  149.     call decint(osize - insize)
  150.     call strend(' unused sectors exist.$')
  151.     go to 990
  152.  
  153. C.. Both files had the same size.
  154. 930    continue
  155.     if (insize.ne.0) go to 935
  156.     call strend('  --  File is vacuous.$')
  157.     go to 990
  158.  
  159. 935    continue
  160.     call strend('$')
  161.     go to 990
  162.  
  163. 940    continue
  164.     if (insize-osize.ne.1) go to 950
  165.     call strend('1 new sector written.$')
  166.     go to 990
  167.  
  168. 950    continue
  169.     call decint(insize-osize)
  170.     call strend(' new sectors written.$')
  171. 990    continue
  172.     return
  173.     end
  174.  
  175.  
  176.     subroutine ioerr(stat)
  177.  
  178. C.. Show what an I/O error means.  End program if code is known.
  179. C.. Return otherwise.
  180.  
  181.     byte stat
  182.  
  183.     if ((stat.lt.1).or.(stat.gt.6)) return
  184.     call chrout(13)
  185.     call chrout(10)
  186.     call strout(' I/O error - $')
  187.     if (stat.eq.1) call strend
  188.      +            ('reading unwritten data.$')
  189.     if (stat.eq.2) call strend
  190.      +        ('disk is full.$')
  191.     if (stat.eq.3) call strend
  192.      +        ('cannot close current extent.$')
  193.     if (stat.eq.4) call strend
  194.      +        ('seek to unwritten extent.$')
  195.     if (stat.eq.5) call strend
  196.      +        ('directory space exhaused.$')
  197.     if (stat.eq.6) call strend
  198.      +        ('seek past physical end of disk.$')
  199.     call endrun
  200.     end
  201.  
  202.  
  203.     subroutine inirun
  204.  
  205. C.. Parse the command string.
  206.  
  207.     include rpl.dcl
  208.     byte blank,peek,sfirst,status,str(7),stat
  209.     byte svfile(11)
  210.     integer start,maxpos,ksize,fsize,reserv
  211.     logical iambig,oambig,badopt
  212.     common /svfile/svfile /reserv/ reserv
  213.     include rpl.blk
  214.  
  215.     include rpl.dat
  216.     data blank /1h /
  217.     data str /6*1h ,1h$/
  218.     data ambig /.false./
  219.  
  220. C.. Start picking characters from 82H in memory.
  221.     start = x'82'
  222.  
  223. C.. Set the maximum position to be examined.
  224.     maxpos = peek(x'80')
  225.     maxpos = maxpos + 128
  226. C.. Get the output file specification.
  227.     call fspec(outfil,outdev,start,maxpos,ouser,oambig)
  228.     if (oambig) go to 80
  229.     if ((outdev.eq.0).and.(outfil(1).eq.blank)) go to 80
  230. C.. Get the input file specifications.
  231.     call fspec(infile,indev,start,maxpos,iuser,iambig)
  232.     if (.not.iambig) go to 60
  233.     if (outfil(1).ne.blank) go to 80
  234.     ambig = .true.
  235.     do 50 i = 1,11
  236.     svfile(i) = infile(i)
  237. 50    continue
  238.  
  239. C.. The source file may not be omitted.
  240. 60    continue
  241.     if (infile(1).ne.blank) go to 90
  242. C.. Give mini-help on syntax type errors.
  243. 80    continue
  244.     call help
  245.     call endrun
  246.  
  247. C.. If the destination file was omitted, copy the input file spec.
  248. 90    continue
  249.     if (outfil(1).ne.blank) go to 200
  250.     do 100 i = 1,11
  251.     outfil(i) = infile(i)
  252. 100    continue
  253.  
  254. C.. Check out the options.
  255.  
  256. 200    continue
  257.     badopt = .false.
  258.        call setopt(start,maxpos,badopt)
  259.     if (badopt) go to 80
  260.     if (ambig) call makres(reserv)
  261.     return
  262.     end
  263.  
  264.  
  265.     subroutine cpyini
  266.  
  267. C.. Initialize for a file copy.
  268.  
  269.     byte status,sfirst
  270.     integer fsize,reserv
  271.     include rpl.dcl
  272.     common /reserv/ reserv
  273.     include rpl.blk
  274.  
  275. C.. See if the input file exists.
  276. 200    continue
  277.     call setusr(iuser)
  278.     status = sfirst(indev,infile)
  279.     if (status.eq.-1) call error(' No files matched.$')
  280.  
  281. 300    continue
  282.     osize = 0
  283.     insize = fsize(indev,infile)
  284.  
  285. C.. Determine how big the output file is now.
  286.     call setusr(ouser)
  287.     status = sfirst(outdev,outfil)
  288.     if (status.eq.-1) go to 350
  289.     osize = fsize(outdev,outfil)
  290. 350    continue
  291.     call strout(' ($')
  292.     call decint((insize+7)/8)
  293.     call strout('k)$')
  294. C.. Reserve space if necessary.
  295.     if ((.not.ambig).and.(insize.gt.osize)) call makres(reserv)
  296.     return
  297.     end
  298.  
  299.  
  300.     subroutine fspec(filnam,device,start,maxpos,usrnum,ambig)
  301.  
  302. C.. This routine will extract a file specification from the command line.
  303.  
  304.     byte filnam(11),device,peek,equals,blank,dot,aa,char,colon
  305.     byte usrnum,aster,hook
  306.     integer start,pos,maxpos
  307.     logical ambig
  308.     data equals,blank,dot /1h=,1h ,1h./, aa /1hA/, colon /1h:/
  309.     data aster,hook /1h*,1h?/
  310.  
  311.     ambig = .false.
  312.     do 50 i = 1,11
  313.     filnam(i) = blank
  314. 50    continue
  315.  
  316. C.. POS will reflect the current position in the command line.
  317.     pos = start
  318. C.. Get the device and user number.
  319.     call getdu(device,usrnum,pos,maxpos)
  320.     if (pos.gt.maxpos) go to 600
  321. C.. Gather up the file name.
  322.     do 300 i = 1,9
  323.     char = peek(pos)
  324. C.. Check for ambiguous file name.
  325.     if (char.eq.hook) ambig = .true.
  326.     if (char.ne.aster) go to 70
  327.     do 60 ii = i,8
  328.     filnam(ii) = hook
  329. 60    continue
  330.     ambig = .true.
  331.     go to 80
  332.  
  333. C.. Blanks and equals terminate the file name.
  334. 70    continue
  335.     if ((char.eq.blank).or.(char.eq.equals)) go to 500
  336. C.. Dots start the extension.
  337.     if (char.eq.dot) go to 400
  338.     filnam(i) = char
  339. 80    continue
  340.     pos = pos + 1
  341.     if (pos.gt.maxpos) go to 600
  342. 300    continue
  343.     call error(' File name is too long.$')
  344. C.. Put together the file extension.
  345. 400    continue
  346.     pos = pos + 1
  347.     if (pos.gt.maxpos) go to 600
  348.     do 450 i = 1,3
  349.     char = peek(pos)
  350.     if (char.eq.hook) ambig = .true.
  351.     if (char.ne.aster)go to 420
  352.     do 410 ii = i,3
  353.     filnam(ii+8) = hook
  354. 410    continue
  355.     ambig = .true.
  356.     go to 430
  357.  
  358. 420    continue
  359.     if ((char.eq.blank).or.(char.eq.equals)) go to 500
  360.     filnam(i+8) = char
  361. 430    continue
  362.     pos = pos + 1
  363.     if (pos.gt.maxpos) go to 600
  364. 450    continue
  365.  
  366. C.. The end of the file spec was found.
  367. 500    continue
  368. 600    continue
  369.     pos = pos + 1
  370. 510    continue
  371.     start = pos
  372.     return
  373.     end
  374.  
  375.  
  376.     subroutine getdu(device,usrnum,pos,maxpos)
  377.  
  378. C.. Get device and usernumber of a file.
  379.  
  380.     byte device,usrnum,char,peek,char0,char9,chara,charp,colon
  381.     integer pos,maxpos
  382.     data char0,char9,chara,charp,colon /1h0,1h9,1hA,1hP,1h:/
  383.  
  384. C.. Default drive.
  385.     call getdev(device)
  386. C.. Get current user number.
  387.     call getusr(usrnum)
  388.     if (pos.gt.maxpos) go to 900
  389. C.. We should see a colon in the first four characters.
  390.     do 10 i = 0,3
  391.     if (peek(pos+i).eq.colon) go to 20
  392. 10    continue
  393.     go to 900
  394.  
  395. C.. Get the user number and device.
  396. 20    continue
  397.     if (pos.gt.maxpos)go to 900
  398.     char = peek(pos)
  399.     pos = pos + 1
  400.     if (char.eq.colon) go to 900
  401.     if (char.lt.char0) go to 40
  402.     if (char.gt.char9) go to 30
  403.     usrnum = usrnum*10 + (char-char0)
  404.     go to 20
  405.  
  406. 30    continue
  407.     if ((char.ge.chara).and.(char.le.charp)) go to 50
  408. 40    continue
  409.     call error('Bad device/user specified.$')
  410.  
  411. 50    continue
  412.     device = char - chara + 1
  413.     go to 20
  414.  
  415. 900    continue
  416.     if ((usrnum.gt.15).or.(usrnum.lt.0))
  417.      +        call error (' User number is out of range.$')
  418.     return
  419.     end
  420.  
  421.  
  422.     subroutine encdxx(string,positn,value)
  423.  
  424. C.. This routine will encode the provided VALUE into a decimal
  425. C.. string of characters, stored in STRING, with the leftmost
  426. C.. in column POSITN.  Leading blanks are used.  Three digitss
  427. C.. are always used.  VALUE is treated as an unsigned, integer
  428. C.. value.  Value are obviously limited to 0 through 999.
  429.  
  430.     byte string(1),positn,zero,blank,d1,d2,d3
  431.     byte ascii(10)
  432.     integer int,value
  433.     data zero,blank /1h0,1h /,ascii/1h0,1h1,1h2,1h3,1h4,
  434.      +        1h5,1h6,1h7,1h8,1h9/
  435.  
  436. C.. Isolate the individual digits.
  437.     int = value
  438.     d1 = int / 100
  439.     d2 = (int - d1*100) / 10
  440.     d3 = int / 10
  441.     d3 = int - (d2*10) - (d1*100)
  442. C.. Convert the digits to ASCII characters.
  443.     d1 = ascii(d1+1)
  444.     d2 = ascii(d2+1)
  445.     d3 = ascii(d3+1)
  446. C.. Blank fill the leading zeros.
  447.     if (d1.ne.ascii(1)) go to 100
  448.     d1 = blank
  449.     if (d2.ne.ascii(1)) go to 100
  450.     d2 = blank
  451. 100    continue
  452. C.. Fill the characters in the user area.
  453.     string(positn) = d1
  454.     string(positn+1) = d2
  455.     string(positn+2) = d3
  456.     return
  457.  
  458.     end
  459.  
  460.  
  461.     subroutine encod6(string,pos,value)
  462.  
  463. C.. This routine will convert a integer value to
  464. C.. ASCII for displaying.  It is like ENCODE, but
  465. C.. uses six character positions.
  466.  
  467.     byte string(1),pos,chzero,blank,pos1
  468.     integer value,part1,part2
  469.     data chzero,blank/1h0,1h /
  470.  
  471. C.. Isolate the two parts. (The base routine can handle
  472. C.. exactly three digits.)
  473.     part1 = value / 1000
  474.     part2 = value - (part1 * 1000)
  475.     pos1 = pos + 5
  476. C.. Clear out the whole message area.
  477.     do 100 i = pos,pos1
  478.     string(i) = blank
  479. 100    continue
  480. C.. Fill in the bottom three characters.
  481.     call encdxx(string,pos+3,part2)
  482. C.. If the top three digits are all zero, we are done.
  483.     if (part1.eq.0) go to 900
  484. C.. Change leading blanks in the bottom three positions
  485. C.. to zeros.
  486.     if (string(pos+4).eq.blank) string(pos+4) = chzero
  487.     if (string(pos+3).eq.blank) string(pos+3) = chzero
  488. C.. Now do the top three digits.
  489.     call encdxx(string,pos,part1)
  490. 900    continue
  491.     return
  492.     end
  493.  
  494.  
  495.     subroutine decint(value)
  496.  
  497. C.. Show integer in decimal form.
  498.  
  499.     integer value
  500.     byte str(7),blank
  501.     data str /6*1h ,1h$/,blank /1h /
  502.  
  503.     call encod6(str,1,value)
  504.     do 100 i = 1,6
  505.     if (str(i).ne.blank) go to 200
  506. 100    continue
  507. 200    continue
  508.     call strout(str(i))
  509.     return
  510.     end
  511.     
  512.  
  513.     subroutine decbyt(byte)
  514.  
  515. C.. Show byte in decimal form.
  516.  
  517.     byte byte
  518.     integer value,mask
  519.     data mask /x'00ff'/
  520.  
  521.     value = byte
  522.     value = value.and.mask
  523.     call decint(value)
  524.     return
  525.     end
  526.  
  527.  
  528.     subroutine setfil(nomore)
  529.  
  530. C.. This routine will set up the input and output FCBs 
  531. C.. from the next file found which matches the ambiguous
  532. C.. specification from the user.  When no more match, 
  533. C.. NOMORE is returned true.
  534.  
  535.     include rpl.dcl
  536.     logical nomore,first
  537.     integer dirptr,fcount,reserv
  538.     byte amb1st,ambnxt,code,nofile,blank,chara,status,sfirst
  539.     byte svfile(11),fcb(36),dirsec(128)
  540.     include rpl.blk
  541.     common /svfile/svfile /reserv/ reserv
  542.  
  543.     data first /.true./,nofile /x'ff'/
  544.     data fcb /36*0/,blank /1h /,chara /1hA/
  545.  
  546.     nomore = .false.
  547.     if (ambig) go to 10
  548. C.. This is not an ambiguous run.  Allow only one pass through here.
  549.     nomore = .true.
  550.     if (.not.first) return
  551.     nomore = .false.
  552.     first = .false.
  553. C.. Make sure that the file exists.
  554.     call setusr(iuser)
  555.     status = sfirst(indev,infile)
  556.     if (status.ne.-1) go to 500
  557.     call strend('Input file does not exist.$')
  558.     call chrout(7)
  559.     call endrun
  560.  
  561. C.. This is an ambiguous run.  The source file had wildcards.
  562. 10    continue
  563.     if (.not.first) go to 400
  564. C.. On the first call, scan through the directory for the specified
  565. C.. user and build a list of matching file names.  Up to 255 are allowed.
  566.     call setusr(iuser)
  567.     do 50 i = 1,11
  568.     fcb(i+1) = svfile(i)
  569. 50    continue
  570.     fcb(1) = indev
  571.     first = .false.
  572.     fcount = 0
  573. C.. Find the first file using the ambiguous specification.
  574.     code = amb1st(fcb)
  575.     go to 200
  576.  
  577. C.. Find the next file.
  578. 100    continue
  579.     code = ambnxt(fcb)
  580. 200    continue
  581.     if (code.ne.nofile) go to 250
  582.     go to 350
  583.  
  584. C.. A file was found.  Copy the file name from the directory sector.
  585. 250    continue
  586.     dirptr = code*32
  587.     do 300 i = 1,11
  588.     infile(i) = peek(x'81'+dirptr)
  589.     dirptr = dirptr + 1
  590. 300    continue
  591. C.. Stash the file name in the list.
  592.     call putfil(infile)
  593.     fcount = fcount + 1
  594.     go to 100
  595.  
  596. C.. If more than one file matched, tell ahead of time how many
  597. C.. files will be processed.
  598. 350    continue
  599.     if (fcount.eq.0) go to 360
  600.     if (fcount.eq.1) go to 370
  601.     call strout(' $')
  602.     call decint(fcount)
  603.     call strend(' files will be processed.$')
  604.     go to 400
  605.  
  606. C.. No files found in an wildcard specification.
  607. 360    continue
  608.     call strend('No such file.$')
  609.     call endrun
  610.  
  611. 370    continue
  612. CCC    call strend(' 1 file will be processed.$')
  613.  
  614. C.. Reserve the saved space now.
  615. 380    continue
  616.     call makres(reserv)
  617.  
  618. C.. This run used ambiguous filespec.  The file list has been build.
  619. C.. Extract the next file name.
  620. 400    continue
  621.     call getfil(infile)
  622.     do 450 i = 1,11
  623.     outfil(i) = infile(i)
  624. 450    continue
  625.     if (infile(1).ne.0) go to 500
  626.     nomore = .true.
  627.     return
  628.  
  629. C.. Make sure we don't copy back onto ourself.  This works ok but
  630. C.. is senseless.
  631. 500    continue
  632.     if (indev.ne.outdev) go to 550
  633.     if (ouser.ne.iuser) go to 550
  634.     do 520 i = 1,11
  635.     if (outfil(i).ne.infile(i)) go to 550
  636. 520    continue
  637.     call error (' Identity copy ignored.$')
  638.  
  639. C.. Tell what is going on.
  640. 550    continue
  641.     call strout(' Copying $')
  642.     call chrout(outdev + chara-1)
  643.     call decbyt(ouser)
  644.     call chrout(':')
  645.     call shofil(outfil)
  646.     call strout(' <-- $')
  647.     call chrout(indev + chara-1)
  648.     call decbyt(iuser)
  649.     call strout(':$')
  650.     call shofil(infile)
  651.     return
  652.     end
  653.  
  654.  
  655.     subroutine shofil(name)
  656.  
  657. C.. This routine sends a file spec to the display.
  658.  
  659.     byte name(11),blank 
  660.     data blank /1h /
  661.  
  662.     do 100 i = 1,8
  663.     if (name(i).ne.blank) call chrout(name(i))
  664. 100    continue
  665.     if ((name(9).eq.blank).and.(name(10).eq.blank).and.
  666.      +        (name(11).eq.blank)) return
  667.     call chrout('.')
  668.     do 200 i = 9,11
  669.     if (name(i).ne.blank) call chrout(name(i))
  670. 200    continue
  671.     return
  672.     end
  673.  
  674.  
  675.     subroutine setopt(start,maxpos,error)
  676.  
  677. C.. This routine parses the options following the source file spec.
  678. C.. If I knew how to do it, I would allow "T" to indicate trimming
  679. C.. off of extra sectors.  "-T" would turn off trimming.  If you come
  680. C.. up with a good way to do it, please let me know.
  681.  
  682.     byte ch0,ch9,cht,dash,chk,blank,dollar
  683.     byte peek,char
  684.     integer reserv,pos,start,maxpos,defres
  685.     logical trim,error
  686.  
  687.     common /trim/ trim
  688.     common /reserv/ reserv
  689.  
  690.     data ch0,ch9,chk,cht,dash,blank,dollar
  691.      +             /1h0,1h9,1hK,1hT,1h-,1h ,1h$/
  692.     data trim /.true./
  693. C.. Change DEFRES on the next line for a new default reserve size.
  694.     data reserv /0/,defres/4/
  695.  
  696.     pos = start
  697.     error = .false.
  698. C.. See if we are already beyond the end of line
  699.     if (pos.gt.maxpos) go to 800
  700. C.. Ignore leading blanks and wait for a dollar sign.
  701. 10    continue
  702.     if (peek(pos).ne.blank) go to 20
  703.     pos = pos + 1
  704.     if (pos.gt.maxpos) go to 800
  705. 20    continue
  706.     if (peek(pos).ne.dollar) go to 900
  707. C.. We have the dollar sign.  Check out what is after it.
  708. 100    continue
  709.     pos = pos + 1
  710.     if (pos.gt.maxpos) go to 800
  711.     char = peek(pos)
  712. CCC    if (char.eq.cht) go to 200
  713. CCC    if (char.eq.dash) go to 300
  714.     if ((char.ge.ch0).and.(char.le.ch9)) go to 400
  715.     if (char.eq.chk) go to 100
  716.     go to 900
  717.  
  718. C.. T - set trim status active (the default).
  719. CCC200    continue
  720. CCC    go to 100
  721.  
  722. C.. minus sign, turn off trim.
  723. CCC300    continue
  724. CCC    trim = .false.
  725. CCC    go to 100
  726.  
  727. C.. Number.  Build up the reserve space amount.
  728. 400    continue
  729.     reserv = reserv*10 + (char - ch0)
  730.     go to 100
  731.  
  732. 800    continue
  733.     if (reserv.eq.0) reserv = defres
  734.     return
  735.  
  736. C.. Invalid something was found.
  737. 900    continue
  738.     error = .true.
  739.     return
  740.     end
  741.