Jump to content

TheBF

+AtariAge Subscriber
  • Posts

    4,398
  • Joined

  • Last visited

1 Follower

About TheBF

Profile Information

  • Gender
    Male
  • Location
    The Great White North
  • Interests
    Music/music production, The Forth programming language and implementations.
  • Currently Playing
    Guitar
  • Playing Next
    Trumpet ;)

Recent Profile Visitors

8,158 profile views

TheBF's Achievements

River Patroller

River Patroller (8/9)

6k

Reputation

  1. Possibly. I used >FFFF which waits for about 1 second before determining there are no more characters to get.
  2. I used >FFFF in my timing which is only .9 seconds or so.
  3. ok, then my consultancy contract is annulled. I have no explanation.
  4. It should not affect the speed as it does not need to delay character reception. They way mine works is if a character is detected (TB 21) I get it and exit the routine ELSE decrement the counter and test again. So it works just like normal expect is has some "elasticity" around when a character doesn't arrive. I think the key is implementing the ELSE clause in the code below. You can see from the machine code that ELSE is just a JMP instruction (>1000+offset) to ENDIF IF is a JNE to ELSE With that you never wait if the character is ready, you only wait if there is nothing coming in. EQ UNTIL is JNE back to BEGIN. But it's also possible that the way you are setup it is not ideal and I am way off base. CREATE ENDTRX C320 , CARD , \ CARD @@ R12 MOV, \ select card 1E05 , \ 5 SBZ, \ CTS LOW, clear to send 1D07 , \ 7 SBO, \ LED OFF 0300 , 0002 , \ 2 LIMI, C101 , \ R1 TOS MOV, NEXT, .( .) HEX \ ** decimal numbers used for UART bit no.s CODE READCOM ( addr n -- n' ) \ [WARNING] SOURCE CODE USES DECIMAL RADIX 0300 , 0000 , \ 0 LIMI, \ full attention C236 , \ *SP+ W MOV, \ addr ->W (ie: R8) A108 , \ W TOS ADD, \ calc last address ->TOS 0700 , \ R0 SETO, \ set timeout register >FFFF 04C1 , \ R1 CLR, \ reset char counter \ BEGIN, \ * handshake hardware ON * C320 , CARD , \ CARD @@ R12 MOV, \ select card 1E05 , \ 5 SBZ, \ CTS LOW, clear to send 1D07 , \ 7 SBO, \ led ON A320 , UART , \ UART @@ R12 ADD, \ >1300+>40 = UART CRU 1F15 , \ 21 TB, \ test if char in uart 1609 , \ EQ IF, 3638 , \ *W+ 8 STCR, \ char to buff & inc buff 1D12 , \ 18 SBO, \ clr UART rcv buffer \ * handshake hardware off * C320 , CARD , \ CARD @@ R12 MOV, \ select card 1D05 , \ 5 SBO, \ CTS line HIGH. I am busy! 1E07 , \ 7 SBZ, \ led OFF 0700 , \ R0 SETO, \ reset timeout to 0FFFF 0581 , \ R1 INC, \ count char 1004 , \ ELSE, 0600 , \ R0 DEC, \ no char, dec TIMEDOUT 1602 , \ EQ IF, \ expired? 0460 , ENDTRX , \ ENDTRX @@ B, \ ENDIF, \ ENDIF, 8108 , \ W TOS CMP, \ W = end of buffer? 16E9 , \ EQ UNTIL, 0460 , ENDTRX , \ ENDTRX @@ B,
  5. Well this is all public information but here is what's in my source code. Just read them upside down and it all make sense. HEX 1300 CONSTANT RS232/1 \ RS232/1 card address 1500 CONSTANT RS232/2 \ RS232/2 card address 40 CONSTANT TTY1 \ 40 = uart#1 80 CONSTANT TTY2 \ 80 = uart#2 \ card control bits. CRU base (R12) set to 1300/1500 5 EQU -CTS \ "negative" CTS (low=clear to send) OUTPUT!! 7 EQU LED \ CARD LED on/off \ 9902 UART control bits. CRU base (R12) set to 1340/1380/1540/1580 DECIMAL 13 EQU LDIR \ "load interval register" 16 EQU RTS \ request to send 18 EQU RIENB \ rcv interrupt enable 21 EQU RXRL \ receive register loaded bit 22 EQU TXRE \ transmit register empty bit 27 EQU -DSR \ NOT data set ready 28 EQU -CTS \ NOT clear to send INPUT!! 31 EQU RESET \ 9902 reset bit Edit: I had to double check the comments. Note bit 5 is OUTPUT and bit 28 is INPUT (readable) This is a confusing bit for doing RTS/CTS handshake.
  6. Nice work. Looking at your Assembly language code the only difference I see is that you put TB 21 in an infinite loop. I used a timed loop that jumped out only when the characters stopped coming. Not sure that makes a difference. ?? Anyway I gotta get something going here now that you have set the bar.
  7. That's why you would STCR each byte directly into memory with *Rx+. Even it was a separate buffer you should be able to transfer that Assembly buffer to a Pascal packed array no?
  8. I have been a X BASIC program that has Assembly language support to do XMODEM called "Magic File Manipulator for 6 years or so. It works well and transfers at 19.2Kbps but it means leaving your current environment and going to BASIC. Yours is available directly from Pascal which is ideal. I need a version for the same reason so that I can remain in Forth and transfer binary files. You are an inspiration.
  9. Since all the real experts are having something to eat I will give you whatever I have gleaned. You are not alone with confusion using BLWP. I remember puzzling on it too. BLWP needs you to define a "vector" that consists of the workspace address and the entry address of the code you want to run. That would typically be done like this: MYWKSP BSS 32 * make some space for your registers MYCODE <CODE> <CODE> . . <END OF MY CODE> VECTOR DATA MYWKSP,MYCODE * two memory words that point to the workspace and entry address MAIN BLWP @VECTOR * this will change to your workspace and run MYCODE
  10. TheBF

    OPA Gary!

    What is the room audio recording all about?
  11. You might not need this with the xmodem protocol but what I did was make a "timed" getchar loop that waits for each character but not forever. That way when the data stream stops the code jumps straight into code that ends the communication. Just a thought. Something to consider. You can STCR directly into the buffer using indirect auto-inc. addressing and save instructions. mov *r10+,r1 ;get array pointer li r2,132 ;size of packet sbz -27 ;activate cts line chkbuf tb 21 ;check if receive buffer is empty jne chkbuf stcr *r1+,8 ;get byte directly into buffer, inc address sbz 18 ;reset buffer dec r2 jne chkbuf sbo -27 ;inactivate cts Here is what I am using. I realize it's quite a different looking assembler but maybe you can find something useful. ?? The IF statements can get confusing. When translating them to Jumps the logic is usually opposite so: EQ IF is really JNE instruction. Make sense?
  12. Just checked and most of that PI program is ANS Forth. Only the stuff at the top is for my system . So it runs on GForth and many other compliant systems. Everything from this code and below is ANS Forth. DECIMAL 0 VALUE POWER ( adr) 0 VALUE TERM ( adr) 0 VALUE RESULT ( adr) 0 VALUE SIZE ( n) So I pasted it into GForth and this is what happened. OMG. Milliseconds versus 6+ minutes. I forgot how slow our favourite machine is. gforth-itc 2024-03-14 21-43-15.mp4
  13. Currently its got specific code for Camel99 Forth. It is mostly ANS/Forth but with a bunch of additions to cope with TI-99. The kernel file and all the library files are here: You need is DSK1 for the system. CAMEL99-ITC/bin at master · bfox9900/CAMEL99-ITC · GitHub The PI progRam is on DSK3. With both disks on Classic99 Use Editor/Assembler Option 5 file name DSK1.CAMEL99 When it's loaded type INCLUDE DSK3.PI Then 100 PI for example I just tried this version (2.69) and it seems to work
  14. Oh sure. It's Forth so not many people care but here it is. What's nice is that it includes credits back to 1978! Ed in the notes is the author of DxForth that runs on MSDOS and CPM. \ PI.FTH from DxForth. \ Thanks to Ed from Australia for finding the bug in my D+ \ \ Revised 2015-02-09 es \ \ Compute Pi to an arbitrary precision. Uses Machin's \ formula: pi/4 = 4 arctan(1/5) - arctan(1/239) \ \ Compile with 16-bit DX-Forth: FORTH - INCLUDE PI.F BYE \ Compile with CAMEL99 Forth: INCLUDE DSK*.PI ( where * is your drive no.) \ \ This 16-bit implementation allows up to 45,808 digits \ to be computed before arithmetic overflow occurs. \ \ The code can be used on 32-bit targets with appropriate \ changes: \ \ 16-bit 32-bit \ \ 10000 Multiply 100000000 Multiply \ <# # # # # #> <# # # # # # # # # #> \ 4 +loop 8 +loop \ 525 um/mod 1050 um/mod \ remove 'digits > 45808' warning \ \ Acknowledgements: \ \ Roy Williams, Feb 1994 \ J. W. Stumpel, May 1991 \ E. Ford, Aug 2009 \ R. Bishop, Aug 1978 \ \ This code is PUBLIC DOMAIN. Use at your own risk. \ Modified for Camel99 Forth Mar 2021 Fox NEEDS DUMP FROM DSK1.LOWTOOLS NEEDS VALUE FROM DSK1.VALUES NEEDS D= FROM DSK1.DOUBLE NEEDS .R FROM DSK1.UDOTR NEEDS ELAPSE FROM DSK1.ELAPSE NEEDS MALLOC FROM DSK1.MALLOC \ proper MOVE for 9900, cell wide HEX CODE MOVE (addr1 addr2 len -- ) C036 , C076 , C104 , 1306 , 0584 , 0244 , FFFE , CC31 , 0644 , 15FD , C136 , NEXT, ENDCODE DECIMAL 0 VALUE POWER ( adr) 0 VALUE TERM ( adr) 0 VALUE RESULT ( adr) 0 VALUE SIZE ( n) VARIABLE CARRY : ADD ( -- ) CARRY OFF RESULT 0 SIZE 1- DO I CELLS OVER + ( res) DUP @ 0 I CELLS TERM + @ 0 D+ CARRY @ M+ ( hi) CARRY ! ( lo) SWAP ( res) ! -1 +LOOP DROP ; : SUBTRACT ( -- ) CARRY OFF RESULT 0 SIZE 1- DO I CELLS OVER + ( RES) DUP @ 0 I CELLS TERM + @ 0 D- CARRY @ M+ ( HI) CARRY ! ( LO) SWAP ( RES) ! -1 +LOOP DROP ; 0 VALUE FACTOR \ scan forward for cell containing non-zero : +INDEX ( ADR -- ADR INDEX ) -1 BEGIN 1+ DUP SIZE - WHILE 2DUP CELLS + @ UNTIL THEN ; : DIVIDE ( ADR FACTOR -- ) TO FACTOR CARRY OFF +INDEX ( adr index ) SIZE SWAP ?DO I CELLS OVER + ( res) DUP @ CARRY @ FACTOR UM/MOD ( quot) ROT ( res) ! ( rem) CARRY ! LOOP DROP ; \ scan backward for cell containing non-zero : -INDEX ( adr -- adr index ) SIZE BEGIN 1- DUP WHILE 2DUP CELLS + @ UNTIL THEN ; : MULTIPLY ( adr factor -- ) TO FACTOR CARRY OFF -INDEX ( adr index ) 0 SWAP DO I CELLS OVER + ( res) DUP @ FACTOR UM* CARRY @ M+ ( hi) CARRY ! ( lo) SWAP ( res) ! -1 +LOOP DROP ; : COPY ( -- ) POWER TERM SIZE CELLS MOVE ; \ : ZERO? ( result -- f ) +INDEX NIP SIZE = ; : ZERO? ( result -- F ) SIZE CELLS 0 SKIP NIP 0= ; 0 VALUE PASS VARIABLE EXP VARIABLE SIGN : DIVISOR ( -- N ) PASS 1 = IF 5 ELSE 239 THEN ; : ERASE 0 FILL ; : INITIALIZE ( -- ) POWER SIZE CELLS ERASE TERM SIZE CELLS ERASE PASS 1 = IF RESULT SIZE CELLS ERASE THEN 16 PASS DUP * / POWER ! POWER DIVISOR DIVIDE 1 EXP ! PASS 1- SIGN ! ; 0 VALUE NDIGIT : CalcPi ( -- ) NDIGIT 45800 U> IF ." Warning: digits > 45808 will be in error " CR THEN 2 1+ 1 DO I TO PASS INITIALIZE BEGIN COPY TERM EXP @ DIVIDE SIGN @ DUP IF SUBTRACT ELSE ADD THEN 0= SIGN ! 2 EXP +! POWER DIVISOR DUP * DIVIDE POWER ZERO? UNTIL LOOP ; \ VARIABLE OUT \ : CR CR 0 OUT ! ; \ : # # 1 OUT +! ; DECIMAL : PRINT ( -- ) CR RESULT DUP @ 0 .R [CHAR] . EMIT CR NDIGIT 0 ?DO 0 OVER ! DUP 10000 MULTIPLY DUP @ 0 <# # # # # #> TYPE SPACE \ OUT @ C/L @ > IF CR THEN \ not needed for Camel99 4 +LOOP DROP CR ; : GetNumber ( -- n ) CR ." How many digits do you want? " PAD DUP 20 ACCEPT NUMBER? ABORT" Invalid" CR ; : PI ( n -- ) DUP TO NDIGIT \ array size = ceil(ndigit / log10(2^16)) 109 UM* 525 UM/MOD SWAP ( rem) IF 1+ THEN ( extra for accurate last digits) 2 + TO SIZE \ create arrays in un-allocated memory HERE TO POWER SIZE 20 + CELLS ALLOT HERE TO TERM SIZE 20 + CELLS ALLOT HERE TO RESULT SIZE 20 + CELLS ALLOT 50 ALLOT ( hold buffer space) CalcPi PRINT ; \ end
×
×
  • Create New...