home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / langs / forst.zoo / forst / src / memory.s < prev    next >
Encoding:
Text File  |  1990-12-10  |  2.9 KB  |  209 lines
  1. ; MEMORY.S: utility routines.
  2. ; <C> John Redmond 1989
  3. ;  Public domain for non-commercial use.
  4. ;
  5.     section    text
  6.     even
  7. ;
  8. _fill:
  9.     movem.l (a6)+,d0/d1/a0        ;address,length,char 
  10.     tst.l    d1            ;length zero? 
  11.     beq    .cfx 
  12. .cflp:    move.b    d0,(a0)+        ;store char 
  13.     subq.l    #1,d1
  14.     bne    .cflp
  15. .cfx:    rts 
  16. ; 
  17. _cmove: movem.l (a6)+,d0/a0/a1        ;source,dest,length
  18.     tst.l    d0            ;zero length? 
  19.     beq    .cmx 
  20. .cmlp:    move.b    (a1)+,(a0)+ 
  21.     subq.l    #1,d0
  22.     bne    .cmlp
  23. .cmx:    rts 
  24. ; 
  25. _cmovegt:
  26.     movem.l (a6)+,d0/a0/a1        ;source,dest,length 
  27.     tst.l    d0            ;zero length? 
  28.     beq    .cmx 
  29.     adda.l    d0,a0
  30.     adda.l    d0,a1
  31. .cmlp:    move.b    -(a1),-(a0)
  32.     subq.l    #1,d0
  33.     bne    .cmlp
  34. .cmx:    rts 
  35. ; 
  36. _rot:    move.l    d2,-(a7)
  37.     pop    d0
  38.     pop    d1
  39.     pop    d2
  40.     push    d1
  41.     push    d0
  42.     push    d2
  43.     move.l    (a7)+,d2
  44.     rts
  45. ;
  46. _pick:    pop    d0
  47.     bmi    .px
  48.     asl.l    #2,d0
  49.     move.l    0(a6,d0.l),d0
  50.     push    d0
  51. .px:    rts
  52. ;
  53. _twodup: move.l (a6),d1
  54.     move.l    4(a6),d0
  55.     push    d0
  56.     push    d1
  57.     rts
  58. ;
  59. _twoover: move.l 8(a6),d1
  60.     move.l    12(a6),d0
  61.     push    d0
  62.     push    d1
  63.     rts
  64. ;
  65. _twoswap: movem.l d2-d3,-(a7)
  66.     movem.l (a6)+,d0-d3
  67.     movem.l d0-d1,-(a6)
  68.     push    d3
  69.     push    d2
  70.     movem.l (a7)+,d2-d3
  71.     rts
  72. ;
  73. _tworot: movem.l d2-d5,-(a7)
  74.     movem.l (a6)+,d0-d5
  75.     movem.l d0-d3,-(a6)
  76.     push    d1
  77.     move.l    d0,d1
  78.     push    d1
  79.     movem.l (a7)+,d2-d5
  80.     rts
  81. ;
  82. _twodrop: addq.l #8,a6
  83.     rts
  84. ;
  85. _depth: lea    dstack,a0
  86.     move.l    (a0),d0
  87.     sub.l    a6,d0
  88.     asr.l    #2,d0
  89.     push    d0
  90.     rts
  91. ;
  92. _minusrot: movem.l d1-d2,-(a7)
  93.     movem.l (a6)+,d0-d2
  94.     push    d0
  95.     push    d2
  96.     push    d1
  97.     movem.l (a7)+,d1-d2
  98.     rts
  99. ;
  100. _tuck:    pop    d0
  101.     pop    d1
  102.     push    d0
  103.     push    d1
  104.     push    d0
  105.     rts
  106. ;
  107. _spstore: pop    a6
  108.     rts
  109. ;
  110. _rpstore: pop    a7
  111.     rts
  112. ;
  113. _on:    pop    a0
  114.     move.l    #-1,(a0)
  115.     rts
  116. ;
  117. _off:    pop    a0
  118.     clr.l    (a0)
  119.     rts
  120. ;
  121. _pad:    bsr    _here
  122.     add.l    #$100,(a6)
  123.     rts
  124. ;
  125. _notrailing:
  126.     movem.l (a6)+,d0/a0 
  127. .trlp:    subq.l    #1,d0
  128.     bmi    .empty
  129.     move.b    (a0,d0.l),d1
  130.     cmp.b    #32,d1        ;a blank?
  131.     bne    .end
  132.     bra    .trlp
  133. .end:    addq.l    #1,d0        ;adjust length
  134.     movem.l d0/a0,-(a6)    ;^string & trimmed length
  135.     rts
  136. .empty: clr.l    d0
  137.     movem.l d0/a0,-(a6)
  138.     rts
  139. ;
  140. _comp:    pop    d0        ;length
  141.     moveq    #0,d1        ;result
  142.     pop    a0
  143.     pop    a1
  144.     tst.l    d0
  145.     beq    .cx
  146.     subq.l    #1,d0
  147. .clp:    cmpm.b    (a0)+,(a1)+
  148.     dbne    d0,.clp
  149.     beq    .cx
  150.     bcs    .cw
  151.     moveq    #1,d1
  152.     bra    .cx
  153. .cw    moveq    #-1,d1
  154. .cx    push    d1
  155.     rts
  156. ;
  157.     section    data
  158.     even
  159. ;
  160. ; string and block words
  161. ;
  162.     dc.b    $84,'FILL',$a0
  163.     ptrs    _fill,18
  164. ;
  165.     dc.b    $84,'TYPE',$a0
  166.     ptrs    _type,18
  167. ;
  168.     dc.b    $85,'CMOV','E'!$80
  169.     ptrs    _cmove,18
  170. ;
  171.     dc.b    $86,'CMOVE>',$a0
  172.     ptrs    _cmovegt,20
  173. ;
  174.     dc.b    $89,'-TRAILIN','G'!$80
  175.     ptrs    _notrailing,22
  176. ;
  177.     dc.b    $84,'COMP',$a0
  178.     ptrs    _comp,18
  179. ;
  180.     dc.b    $83,'RO','T'!$80
  181.     ptrs    _rot,16
  182. ;
  183.     dc.b    $84,'-ROT',$a0
  184.     ptrs    _minusrot,18
  185. ;
  186.     dc.b    $84,'PICK',$a0
  187.     ptrs    _pick,18
  188. ;
  189.     dc.b    $84,'TUCK',$a0
  190.     ptrs    _tuck,18
  191. ;
  192.     dc.b    $84,'2DUP',$a0
  193.     ptrs    _twodup,18
  194. ;
  195.     dc.b    $85,'2OVE','R'!$80
  196.     ptrs    _twoover,18
  197. ;
  198.     dc.b    $85,'2SWA','P'!80
  199.     ptrs    _twoswap,18
  200. ;
  201.     dc.b    $84,'2ROT',$a0
  202.     ptrs    _tworot,18
  203. ;
  204.     dc.b    $85,'DEPT','H'!$80
  205.     ptrs    _depth,18
  206. ;
  207.     dc.b    $83,'PA','D'!$80
  208.     ptrs    _pad,16
  209.