home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / language / forst / strutil.s < prev    next >
Encoding:
Text File  |  1993-10-23  |  2.2 KB  |  108 lines
  1. ( strutil.s: utility string words )
  2.  
  3. decimal
  4.  
  5. : fill  to d0 to d1 to a0  ( load registers)
  6.   for d1  d0 a0 inc c!  next ;
  7.   
  8. : cmove   to d1 to a1 to a0 ( load registers)
  9.   for d1 a0 inc c@  a1 inc c!  next ;
  10.  
  11. : cmove>  to d1 to a1 to a0 ( load registers)
  12.   d1 addto a0  d1 addto a1
  13.   for d1  a0 dec c@ a1 dec c! next
  14. ;
  15.   
  16. : move  to d1 to a1 to a0  a0 a1 d1 ( replace them on the stack)
  17.   a1 a0 >  if cmove> else cmove then
  18. ;
  19.  
  20. : type ( address,len)
  21.   { 2 regargs string length }
  22.   for length  string inc c@ emit  next
  23. ;
  24.   
  25.   
  26. ( expect package)
  27. : expectmod ;
  28.  
  29. 32 constant blank
  30. 13 constant cret
  31. 8 constant bs
  32. 27 constant esc
  33.  
  34. : backup  bs emit blank emit bs emit ; 
  35. : bspaces  0 do backup loop ;
  36.  
  37. : docontrol { 4 args char &ptr &got &more  1 local sofar }
  38.  
  39.   &got @ to sofar
  40.  
  41.   char bs =
  42.   if sofar 0>
  43.     if  -1 &got +!
  44.      1 &more +!
  45.     -1 &ptr +!  blank &ptr @ c!
  46.     backup
  47.     then  exit
  48.   then
  49.  
  50.   char esc =
  51.   if  sofar 0>
  52.     if  0 &got !
  53.         sofar &more +!
  54.         sofar negate &ptr +!
  55.         &ptr @ sofar blank fill 
  56.         sofar bspaces
  57.     then
  58.   then
  59. ;
  60.  
  61. : expect { 2 args ptr #chars 3 locals char #got #more }
  62.  
  63.     ptr #chars blank fill
  64.     0 to #got  #chars to #more
  65.     
  66.     begin #more if  key to char  then
  67.           #more  char cret = not  and
  68.     while char blank <
  69.           if  char  addr ptr  addr #got  addr #more  docontrol
  70.           else char ptr inc c!
  71.             1 addto #got
  72.             -1 addto #more
  73.             char emit
  74.           then
  75.     repeat
  76. ;      
  77.  
  78. from expectmod keep expect public
  79.  
  80. ( integer output package )
  81. : integermod ;
  82.  
  83. variable base  10 base !  ( decimal default )
  84. 32 constant blank
  85. 45 constant minus
  86. 48 constant zero
  87. 32 constant maxlen
  88. 65 10 - constant hexdigit
  89.  
  90. : . ( numb)
  91.   { 1 arg numb  4 locals sign ptr len numbase  maxlen locbuff string }
  92.  
  93.   numb to sign  numb abs to numb  base @ to numbase
  94.   0 to len  addr string maxlen +  to ptr   ( output pointer)  
  95.  
  96.   begin
  97.      numb numbase u/mod  to numb
  98.      dup 10 < if zero
  99.               else hexdigit then +
  100.      ptr dec c!  ( store char )   1 addto len
  101.   numb 0= until
  102.        
  103.   sign 0<  if  1 addto len  minus ptr dec c!  then
  104.   
  105.   ptr len type  blank emit ;
  106.  
  107. from integermod  keep base  keep .  public
  108.