home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol171 / list1.lst < prev    next >
Encoding:
File List  |  1984-05-30  |  23.0 KB  |  711 lines
  1.        ;
  2.        ;  This file contains the assembler language code for all of the 
  3.        ;  operations in the M68K compiler.
  4.        ;
  5.        ;  Register usage....
  6.        ;       A7 - Hardware and return stack pointer
  7.        ;       A6 - Data stack pointer
  8.        ;       A5 - Pointer to variable pool
  9.        ;       A4 - Reserved for future use
  10.        ;
  11.        ;       All other registers are free to be used by any word that needs them
  12.        ;       and are to be considered as altered across word boundaries.
  13.        ;
  14.        ;******************************************************************************
  15.        ;
  16.        ;  Arithmetic operations
  17.        ;
  18.        ;******************************************************************************
  19.        ;
  20.        ;  +            ( n1 n2 -- sum )
  21.        ;
  22. 301E            MOVE.W  (A6)+,D0                ;Get n2
  23. D156            ADD.W   D0,(A6)                 ;n1 + n2
  24.        ;
  25.        ;  -            ( n1 n2 -- dif )        n1-n2
  26.        ;
  27. 301E            MOVE.W  (A6)+,D0                ;Get n2
  28. 9156            SUB.W   D0,(A6)                 ;n1 - n2
  29.        ;
  30.        ;  *            ( n1 n2 -- prod )
  31.        ;
  32. 301E            MOVE.W  (A6)+,D0                ;Get n2
  33. C1D6            MULS    (A6),D0                 ;n2 * n1
  34. 3C80            MOVE.W  D0,(A6)
  35.        ;
  36.        ;  /            ( n1 n2 -- quot )       n1/n2
  37.        ;
  38. 4C9E 0003       MOVEM.W (A6)+,D0/D1             ;Get operands sign extended
  39. 83C0            DIVS    D0,D1                   ;n1/n2
  40. 3D01            MOVE.W  D1,-(A6)
  41.        ;
  42.        ;  */           ( n1 n2 n3 -- n-result )  n1*n2/n3
  43.        ;
  44. 321E            MOVE.W  (A6)+,D1                ;Get n3
  45. 301E            MOVE.W  (A6)+,D0                ;Get n2
  46. C1D6            MULS    (A6),D0                 ;n2*n1 -> D0
  47. 81C1            DIVS    D1,D0                   ;n2*n1/n3 -> D0
  48. 3C80            MOVE.W  D0,(A6)
  49.        ;
  50.        ;  /MOD         ( u1 u2 -- u-rem u-quot )
  51.        ;
  52. 4280            CLR.L   D0
  53. 321E            MOVE.W  (A6)+,D1                ;Get u2
  54. 301E            MOVE.W  (A6)+,D0                ;Get u1
  55. 80C1            DIVU    D1,D0                   ;u1/u2
  56. 4840            SWAP    D0                      ;Interchange remainder and quotient
  57. 2D00            MOVE.L  D0,-(A6)                ;Return both on stack
  58.        ;
  59.        ;  MOD         ( u1 u2 -- u-rem )
  60.        ;
  61. 4280            CLR.L   D0
  62. 321E            MOVE.W  (A6)+,D1                ;Get u2
  63. 301E            MOVE.W  (A6)+,D0                ;Get u1
  64. 80C1            DIVU    D1,D0                   ;u1/u2
  65. 4840            SWAP    D0                      ;Interchange remainder and quotient
  66. 3D00            MOVE.W  D0,-(A6)                ;Return remainder on stack
  67.        ;
  68.        ;  */MOD        ( u1 u2 u3 -- u-rem u-result )  u1*u2/u3
  69.        ;
  70. 321E            MOVE.W  (A6)+,D1                ;Get u3
  71. 301E            MOVE.W  (A6)+,D0                ;Get u2
  72. C0DE            MULU    (A6)+,D0                ;u2*u1 -> D0
  73. 80C1            DIVU    D1,D0                   ;u2*u1/u3 -> D0
  74. 4840            SWAP    D0
  75. 2D00            MOVE.L  D0,-(A6)
  76.        ;
  77.        ;  U*           ( u1 u2 -- ud )
  78.        ;
  79. 301E            MOVE.W  (A6)+,D0
  80. C0DE            MULU    (A6)+,D0
  81. 2D00            MOVE.L  D0,-(A6)
  82.        ;
  83.        ;  U/MOD        ( ud u1 -- u-rem u-quot )
  84.        ;
  85. 321E            MOVE.W  (A6)+,D1                ;Get u1
  86. 201E            MOVE.L  (A6)+,D0                ;Get ud
  87. 80C1            DIVU    D1,D0                   ;ud/u1
  88. 4840            SWAP    D0
  89. 2D00            MOVE.L  D0,-(A6)
  90.        ;
  91.        ;  1+           ( n -- n+1 )
  92.        ;
  93. 5256            ADDQ.W  #1,(A6)
  94.        ;
  95.        ;  1-           ( n -- n-1 )
  96.        ;
  97. 5356            SUBQ.W  #1,(A6)
  98.        ;
  99.        ;  2+           ( n -- n+2 )
  100.        ;
  101. 5456            ADDQ.W  #2,(A6)
  102.        ;
  103.        ;  2-           ( n -- n-2 )
  104.        ;
  105. 5556            SUBQ.W  #2,(A6)
  106.        ;
  107.        ;  2*           ( n -- n*2 )
  108.        ;
  109. E1D6            ASL     (A6)
  110.        ;
  111.        ;  2/           ( n -- n/2 )
  112.        ;
  113. E0D6            ASR     (A6)
  114.        ;
  115.        ;  ABS          ( n -- abs(n) )
  116.        ;
  117. 4A56            TST.W   (A6)                    ;Test for negative
  118. 6C02            BGE.S   ABS                     ;Skip next instruction if not
  119. 4456            NEG.W   (A6)
  120.        ABS
  121.        ;
  122.        ;  DABS         ( d -- abs(d) )
  123.        ;
  124. 4A96            TST.L   (A6)                    ;Test for negative
  125. 6C02            BGE.S   DABS                    ;Skip next instruction if not
  126. 4496            NEG.L   (A6)
  127.        DABS
  128.        ;
  129.        ;  NEGATE       ( n -- -n )
  130.        ;
  131. 4456            NEG.W   (A6)
  132.        ;
  133.        ;  DNEGATE      ( d -- -d )
  134.        ;
  135. 4496            NEG.L   (A6)
  136.        ;
  137.        ;  D+           ( d1 d2 -- d-sum )
  138.        ;
  139. 201E            MOVE.L  (A6)+,D0
  140. D196            ADD.L   D0,(A6)
  141.        ;
  142.        ;  D-           ( d1 d2 -- d-diff )     d1-d2
  143.        ;
  144. 201E            MOVE.L  (A6)+,D0
  145. 9196            SUB.L   D0,(A6)
  146.        ;
  147.        ;
  148.        ;******************************************************************************
  149.        ;
  150.        ;  Stack manipulation
  151.        ;
  152.        ;******************************************************************************
  153.        ;
  154.        ;  DROP         ( n -- )
  155.        ;
  156. 548E            ADDQ.L  #2,A6
  157.        ;
  158.        ;  2DROP        ( d -- )
  159.        ;
  160. 588E            ADDQ.L  #4,A6
  161.        ;
  162.        ;  SWAP
  163.        ;
  164. 2016            MOVE.L  (A6),D0
  165. 4840            SWAP    D0
  166. 2C80            MOVE.L  D0,(A6)
  167.        ;
  168.        ;  2SWAP        ( d1 d2 -- d2 d1 )
  169.        ;
  170. 2016            MOVE.L  (A6),D0
  171. 2CAE 0004       MOVE.L  4(A6),(A6)
  172. 2D40 0004       MOVE.L  D0,4(A6)
  173.        ;
  174.        ;  DUP          ( n -- n n )
  175.        ;
  176. 3D16            MOVE.W  (A6),-(A6)
  177.        ;
  178.        ;  2DUP         ( d -- d d )
  179.        ;
  180. 2D16            MOVE.L  (A6),-(A6)
  181.        ;
  182.        ;  OVER         ( n1 n2 -- n1 n2 n1 )
  183.        ;
  184. 3D2E 0002       MOVE.W  2(A6),-(A6)
  185.        ;
  186.        ;  2OVER        ( d1 d2 -- d1 d2 d1 )
  187.        ;
  188. 2D2E 0004       MOVE.L  4(A6),-(A6)
  189.        ;
  190.        ;  >R           ( n -- )        Store on return stack
  191.        ;
  192. 3F1E            MOVE.W  (A6)+,-(A7)
  193.        ;
  194.        ;  R>           ( -- n )        Remove from return stack
  195.        ;
  196. 3D1F            MOVE.W  (A7)+,-(A6)
  197.        ;
  198.        ;  I            ( -- n )        Copies top of return stack
  199.        ;
  200. 3D17            MOVE.W  (A7),-(A6)
  201.        ;
  202.        ;  I'           ( -- n )        Copies second item on return stack
  203.        ;
  204. 3D2F 0002       MOVE.W  2(A7),-(A6)
  205.        ;
  206.        ;  J            ( -- n )        Copies third item on return stack
  207.        ;
  208. 3D2F 0004       MOVE.W  4(A7),-(A6)
  209.        ;
  210.        ;  Push a constant onto the stack       ( -- n )
  211.        ;
  212. 3D3C 0000       MOVE.W  #0,-(A6)
  213.        ;
  214.        ;  Push a double constant onto the stack        ( -- d )
  215.        ;
  216. 2D3C 0000       MOVE.L  #0,-(A6)
  217.      0000
  218.        ;
  219.        ;
  220.        ;******************************************************************************
  221.        ;
  222.        ;  Memory and I/O operations
  223.        ;
  224.        ;******************************************************************************
  225.        ;
  226.        ;  Note.. all references to memory are relative to A5 unless otherwise
  227.        ;         specified.
  228.        ;
  229.        ;
  230.        ;  !            ( n adr -- )
  231.        ;               Store in variable
  232.        ;
  233. 301E            MOVE.W  (A6)+,D0
  234. 3B9E 0000       MOVE.W  (A6)+,0(A5,D0.W)
  235.        ;
  236.        ;  @            ( adr -- n )
  237.        ;               Get from variable
  238.        ;
  239. 3016            MOVE.W  (A6),D0
  240. 3CB5 0000       MOVE.W  0(A5,D0.W),(A6)
  241.        ;
  242.        ;  C!           ( c adr -- )
  243.        ;               Store in variable
  244.        ;
  245. 301E            MOVE.W  (A6)+,D0
  246. 321E            MOVE.W  (A6)+,D1
  247. 1B81 0000       MOVE.B  D1,0(A5,D0.W)
  248.        ;
  249.        ;  C@           ( adr -- c )
  250.        ;               Get from variable
  251.        ;
  252. 3016            MOVE.W  (A6),D0
  253. 4241            CLR.W   D1
  254. 1235 0000       MOVE.B  0(A5,D0.W),D1
  255. 3C81            MOVE.W  D1,(A6)
  256.        ;
  257.        ;  2!           ( d adr -- )
  258.        ;               Store in variable
  259.        ;
  260. 301E            MOVE.W  (A6)+,D0
  261. 2B9E 0000       MOVE.L  (A6)+,0(A5,D0.W)
  262.        ;
  263.        ;  2@           ( adr -- d )
  264.        ;               Get from variable
  265.        ;
  266. 301E            MOVE.W  (A6)+,D0
  267. 2D35 0000       MOVE.L  0(A5,D0.W),-(A6)
  268.        ;
  269.        ;  +!           ( n adr -- )
  270.        ;               Add n to the loaction pointed to by adr
  271.        ;
  272. 301E            MOVE.W  (A6)+,D0
  273. 321E            MOVE.W  (A6)+,D1
  274. D375 0000       ADD.W   D1,0(A5,D0.W)
  275.        ;
  276.        ;  M68ARY xxxx  ( n -- )        defines an array xxxx n words long
  277.        ;
  278.        ;
  279.        ;  xxxx         ( n -- adr )    returns the address of the n-th element of xxxx
  280.        ;
  281. 303C 0000       MOVE.W  #0,D0           ;Array base address
  282. D056            ADD.W   (A6),D0         ;n + address
  283. D156            ADD.W   D0,(A6)         ;2*n + address
  284.        ;
  285.        ;  M68CARY xxxx ( n -- )        defines an array xxxx n bytes long
  286.        ;
  287.        ;
  288.        ;  xxxx         ( n -- adr )    returns the address of the n-th element of xxxx
  289.        ;
  290. 303C 0000       MOVE.W  #0,D0           ;Array base address
  291. D156            ADD.W   D0,(A6)         ;n + address
  292.        ;
  293.        ;  M68DARY xxxx ( n -- )        defines an array xxxx n double words long
  294.        ;
  295.        ;
  296.        ;  xxxx         ( n -- adr )    returns the address of the n-th element of xxxx
  297.        ;
  298. 303C 0000       MOVE.W  #0,D0           ;Array base address
  299. 3216            MOVE.W  (A6),D1         ;n
  300. E541            ASL.W   #2,D1           ;4*n
  301. D041            ADD.W   D1,D0           ;4*n + address
  302. 3C80            MOVE.W  D0,(A6)
  303.        ;
  304.        ;  FILL         ( adr n b -- )
  305.        ;               Fills n bytes of memory beginning at the variable pool
  306.        ;               relative address with the value b.
  307.        ;
  308. 301E               MOVE.W  (A6)+,D0        ;Get b
  309. 321E               MOVE.W  (A6)+,D1        ;Get n
  310. 305E               MOVEA.W (A6)+,A0        ;Get variable pool relative address
  311. D1CD               ADDA.L  A5,A0           ;Compute actual address
  312. 6002               BRA.S   $02             ;Enter loop at proper point
  313. 10C0       $01     MOVE.B  D0,(A0)+        ;Store b and increment address
  314. 51C9 FFFC  $02     DBF     D1,$01          ;Repeat n times
  315.        ;
  316.        ;*******************************************************************************
  317.        ;
  318.        ; Note.. the following words reference absoute memory addresses.  They should
  319.        ;        only be used to reference data and I/O devices that are fixed and
  320.        ;        outside the environment of the compiler.  Under NO conditions should
  321.        ;        these operations be used to reference data structures created by the
  322.        ;        compiler.  The compiler data structures are relocatable and there is
  323.        ;        no easy way to find the current location of these data structures.
  324.        ;        The other operators provided above are much more convenient and
  325.        ;        preserve the relocatability.
  326.        ;
  327.        ;
  328.        ;  AW!          ( n short -- )
  329.        ;               Store n at the location specified by the short address.
  330.        ;
  331. 305E            MOVEA.W (A6)+,A0        ;Get address
  332. 309E            MOVE.W  (A6)+,(A0)      ;Store n
  333.        ;
  334.        ;  AW@          ( short -- n )
  335.        ;               Get n from the location specified by the short address.
  336.        ;
  337. 3056            MOVEA.W (A6),A0         ;Get address
  338. 3C90            MOVE.W  (A0),(A6)       ;Get n
  339.        ;
  340.        ;  AL!          ( n long -- )
  341.        ;               Store n at the location specified by the long address.
  342.        ;
  343. 205E            MOVEA.L (A6)+,A0        ;Get address
  344. 309E            MOVE.W  (A6)+,(A0)      ;Store n
  345.        ;
  346.        ;  AL@          ( long -- n )
  347.        ;               Get n from the location specified by the long address.
  348.        ;
  349. 205E            MOVEA.L (A6)+,A0        ;Get address
  350. 3D10            MOVE.W  (A0),-(A6)      ;Get n
  351.        ;
  352.        ;  CAW!         ( c short -- )
  353.        ;               Store c at the location specified by the short address.
  354.        ;
  355. 305E            MOVEA.W (A6)+,A0        ;Get address
  356. 301E            MOVE.W  (A6)+,D0        ;Get c
  357. 1080            MOVE.B  D0,(A0)         ;Store c
  358.        ;
  359.        ;  CAW@         ( short -- c )
  360.        ;               Get c from the location specified by the short address.
  361.        ;
  362. 3056            MOVEA.W (A6),A0         ;Get address
  363. 4240            CLR.W   D0
  364. 1010            MOVE.B  (A0),D0         ;Get c
  365. 3C80            MOVE.W  D0,(A6)
  366.        ;
  367.        ;  CAL!         ( c long -- )
  368.        ;               Store c at the location specified by the long address.
  369.        ;
  370. 205E            MOVEA.L (A6)+,A0        ;Get address
  371. 301E            MOVE.W  (A6)+,D0        ;Get c
  372. 1080            MOVE.B  D0,(A0)         ;Store c
  373.        ;
  374.        ;  CAL@         ( long -- c )
  375.        ;               Get c from the location specified by the long address.
  376.        ;
  377. 205E            MOVEA.L (A6)+,A0        ;Get address
  378. 4240            CLR.W   D0
  379. 1010            MOVE.B  (A0),D0         ;Get c
  380. 3D00            MOVE.W  D0,-(A6)
  381.        ;
  382.        ;  2AW!         ( d short -- )
  383.        ;               Store d at the location specified by the short address.
  384.        ;
  385. 305E            MOVEA.W (A6)+,A0        ;Get address
  386. 209E            MOVE.L  (A6)+,(A0)      ;Store d
  387.        ;
  388.        ;  2AW@         ( short -- d )
  389.        ;               Get d from the location specified by the short address.
  390.        ;
  391. 305E            MOVEA.W (A6)+,A0        ;Get address
  392. 2D10            MOVE.L  (A0),-(A6)      ;Get d
  393.        ;
  394.        ;  2AL!         ( d long -- )
  395.        ;               Store d at the location specified by the long address.
  396.        ;
  397. 205E            MOVEA.L (A6)+,A0        ;Get address
  398. 209E            MOVE.L  (A6)+,(A0)      ;Store d
  399.        ;
  400.        ;  2AL@         ( long -- d )
  401.        ;               Get d from the location specified by the long address.
  402.        ;
  403. 2056            MOVEA.L (A6),A0         ;Get address
  404. 2C90            MOVE.L  (A0),(A6)       ;Get d
  405.        ;
  406.        ;  AFILL        ( long_adr n b -- )
  407.        ;               Fills n bytes of memory beginning at the long absolute
  408.        ;               address with the value b.
  409.        ;
  410. 301E               MOVE.W  (A6)+,D0        ;Get b
  411. 321E               MOVE.W  (A6)+,D1        ;Get n
  412. 205E               MOVEA.L (A6)+,A0        ;Get absolute address
  413. 6002               BRA.S   $02             ;Enter loop at proper point
  414. 10C0       $01     MOVE.B  D0,(A0)+        ;Store b and increment address
  415. 51C9 FFFC  $02     DBF     D1,$01          ;Repeat n times
  416.        ;
  417.        ;
  418.        ;******************************************************************************
  419.        ;
  420.        ;  Comparison operations
  421.        ;
  422.        ;******************************************************************************
  423.        ;
  424.        ;  MIN          ( n1 n2 -- n-min )
  425.        ;
  426. 301E            MOVE.W  (A6)+,D0                ;n2
  427. 3216            MOVE.W  (A6),D1                 ;n1
  428. B041            CMP.W   D1,D0                   ;n2-n1
  429. 6F02            BLE.S   MIN
  430. C141            EXG     D0,D1                   ;Swap if D1 < D0
  431. 3C80       MIN  MOVE.W  D0,(A6)
  432.        ;
  433.        ;  MAX          ( n1 n2 -- n-max )
  434.        ;
  435. 301E            MOVE.W  (A6)+,D0                ;n2
  436. 3216            MOVE.W  (A6),D1                 ;n1
  437. B041            CMP.W   D1,D0                   ;n2-n1
  438. 6C02            BGE.S   MAX
  439. C141            EXG     D0,D1                   ;Swap if D1 > D0
  440. 3C80       MAX  MOVE.W  D0,(A6)
  441.        ;
  442.        ;  =            ( n1 n2 -- f )          if n1 = n2 then f is true
  443.        ;
  444. 301E            MOVE.W  (A6)+,D0                ;n2
  445. 321E            MOVE.W  (A6)+,D1                ;n1
  446. B240            CMP.W   D0,D1                   ;n1-n2
  447. 57C0            SEQ     D0
  448. 0240 0001       ANDI.W  #1,D0
  449. 3D00            MOVE.W  D0,-(A6)
  450.        ;
  451.        ;  <            ( n1 n2 -- f )          if n1 < n2 then f is true
  452.        ;
  453. 301E            MOVE.W  (A6)+,D0                ;n2
  454. 321E            MOVE.W  (A6)+,D1                ;n1
  455. B240            CMP.W   D0,D1                   ;n1-n2
  456. 5DC0            SLT     D0
  457. 0240 0001       ANDI.W  #1,D0
  458. 3D00            MOVE.W  D0,-(A6)
  459.        ;
  460.        ;  >            ( n1 n2 -- f )          if n1 > n2 then f is true
  461.        ;
  462. 301E            MOVE.W  (A6)+,D0                ;n2
  463. 321E            MOVE.W  (A6)+,D1                ;n1
  464. B240            CMP.W   D0,D1                   ;n1-n2
  465. 5EC0            SGT     D0
  466. 0240 0001       ANDI.W  #1,D0
  467. 3D00            MOVE.W  D0,-(A6)
  468.        ;
  469.        ;  D=           ( d1 d2 -- f )          if d1 = d2 then f is true
  470.        ;
  471. 201E            MOVE.L  (A6)+,D0                ;d2
  472. 221E            MOVE.L  (A6)+,D1                ;d1
  473. B280            CMP.L   D0,D1                   ;d1-d2
  474. 57C0            SEQ     D0
  475. 0240 0001       ANDI.W  #1,D0
  476. 3D00            MOVE.W  D0,-(A6)
  477.        ;
  478.        ;  D<           ( d1 d2 -- f )          if d1 < d2 then f is true
  479.        ;
  480. 201E            MOVE.L  (A6)+,D0                ;d2
  481. 221E            MOVE.L  (A6)+,D1                ;d1
  482. B280            CMP.L   D0,D1                   ;d1-d2
  483. 5DC0            SLT     D0
  484. 0240 0001       ANDI.W  #1,D0
  485. 3D00            MOVE.W  D0,-(A6)
  486.        ;
  487.        ;  D>           ( d1 d2 -- f )          if d1 > d2 then f is true
  488.        ;
  489. 201E            MOVE.L  (A6)+,D0                ;d2
  490. 221E            MOVE.L  (A6)+,D1                ;d1
  491. B280            CMP.L   D0,D1                   ;d1-d2
  492. 5EC0            SGT     D0
  493. 0240 0001       ANDI.W  #1,D0
  494. 3D00            MOVE.W  D0,-(A6)
  495.        ;
  496.        ;  0=           ( n -- f )              if n = 0 then f is true
  497.        ;  Alternate name is NOT
  498.        ;
  499. 4A5E            TST.W   (A6)+
  500. 57C0            SEQ     D0
  501. 0240 0001       ANDI.W  #1,D0
  502. 3D00            MOVE.W  D0,-(A6)
  503.        ;
  504.        ;  0<           ( n -- f )              if n < 0 then f is true
  505.        ;
  506. 4A5E            TST.W   (A6)+
  507. 5DC0            SLT     D0
  508. 0240 0001       ANDI.W  #1,D0
  509. 3D00            MOVE.W  D0,-(A6)
  510.        ;
  511.        ;  0>           ( n -- f )              if n > 0 then f is true
  512.        ;
  513. 4A5E            TST.W   (A6)+
  514. 5EC0            SGT     D0
  515. 0240 0001       ANDI.W  #1,D0
  516. 3D00            MOVE.W  D0,-(A6)
  517.        ;
  518.        ;  D0=          ( d -- f )              if d = 0 then f is true
  519.        ;
  520. 4A9E            TST.L   (A6)+
  521. 57C0            SEQ     D0
  522. 0240 0001       ANDI.W  #1,D0
  523. 3D00            MOVE.W  D0,-(A6)
  524.        ;
  525.        ;  D0<          ( d -- f )              if d < 0 then f is true
  526.        ;
  527. 4A9E            TST.L   (A6)+
  528. 5DC0            SLT     D0
  529. 0240 0001       ANDI.W  #1,D0
  530. 3D00            MOVE.W  D0,-(A6)
  531.        ;
  532.        ;  D0>          ( d -- f )              if d > 0 then f is true
  533.        ;
  534. 4A9E            TST.L   (A6)+
  535. 5EC0            SGT     D0
  536. 0240 0001       ANDI.W  #1,D0
  537. 3D00            MOVE.W  D0,-(A6)
  538.        ;
  539.        ;  AND          ( u1 u2 -- and )
  540.        ;
  541. 301E            MOVE.W  (A6)+,D0
  542. C156            AND.W   D0,(A6)
  543.        ;
  544.        ;  OR           ( u1 u2 -- or )
  545.        ;
  546. 301E            MOVE.W  (A6)+,D0
  547. 8156            OR.W    D0,(A6)
  548.        ;
  549.        ;  XOR          ( u1 u2 -- xor )        Exclusive OR
  550.        ;
  551. 301E            MOVE.W  (A6)+,D0
  552. B156            EOR.W   D0,(A6)
  553.        ;
  554.        ;  1'S          ( u -- compl )          One's compliment
  555.        ;
  556. 4656            NOT.W   (A6)
  557.        ;
  558.        ;
  559.        ;******************************************************************************
  560.        ;
  561.        ;  Control operations
  562.        ;
  563.        ;******************************************************************************
  564.        ;
  565.        ;  Note.. all control structures use the PC relative addressing mode
  566.        ;         this makes the code position independent.
  567.        ;
  568.        ;
  569.        ;  IF           ( f -- )
  570.        ;               Takes an entry off the stack and branches if the value
  571.        ;               is FALSE (0).
  572.        ;
  573. 4A5E            TST.W   (A6)+                   ;Remove and test flag
  574. 6700 ****       BEQ     ELSE
  575.        ;
  576.        ;  ELSE         ( -- )
  577.        ;               Branches around the else part and provides a target for the
  578.        ;               false branch of the if part.
  579.        ;
  580. 6000 ****       BRA     ENDIF
  581.        ELSE
  582.        ;
  583.        ;  ENDIF        ( -- )
  584.        ;               Provides a target for the branch around the else part, and if
  585.        ;               the else is missing provides a target for the false branch of
  586.        ;               the if part.
  587.        ;
  588.        ENDIF
  589.        ;
  590.        ;  BEGIN        ( -- )
  591.        ;               Provides a target for a branch back from UNTIL, AGAIN, REPEAT.
  592.        ;
  593.        BEGIN
  594.        ;
  595.        ;  UNTIL        ( f -- )
  596.        ;               Takes an entry off the stack and branches to BEGIN if the
  597.        ;               value is FALSE (0).
  598.        ;
  599. 4A5E            TST.W   (A6)+                   ;Remove and test flag
  600. 6700 ****       BEQ     BEGIN
  601.        ;
  602.        ;  AGAIN        ( -- )
  603.        ;               Always branches to BEGIN
  604.        ;
  605. 6000 ****       BRA     BEGIN
  606.        ;
  607.        ;  WHILE        ( f -- )
  608.        ;               Takes an entry off the stack and branches to REPEAT if the
  609.        ;               value is FALSE (0).
  610.        ;
  611. 4A5E            TST.W   (A6)+                   ;Remove and test flag
  612. 6700 ****       BEQ     REPEAT
  613.        ;
  614.        ;  REPEAT       ( -- )
  615.        ;               Always jumps back to begin and provides a target for WHILE.
  616.        ;
  617. 6000 ****       BRA     BEGIN
  618.        REPEAT
  619.        ;
  620.        ;  DO           ( limit index -- )
  621.        ;               Remove the index and limit from the data stack and put on
  622.        ;               the return stack.  Provides a target for LOOP and +LOOP
  623.        ;
  624. 2F1E            MOVE.L  (A6)+,-(A7)
  625.        DO
  626.        ;
  627.        ;  LOOP         ( -- )
  628.        ;               Increment the index and test for end of the loop.
  629.        ;
  630. 5257            ADDQ.W  #1,(A7)                 ;Increment index
  631. 4C97 0003       MOVEM.W (A7),D0/D1              ;Get index (D0) and limit (D1)
  632. B041            CMP.W   D1,D0
  633. 6D00 ****       BLT     DO                      ;Continue if (index - limit) < 0
  634. 588F            ADDQ.L  #4,A7                   ;Drop index and limit
  635.        ;
  636.        ;  +LOOP        ( n -- )
  637.        ;               Add n to the index then
  638.        ;                  IF n > 0 then continue if (index - limit) < 0
  639.        ;                  ELSE continue if (index - limit) >= 0.
  640.        ;
  641. 301E            MOVE.W  (A6)+,D0                ;Get increment
  642. D157            ADD.W   D0,(A7)                 ;Update index
  643. 4C97 0006       MOVEM.W (A7),D1/D2              ;Get index (D1) and limit (D2)
  644. 4A40            TST.W   D0                      ;Test for negative
  645. 6E04            BGT.S   $01
  646. B441            CMP.W   D1,D2                   ;Test (limit - index)
  647. 6002            BRA.S   $02
  648. B242       $01  CMP.W   D2,D1                   ;Test (index - limit)
  649. 6D00 ****  $02  BLT     DO                      ;Continue if (condition tested) < 0
  650. 588F            ADDQ.L  #4,A7                   ;Drop index and limit
  651.        ;
  652.        ;  LEAVE        ( -- )
  653.        ;               Terminate loop by seting limit equal to index
  654.        ;
  655. 3F57 0002       MOVE.W  (A7),2(A7)
  656.        ;
  657.        ;  Routines for accessing external programs and subroutines.
  658.        ;
  659.        ;
  660.        ;  JSR.W        ( short address -- )
  661.        ;               Jump to subroutine using short address from tos
  662.        ;
  663. 305E            MOVEA.W (A6)+,A0
  664. 4E90            JSR     (A0)
  665.        ;
  666.        ;  JSR.L        ( long address -- )
  667.        ;               Jump to subroutine using long address from tos
  668.        ;
  669. 205E            MOVEA.L (A6)+,A0
  670. 4E90            JSR     (A0)
  671.        ;
  672.        ;  JMP.W        ( short address -- )
  673.        ;               Jump to location pointed to by short address on stack
  674.        ;
  675. 305E            MOVEA.W (A6)+,A0
  676. 4ED0            JMP     (A0)
  677.        ;
  678.        ;  JMP.L        ( long address -- )
  679.        ;               Jump to location pointed to by long address on stack
  680.        ;
  681. 205E            MOVEA.L (A6)+,A0
  682. 4ED0            JMP     (A0)
  683.        ;
  684.        ;
  685.        ;******************************************************************************
  686.        ;
  687.        ;  Initialization operations
  688.        ;
  689.        ;******************************************************************************
  690.        ;
  691.        ;  Note.. the following words initialize the registers of the M68000
  692.        ;
  693.        ;
  694.        ;  A5LD         Load the variable pool pointer
  695.        ;
  696. 2A7C 0000       MOVEA.L #0,A5
  697.      0000
  698.        ;
  699.        ;  A6LD         Load the data stack pointer
  700.        ;
  701. 2C7C 0000       MOVEA.L #0,A6
  702.      0000
  703.        ;
  704.        ;  A7LD         Load the return stack pointer
  705.        ;
  706. 2E7C 0000       MOVEA.L #0,A7
  707.      0000
  708.        ;
  709.        ;
  710.         END
  711.