1 ; ----------------------------------------------------------------------------------
2 ; ANS complement for MSP430FR4xxx devices without hardware_MPY, to pass CORETEST.4th
3 ; when downloading to SD_CARD target, truncate filename ANS_COMP_SMPY.4th to ANS_COMP.4th
4 ; ----------------------------------------------------------------------------------
7 \ R4 to R7 must be saved before use and restored after
8 \ scratch registers Y to S are free for use
9 \ under interrupt, IP is free for use
11 \ PUSHM order : PSP,TOS, IP, S, T, W, X, Y, R7, R6, R5, R4
12 \ example : PUSHM IP,Y
14 \ POPM order : R4, R5, R6, R7, Y, X, W, T, S, IP,TOS,PSP
17 \ ASSEMBLER conditionnal usage before IF UNTIL WHILE : S< S>= U< U>= 0= 0<> 0>=
18 \ ASSEMBLER conditionnal usage before ?JMP ?GOTO : S< S>= U< U>= 0= 0<> 0<
20 \ FORTH conditionnal usage before IF UNTIL WHILE : 0= 0< = < > U<
24 CODE INVERT \ x1 -- x2 bitwise inversion
30 CODE LSHIFT \ x1 u -- x2 logical L shift u places
32 AND #$1F,TOS \ no need to shift more than 16
42 CODE RSHIFT \ x1 u -- x2 logical R shift u places
44 AND #$1F,TOS \ no need to shift more than 16
46 BEGIN BIC #C,SR \ Clr Carry
55 CODE 1+ \ n1/u1 -- n2/u2 add 1 to TOS
61 CODE 1- \ n1/u1 -- n2/u2 subtract 1 from TOS
67 CODE MAX \ n1 n2 -- n3 signed maximum
75 CODE MIN \ n1 n2 -- n3 signed minimum
83 CODE 2* \ x1 -- x2 arithmetic left shift
89 CODE 2/ \ x1 -- x2 arithmetic right shift
95 \ --------------------
96 \ ARITHMETIC OPERATORS
97 \ --------------------
99 : S>D \ n -- d single -> double
104 \ \ C UM* u1 u2 -- ud unsigned 16x16->32 mult.
107 \ \ u2 = TOS register
113 \ \ T.I. SIGNED MULTIPLY SUBROUTINE: u2 x u1 -> ud
114 \ MOV #0,Y \ 0 -> LSBs RESULT
115 \ MOV #0,T \ 0 -> MSBs RESULT
116 \ MOV #0,W \ 0 -> MSBs MULTIPLIER
117 \ MOV #1,X \ BIT TEST REGISTER
118 \ BEGIN BIT X,TOS \ 1 TEST ACTUAL BIT ; IF 0: DO NOTHING
119 \ 0<> IF \ 2 IF 1: ADD MULTIPLIER TO RESULT
122 \ THEN ADD S,S \ 1 (RLA LSBs) MULTIPLIER x 2
123 \ ADDC W,W \ 1 (RLC MSBs)
124 \ ADD X,X \ 1 (RLA) NEXT BIT TO TEST
125 \ U>= UNTIL \ 2 IF BIT IN CARRY: FINISHED 10~ loop
126 \ MOV Y,0(PSP) \ low result on stack
127 \ MOV T,TOS \ high result in TOS
132 CODE M* \ n1 n2 -- dlo dhi signed 16*16->32 multiply
134 XOR @PSP,S \ S contains sign of result
135 CMP #0,0(PSP) \ n1 > -1 ?
137 XOR #-1,0(PSP) \ n1 --> u1
140 CMP #0,TOS \ n2 > -1 ?
142 XOR #-1,TOS \ n2 --> u2
147 UM* \ UMSTAR use S,T,W,X,Y
150 CMP #0,S \ sign of result > -1 ?
152 XOR #-1,0(PSP) \ ud --> d
166 \ DVDhi|DVDlo : DIVISOR -> QUOT in Y, REM in DVDhi
167 \ RETURN: CARRY = 0: OK CARRY = 1: QUOTIENT > 16 BITS
169 \ C UM/MOD udlo|udhi u1 -- ur uq
171 MOV @PSP+,W \ 2 W = DIVIDENDhi
172 MOV @PSP,S \ 2 S = DIVIDENDlo
173 MOV #16,X \ 2 INITIALIZE LOOP COUNTER
174 BW1 CMP TOS,W \ 1 dividendHI-divisor
175 U< ?GOTO FW1 \ 2 if not carry
176 SUB TOS,W \ 1 if carry
177 FW1 \ FW1 is resolved therefore reusable
178 BW2 ADDC Y,Y \ 1 RLC quotient
179 SUB #1,X \ 1 Decrement loop counter
180 0< ?GOTO FW1 \ 2 if 0< terminate
183 U< ?GOTO BW1 \ 2 if not carry 14~ loop
186 GOTO BW2 \ 2 14~ loop
187 FW1 MOV W,0(PSP) \ 3 remainder on stack
188 MOV Y,TOS \ 1 quotient in TOS
193 CODE SM/REM \ d1lo d1hi n2 -- n3 n4 symmetric signed div
194 MOV TOS,S \ S=divisor
195 MOV @PSP,T \ T=dividend_sign=rem_sign
196 CMP #0,TOS \ n2 >= 0 ?
199 ADD #1,TOS \ -- d1 u2
201 CMP #0,0(PSP) \ d1hi >= 0 ?
203 XOR #-1,2(PSP) \ d1lo
204 XOR #-1,0(PSP) \ d1hi
205 ADD #1,2(PSP) \ d1lo+1
206 ADDC #0,0(PSP) \ d1hi+C
210 UM/MOD \ UM/MOD use S,W,X,Y, not T
213 CMP #0,T \ T=rem_sign
218 XOR S,T \ S=divisor T=quot_sign
219 CMP #0,T \ T=quot_sign
223 THEN \ -- n3 n4 S=divisor
229 : FM/MOD \ d1 n1 -- n2 n3 floored signed div'n
231 HI2LO \ -- remainder quotient S=divisor
234 CMP #1,TOS \ quotient < 1 ?
236 ADD S,0(PSP) \ add divisor to remainder
237 SUB #1,TOS \ decrement quotient
245 : * \ n1 n2 -- n3 n1*n2 --> n3
250 : /MOD \ n1 n2 -- n3 n4 n1/n2 --> rem quot
255 : / \ n1 n2 -- n3 n1/n2 --> quot
256 >R DUP 0< R> FM/MOD NIP
260 : MOD \ n1 n2 -- n3 n1/n2 --> rem
261 >R DUP 0< R> FM/MOD DROP
265 : */MOD \ n1 n2 n3 -- n4 n5 n1*n2/n3 --> rem quot
270 : */ \ n1 n2 n3 -- n4 n1*n2/n3 --> quot
275 \ ----------------------------------------------------------------------
277 \ ----------------------------------------------------------------------
279 CODE 2@ \ a-addr -- x1 x2 fetch 2 cells \ the lower address will appear on top of stack
287 CODE 2! \ x1 x2 a-addr -- store 2 cells \ the top of stack is stored at the lower adr
295 CODE 2DUP \ x1 x2 -- x1 x2 x1 x2 dup top 2 cells
296 SUB #4,PSP \ -- x1 x x x2
297 MOV TOS,2(PSP) \ -- x1 x2 x x2
298 MOV 4(PSP),0(PSP) \ -- x1 x2 x1 x2
303 CODE 2DROP \ x1 x2 -- drop 2 cells
310 CODE 2SWAP \ x1 x2 x3 x4 -- x3 x4 x1 x2
311 MOV @PSP,W \ -- x1 x2 x3 x4 W=x3
312 MOV 4(PSP),0(PSP) \ -- x1 x2 x1 x4
313 MOV W,4(PSP) \ -- x3 x2 x1 x4
314 MOV TOS,W \ -- x3 x2 x1 x4 W=x4
315 MOV 2(PSP),TOS \ -- x3 x2 x1 x2 W=x4
316 MOV W,2(PSP) \ -- x3 x4 x1 x2
321 CODE 2OVER \ x1 x2 x3 x4 -- x1 x2 x3 x4 x1 x2
322 SUB #4,PSP \ -- x1 x2 x3 x x x4
323 MOV TOS,2(PSP) \ -- x1 x2 x3 x4 x x4
324 MOV 8(PSP),0(PSP) \ -- x1 x2 x3 x4 x1 x4
325 MOV 6(PSP),TOS \ -- x1 x2 x3 x4 x1 x2
331 \ ----------------------------------------------------------------------
332 \ ALIGNMENT OPERATORS
333 \ ----------------------------------------------------------------------
335 CODE ALIGNED \ addr -- a-addr align given addr
342 CODE ALIGN \ -- align HERE
349 \ ---------------------
350 \ PORTABILITY OPERATORS
351 \ ---------------------
353 CODE CHARS \ n1 -- n2 chars->adrs units
358 CODE CHAR+ \ c-addr1 -- c-addr2 add char size
364 CODE CELLS \ n1 -- n2 cells->adrs units
370 CODE CELL+ \ a-addr1 -- a-addr2 add cell size
375 \ ---------------------------
376 \ BLOCK AND STRING COMPLEMENT
377 \ ---------------------------
379 : CHAR \ -- char parse ASCII character
384 : [CHAR] \ -- compile character literal
389 CODE +! \ n/u a-addr -- add to memory
397 CODE FILL \ c-addr u char -- fill memory with char
399 MOV @PSP+,W \ address
403 MOV.B TOS,0(W) \ store char in memory
408 MOV @PSP+,TOS \ empties stack
413 \ --------------------
414 \ INTERPRET COMPLEMENT
415 \ --------------------
433 : .( \ -- dotparen \ type comment immediatly.
434 \ CAPS_OFF \ -- set CAPS_OFF (recompile FORTH with LOWERCASE swith ON before, must be paired with set CAP_ON)
437 \ CAPS_ON \ -- set CAPS_OFF (recompile FORTH with LOWERCASE swith ON before, must be paired with set CAP_ON)
441 CODE SOURCE \ -- adr u current input buffer
445 MOV &SOURCE_ADR,0(PSP)
456 ; added ANS_COMPLEMENT: INVERT LSHIFT RSHIFT 1+ 1- MAX MIN 2* 2/ CHAR [CHAR] +! FILL HEX DECIMAL ( .( SOURCE >BODY
457 ; ARITHMETIC: S>D UM* M* UM/MOD SM/REM FM/MOD * /MOD / MOD */MOD */
458 ; DOUBLE: 2@ 2! 2DUP 2DROP 2SWAP 2OVER
459 ; ALIGMENT: ALIGNED ALIGN
460 ; PORTABIITY: CHARS CHAR+ CELLS CELL+
462 ; v--- use backspaces before hit "CR" if you want decrease level of app protection