├── .gitattributes ├── .gitignore ├── README.md ├── f83.txt ├── from_author ├── F-PC.EXE ├── FBBS45.DAT ├── FBBS45.SEQ ├── FBBS_PRECOMPILED.EXE ├── instructions.md └── main.bat ├── modern ├── README.txt └── fbbs.fth ├── pristine ├── FBBS2.DAT ├── FBBS2.DOC ├── FBBS2.SCR └── README.SCR └── screens ├── screen_00.txt ├── screen_01.txt ├── screen_02.txt ├── screen_03.txt ├── screen_04.txt ├── screen_05.txt ├── screen_06.txt ├── screen_07.txt ├── screen_08.txt ├── screen_09.txt ├── screen_10.txt ├── screen_11.txt ├── screen_12.txt ├── screen_13.txt ├── screen_14.txt ├── screen_15.txt ├── screen_16.txt ├── screen_17.txt ├── screen_18.txt ├── screen_19.txt ├── screen_20.txt ├── screen_21.txt ├── screen_22.txt ├── screen_23.txt ├── screen_24.txt ├── screen_25.txt ├── screen_26.txt ├── screen_27.txt ├── screen_28.txt ├── screen_29.txt ├── screen_30.txt ├── screen_31.txt ├── screen_32.txt ├── screen_33.txt ├── screen_34.txt ├── screen_35.txt ├── screen_36.txt ├── screen_37.txt ├── screen_38.txt ├── screen_39.txt ├── screen_40.txt ├── screen_41.txt ├── screen_42.txt ├── screen_43.txt └── screens_all.fth /.gitattributes: -------------------------------------------------------------------------------- 1 | *.fth linguist-language=Forth 2 | *.scr linguist-language=Forth 3 | *.SCR linguist-language=Forth 4 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Forth BBS 2 (1984-1985) 2 | 3 | A reconstruction of a historic Forth BBS system. 4 | File timestamps and log comments seem to hint that the BBS was used around 1985. According to the author, it ran on a Z-80 and CP/M, though it also runs on MS-DOS. The system runs on the [F-PC Forth Environment](https://github.com/uho/F-PC). F-PC seems to work on [vDOS](https://www.vdos.info/download.html) (according to the original author) as well as [DOSBox](https://www.dosbox.com/) on Linux. 5 | 6 | Tom [left a comment](https://github.com/RickCarlino/fbbs2/issues/1#issuecomment-998279944) about getting the system to run. 7 | 8 | ## Project Status 9 | 10 | The source code does not yet run. We are actively reconstructing the software to run on modern hardware and would like to eventually host an instance of the BBS publicly. 11 | 12 | ## Goals / TODOs 13 | 14 | * Get it to run on modern hardware, an emulator or restored hardware that is period correct 15 | * Document its history 16 | * Get it online so that it can be used again by enthusiasts (probably via TCP or WebSocket proxy since I don't have a phone line) 17 | * According to Tom, the original author, the date code will need to be updated for the 2000s date format. 18 | 19 | ## Directory Contents 20 | 21 | * `pristine/` Unchanged source code for historic preservation purposes. 22 | * `modern/` Work in progress. A modernized version of the source code that someday will run on modern systems or emulators. We're not sure yet. 23 | * `from_author/` A collection of data provided by [the author](https://github.com/tombelpasso). 24 | * `screens/` The original screen files split and formatted in a way that can be easily viewed on modern systems. 25 | * `screens_all.txt` is all screens formatted and concatenated into a single file. 26 | * See `pristine/fbbs.scr` for the original version of the file. 27 | 28 | The soon-to-be-working source code can be found in `modern/fbbs.fth` 29 | 30 | ## Resources 31 | 32 | * ["Inside Forth 83" By: Dr. C. H. Ting](http://forth.org/OffeteStore/1003_InsideF83.pdf) - A very detailed introduction to F83 for those of us who learned Forth in the 21st century. 33 | * [The Forth 83 Standard, Converted to HTML](http://forth.sourceforge.net/standard/fst83/) - We may want to run the various test files at the bottom of the page to verify compatibility. I have added it to this project as `f83.txt` for easier `grep`ing. 34 | 35 | ## Run / Build Instructions 36 | 37 | Unknown at this time 38 | 39 | ## Resources 40 | 41 | I will add more resources about this package as I find them. 42 | 43 | The BBS was originally found here: http://cd.textfiles.com/simtel/simtel20/MSDOS/FORTH/.index.html 44 | 45 | The words that follow are a heavily modified copy of the original documentation, converted to Markdown. The original version can be found in `pristine/` 46 | 47 | --- 48 | 49 | **== BEGIN FBBS2 Documentation ==** 50 | 51 | # Purpose 52 | 53 | FBBS stands for FORTH Bulletin-Board System, and is a 54 | public domain tree-structured system modeled after the 55 | Communi-tree system. The purpose in placing this code in 56 | the public domain is NOT to provide a general-purpose do-all 57 | BBS for free for everyone for every computer, but rather to 58 | provide a basic system with the capability to be expanded in 59 | almost any direction. I will try to answer questions, but 60 | other than that, I can offer little or no free support for 61 | this system. 62 | 63 | To those who wish to alter this system and sell it, feel 64 | free to do so. If you make a lot of money and feel a little 65 | guilty, feel free also to send me some royalties. 66 | 67 | # General 68 | 69 | If you no little or nothing about tree-structured BBS's, I 70 | strongly advise that you spend an hour or two on one of the 71 | communitree boards (they are listed in The Computer Shopper) 72 | to get a feel for what is going on. The basic premise is 73 | that each message in the tree is appended to some other 74 | message (its parent) and may, in turn, have one or more 75 | messages appended to it (its sub-messages). These sub- 76 | messages can have there own sub-messages and so on. The 77 | top-most message in the tree would normally have as its 78 | submessages all the current major topics in the tree. Each 79 | of these topics could have a list of comments about that 80 | topic, and the comments could have comments, etc. etc. 81 | 82 | There is one unique message in the Tree, and that is at 83 | the top of the tree. This message is unique in that it has 84 | no parent (i.e. it was not added to another message). When 85 | the Tree is first brought up, the routine `ENTER-TOP` in- 86 | itializes the system and allows you to enter this message. 87 | All other messages in the system are added to this or some 88 | other message using the `ADDTO ` command. 89 | 90 | # Types of Commands 91 | 92 | The commands (or forth lexicons) in this system may be 93 | split into there groups: 94 | 95 | 1. User commands 96 | 2. Sysop commands 97 | 3. Internal commands. 98 | 99 | The normal user would use only those commands for reading, 100 | indexing, and finding messages. The Sysop commands include 101 | those for message removal, restructuring the tree, and for 102 | disk compaction. To perform these commands, a large set of 103 | internal commands are used, which neither the sysop nor the 104 | user need be concerned about. Programmers can build more 105 | user and/or sysop functions by combining these internal 106 | commands. 107 | 108 | Unlike FBBS-1.0, nothing is system dependent as limiting 109 | which functions can be executed has been implemented. This, 110 | **as well as such things as modem interface, are left to the 111 | end user**. 112 | 113 | # User Commands 114 | 115 | These are few in number and general-purpose in nature to make 116 | using the board as simple as possible. 117 | 118 | ## READ [date] 119 | 120 | This is the most common function, and is rather self-explanatory. 121 | A heading is printed, the body of the message, and a list of any 122 | submessages. The output may be paused by hitting any key, or 123 | terminated by hitting `K`. If a date is supplied, only submessages 124 | on or after that date will be listed. 125 | 126 | ## BROWSE [date] 127 | 128 | This is just like read, except that only the first line of 129 | the message is printed. 130 | 131 | ## ADDTO 132 | 133 | This function is for adding a sub-message to an existing 134 | message. If the directory or the disk is full, an error 135 | message will result. You will be asked to give the message 136 | a name, which may be up to 30 characters in length (longer 137 | names will be truncated). The name may not contain spaces. 138 | After entering the name, all lines typed in will become 139 | part of the message until an empty line is entered. The 140 | only editing provided is back-space. If you wish to embed 141 | blank lines in your message, put a space in the line before 142 | hitting again. There is no limitation on message 143 | length in this system other than disk capacity. 144 | After entering an empty line, you are back in the regular 145 | mode. 146 | 147 | ## INDEX [date] 148 | 149 | This function provides a method of viewing the structure 150 | of the tree below a certain message. INDEX FBBS (where 151 | FBBS is the top message in the tree) will display the 152 | structure of the entire tree. Each successive level of 153 | comments is indented 2 spaces from its parent. 154 | 155 | If a date is supplied, only messages aon or after that 156 | date will be listed. 157 | 158 | ## HELP 159 | 160 | This just prints "try READ HELP" HELP is a sysop-provided 161 | message that may contain all or part of this document. 162 | 163 | # Sysop Commands 164 | 165 | Again, these are not too complicated or numerous, and may 166 | be extended as needed. I call them sysop commands because it 167 | may not be desired to give the users this much power. 168 | 169 | ## START 170 | 171 | When you start up this system, this command is needed to 172 | load a few variables from disk 173 | 174 | ## REMOVE 175 | 176 | Self-explanatory. Both and any messages 177 | appended to it are removed, and the associated directory 178 | space (but not disk space) is reclaimed. A trap is provided 179 | to prevent removing the top of the tree. 180 | 181 | ## CRUNCH 182 | 183 | This command reclaims any disk space freed via REMOVE. It 184 | is slow, and should not be used when not needed. A star is 185 | printed as each message is crunched. 186 | 187 | ## MOVE TO 188 | 189 | This command allows a message to be reassigned to another 190 | parent, thus allowing you to move a message to a more 191 | appropriate section of the tree if required. All submes- 192 | sages appended to the message are moved also. A common use 193 | would be to move a message to a parent called GOING... prior 194 | to removing it to give users some warning. 195 | 196 | ## ENTER-TOP 197 | 198 | This command is dangerous, as it will wipe the tree clean. 199 | It is to be used only to enter the first message in the tree 200 | (it is a little difficult to use ADDTO when there is nothing 201 | to addto). 202 | 203 | ## RE-ENTER 204 | 205 | Normally, if you enter a message incorrectly, and wish to 206 | change it, you would use REMOVE and ADDTO. If the message 207 | in question had submessages, they would be lost. RE-ENTER 208 | allows you to enter new text for an exiting message without 209 | loosing the submessages. This is particularly useful for 210 | changing the text at the top of the tree. 211 | 212 | # Internals: 213 | 214 | Use the comments in the source code as a primary reference, 215 | as I may still make some changes. I will try to highlight a few 216 | things here that seem a little obtuse. 217 | 218 | ## #BLOCKS, DIR, #DIR and TREE 219 | 220 | These constants you will likely wish to change. As it 221 | stands, both the source code and the tree data are in the 222 | same file to make development easier. Most users will want 223 | to use a working file as large as possible, generally the 224 | size of one floppy disk on a floppy system. Change `#BLOCKS` 225 | to the capacity of that file (or to the capacity of your 226 | drive system if you are using direct disk-i/o). If you want 227 | to keep the source on line, set DIR to 40, leaving the 228 | first 40 blocks of the file free to hold the code. Other- 229 | wise, set DIR to 0 and be careful. 230 | 231 | The rest of the disk is split into two parts, a directory 232 | area and a data area. If either area gets full, the tree 233 | will be able to accept no more data. You should choose `#DIR` 234 | such that both areas fill up at about the same rate. The 235 | best number to use in dependent on the average message size. 236 | I would suggest 2 or 3 directory slots for each 1k of data 237 | area. Since there are about 22 directory slots in a a 238 | block, this will take up 10-15% of the disk and will 239 | generally be enough unless the messages are very short. 240 | 241 | The constants `#BYTES` and TREE are calculated automatically 242 | during compile and tell the # of bytes in the data area and 243 | block that that area starts. 244 | 245 | # Data structures 246 | 247 | Of these there are two. The first is a fixed-length 248 | directory record, and the second is the body of the message. 249 | 250 | Each message in the tree is just a simple ascii file, with 251 | the lines ending in CRLF with EOF (26h) marking the end of 252 | the file. Again, there is no real restriction on the size 253 | of the message other then disk space. If you are 254 | perceptive, you may notice this is exactly the same 255 | structure as a CP/M text file. Note that you cannot store 256 | com files in this structure, as they may contain EOF's in 257 | bad places. 258 | 259 | The directory record contains the name of the message, a 260 | few useful fields such as usage, date and length, a pointer 261 | to where the text of the message resides, and 3 pointers to 262 | other records to form the tree structure (parent, daughter, 263 | and sister). Note that there are pointers to records. This 264 | means shuffling the records about is a real no-no. As 265 | directory slots become available when messages are removed, 266 | they are kept track of by a linked list with the variable 267 | MT.PTR pointing to the most recently freed slot. 268 | Note also that the 32 bit pointer to the text of the 269 | message is the only direct reference to that message. All 270 | other references should be made thru the directory. This 271 | allows messages to be moved when the disk is being 272 | compacted. 273 | 274 | # Tree Structure 275 | 276 | **EDITORS NOTE:** 277 | Something is wrong with this section. The bullets are out of 278 | order and the paragraph topic changes without reason. Possible 279 | file corruption? -RC 17-DEC-2021 280 | 281 | If you've ever done an `INDEX ` the structure of 282 | the tree is obvious. Each message has a parent. The first 283 | sub-message of a message is it's daughter. To achive the 284 | effect of unlimited number of daughters, the daughter can 285 | point to a younger sister. The youngest sist 286 | 287 | 1. If there is a daughter, it becomes the new message 288 | 2. If there is no daughter, put there is a younger sister, it 289 | becomes the next message. 290 | 3. If there are neither go up the tree until a parent with a 291 | younger sister is found, which will become the next message. 292 | If no younger sister can be found, return a zero to indicate 293 | that the tree is exhausted. 294 | 4. TUTOR.LBR and HELP.BLK also some documentation files. 295 | 5. FBBS Forth based BBS with source. Two revisions. 296 | 6. F83 Text and Documentation files collection. 297 | 7. Library files A-I (Files used every day are kept on one of) 298 | 8. Library files J-P (the above working disks. These are) 299 | 9. Library files Q-Z (new to me or I don't have room above.) 300 | 301 | Send a SASE for an index list with citations. Include a letter or 302 | a dollar. John A. Peters 121 Santa Rosa Ave, SF, CA 94112: 303 | 304 | # CRUNCHing the disk 305 | 306 | This is a little bit complicated, but still only three 307 | screens worth of complicated. The idea behind crunching the 308 | disk is to take all the messages and rearrange them but-up 309 | against one another, making all the empty space contiguous 310 | and ready for more messages. This is done by building a 311 | list of each of the currently occupied directory slots 312 | sorted by the address of the message (BUILD-LIST). With 313 | 314 | this list, CRUNCH can move each of the messages to the low 315 | end of the file, updating the address pointers on the 316 | fly. After doing all this, we update END.PTR so we can 317 | make use of the space we freed. 318 | 319 | # Customization 320 | 321 | You may have noticed more than a few things have been left 322 | out of the code, such as bullet-proofing and modem inter- 323 | face. I consider this sort of thing to be system-dependent 324 | and not really all that difficult to program. This code is 325 | the meat of a bbs (in a reasonablly small and digestable 326 | portion), you may season it to your own taste. 327 | 328 | If you need some hints, I have ideas (and a little code) 329 | for everything from archival to passwords to multi-tasking 330 | to user-logons. 331 | -------------------------------------------------------------------------------- /from_author/F-PC.EXE: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/RickCarlino/fbbs2/ebedde08efdae22c630cd8861445585dbd9dc71e/from_author/F-PC.EXE -------------------------------------------------------------------------------- /from_author/FBBS45.DAT: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/RickCarlino/fbbs2/ebedde08efdae22c630cd8861445585dbd9dc71e/from_author/FBBS45.DAT -------------------------------------------------------------------------------- /from_author/FBBS45.SEQ: -------------------------------------------------------------------------------- 1 | \ FBBS46.SEQ version 4.3 of FORTH BBS program for f-pc Oct 04, 1992 2 | comment: 3 | This is a FORTH based BBS. It modeled after a BBS program called Comunitree 4 | written by John James over a decade ago. The tree structure makes much more 5 | sense for finding information on an unlimited number of topics. 6 | This a modification of Jeff Wilsons version 2 FBBS. 7 | 8 | By the way my name is Tom Belpasso, 852 Minnesota #116, San Jose, CA 95125 9 | 10 | Version 4.3 11/22/91 tjb 11 | Added NRUN command to read next message if empty line is entered 12 | Added AUTOREAD command that redirects RUN to use NRUN 13 | NOTE: f-pc editor resets RUN to 14 | Made a new NUF? that uses a FBBS variable, #LINE instead of FORTH's #LINE 15 | because #LINE in F-PC's moves the cursor. 16 | I have also made a new CR in the FBBS vocabulary to use the #LINE 17 | New INDEX that takes a max level on the stack only if there is one item 18 | RE-NAME substitutes blanks in message names with underscores 19 | 20 | Version 4 enhansements include: 21 | .NAME now does underscore substitution in display of message names, they are 22 | replaced by blanks to make message titles look cleaner. 23 | 24 | MAKE-HEAD now will accept message names that contain blanks and convert them 25 | to underbars. 26 | 27 | ADDTO now displays the header of the message you are adding to 28 | and the current date, you can cancel if it is the wrong message. 29 | 30 | New command LAST - goes to last message of the current parent. 31 | 32 | Version 4.5 changes 33 | Factored MAKE-HEAD to remove the part that parses the message name into a 34 | separate words GET-NAME gets message name into pad and MAKE-HEAD uses the 35 | message name in PAD. 36 | Changed .DATE into .MSG-DATE to avoid conflict with F-PC .DATE 37 | 38 | Version 4.6 changes 39 | NUF? now prompts with "[more]" 40 | Added AR alias for autoread 41 | Fixed the EDIT command's "temp.msg" file name 42 | 43 | comment; 44 | \ things to make the bbs go on f-PC 04/08/91 45 | ' IS RUN \ Prevents crashing on re-load 46 | ANEW FBBS3 47 | 48 | 11 VALUE KILLKEY \ use 'K' for kill key 49 | 27 VALUE ESCAPE 50 | VARIABLE #LINE \ F-PC's moves the cursor 51 | : 0#LINE! 0 #LINE ! ; 52 | : CR 1 #LINE +! CRLF ; \ Use the FBBS #LINE instead 53 | 54 | : KILLKEY? ( n--f) 55 | DUP ESCAPE = ABORT" Escaped" 31 AND KILLKEY = ; 56 | 57 | : NUF? ( --f) \ leave true it kill key hit 58 | KEY? DUP 59 | #LINE @ 20 > OR 60 | IF 0#LINE! DROP AT? 0 OVER AT ." [more]" 61 | HERE 1 (EXPECT) 62 | 0 OVER AT 7 SPACES AT 63 | HERE C@ KILLKEY? 64 | THEN ; 65 | 66 | \ defining this before loading block.seq will allow dedicated blockhandle 67 | 1024 constant b/buf \ length of each block 68 | 4 constant #buffers \ number of virtual buffers 69 | handle blkhndle 70 | blkhndle value blockhandle \ just use normal file stuff 71 | 72 | NEEDS BLOCK 73 | 74 | VOCABULARY FBBS 75 | FBBS DEFINITIONS 76 | 1024 CONSTANT 1K 77 | 26 CONSTANT EOF 78 | 06 CONSTANT EOT 79 | 80 | : BCLOSE ( -- ) \ CLOSES BLOCK FILE AND EMPTYS BUFFERS 81 | BLOCKHANDLE HCLOSE DROP EMPTY-BUFFERS ; 82 | 83 | : BOPEN READ-WRITE BLOCKHANDLE HOPEN 84 | ABORT" failed to open block file" ; 85 | 86 | : RE-BOPEN BCLOSE BOPEN ; 87 | 88 | ( KEEP THESE SEPARATE, FORTH-79 WORDS ) 89 | : COPY ( n1 n2 -- ) \ COPIES BLOCK n1 TO n2 90 | 2 ?ENOUGH FLUSH BUFFER UPDATE SWAP BLOCK SWAP 1K CMOVE ; 91 | 92 | : TEXT ( c--adr) 93 | WORD PAD 64 BLANK 94 | DUP C@ 1+ PAD SWAP CMOVE ; 95 | 96 | \ directory record field offsets 97 | 98 | 0 CONSTANT /NAME 30 CONSTANT /ADDR 99 | 34 CONSTANT /LENGTH 36 CONSTANT /DATE 100 | 38 CONSTANT /USAGE 40 CONSTANT /PARENT 101 | 42 CONSTANT /SISTER 44 CONSTANT /DAUGHTER 102 | 46 CONSTANT R-LEN 22 CONSTANT R/BLK 103 | 30 CONSTANT NAME-LEN \ max name length 104 | 105 | \ block allocation constants 012288TJB 106 | \ change the first three to suit your system 107 | 0 VALUE FBBS-DIR \ first directory block 108 | 6 VALUE #BLOCKS \ # of blocks in working file 109 | 1 VALUE TREE \ and figure 1st block of tree 110 | 111 | TREE FBBS-DIR - R/BLK * \ compute # of directory blocks 112 | VALUE #DIR \ max entries in directory 113 | 114 | #BLOCKS TREE - 1K UM* \ bytes in the tree 115 | 2CONSTANT #BYTES 116 | 117 | \ define storage 012288TJB 118 | 119 | VARIABLE MT.PTR \ points to empty directory slot 120 | 2VARIABLE RD.PTR \ for serial file i/o 121 | 2VARIABLE WR.PTR \ for serial file i/o 122 | VARIABLE TODAY 123 | VARIABLE LEVEL \ level of tree for INDEX 124 | VARIABLE SINCE \ for restricting dates 125 | 126 | \ date compression and formatting 092089TJB 127 | 128 | : DATE> ( mm/dd/yy -- u ) 100 UM/MOD 0 100 UM/MOD 129 | 32 * + SWAP 416 * + ; ( this is sortable) 130 | 131 | : >MDY ( U -- yy dd mm) 0 416 UM/MOD SWAP 32 /MOD ; 132 | 133 | : >DATE ( u -- mm/dd/yy) >MDY 100 * + 100 UM* ROT 0 D+ ; 134 | 135 | : .MSG-DATE ( u -- ) >DATE 136 | <# # # 47 HOLD # # 47 HOLD # # #> TYPE SPACE ; 137 | 138 | : .SINCE ( -- ) \ only displays since if set 139 | SINCE @ ?DUP 140 | IF ." since " .MSG-DATE ." only" THEN ; 141 | 142 | : ?DATE ( --u) \ parse off a date, use since as default 143 | >IN @ BL WORD DUP C@ 144 | IF NUMBER? 145 | IF DATE> NIP ELSE 2DROP >IN ! SINCE @ THEN 146 | ELSE DROP >IN ! SINCE @ THEN ; 147 | 148 | \ setting the date 149 | : GET-DOS-DATE ( - u ) \ gets the date from DOS into sort format 150 | 0 0 42 OS2 DROP \ drop day of week 151 | 256 /MOD 32 * + \ month and day 152 | SWAP 100 MOD 416 * + ; \ year 153 | 154 | : SET-DATE ( --) 155 | GET-DOS-DATE TODAY ! 156 | BEGIN CR ." Current date is: " TODAY @ .MSG-DATE CR 157 | \ ." Press if correct or enter new date mmddyy: " 158 | 0 0 \ QUERY CR ?DATE DUP SINCE @ <> 159 | WHILE TODAY ! REPEAT DROP ; 160 | 161 | \ get/save system vars 22JAN88TJB 162 | 163 | : PUTV ( --) \ save system vars 164 | FBBS-DIR BLOCK R/BLK R-LEN * + \ point to unused part 165 | >R WR.PTR 2@ R@ 2! 166 | MT.PTR @ R@ 4 + ! 167 | TODAY @ R@ 6 + ! 168 | #BLOCKS R@ 8 + ! 169 | TREE R> 10 + ! 170 | UPDATE FLUSH ; 171 | 172 | : START ( --) \ get system variables 173 | FBBS-DIR BLOCK R/BLK R-LEN * + 174 | DUP 2@ WR.PTR 2! 175 | DUP 4 + @ MT.PTR ! 176 | DUP 6 + @ TODAY ! 177 | DUP 8 + @ =: #BLOCKS 178 | 10 + @ =: TREE 179 | TREE FBBS-DIR - R/BLK * =: #DIR 180 | #BLOCKS TREE - 1K UM* ['] #BYTES >BODY 2! ; 181 | 182 | : .BLOCKFILE ( -- ) 183 | BLOCKHANDLE DUP COUNT CR TYPE SPACE ENDFILE D. ; 184 | 185 | : USE ( - |NAMEOFBLOCKFILE ) 186 | GFL BL WORD FLUSH BCLOSE 187 | BLOCKHANDLE $>HANDLE READ-WRITE BOPEN 188 | .BLOCKFILE START ; 189 | 190 | \ directory access 04APR91TJB 191 | 192 | : RECORD ( u--adr) \ this is 1 based 193 | 1- R/BLK /MOD FBBS-DIR + BLOCK SWAP R-LEN * + ; 194 | 195 | : INIT-TREE ( --) \ initialize the tree 196 | TREE FBBS-DIR - R/BLK * =: #DIR 197 | #BLOCKS TREE DO I BUFFER \ fill tree with EOF's 198 | 1K EOF FILL UPDATE LOOP 199 | #DIR 0 DO I 1+ I RECORD ! \ make linked list of empties 200 | UPDATE LOOP 1 MT.PTR ! \ and point to first 201 | 0 #DIR RECORD ! \ zero the last slot 202 | 0. WR.PTR 2! PUTV ; 203 | 204 | : MORE-TEXT ( n - ) \ allows adding more blocks for text 205 | 1 ?ENOUGH DUP 0> 206 | IF #BLOCKS OVER 0 MAX 0 207 | ?DO DUP I + BUFFER 1K EOF FILL UPDATE FLUSH LOOP 208 | + =: #BLOCKS PUTV RE-BOPEN 209 | #BLOCKS TREE - 1K UM* ['] #BYTES >BODY 2! 210 | ELSE DROP THEN ; 211 | 212 | : MORE-DIR ( n - ) \ allows adding more blocks for text 213 | 1 ?ENOUGH DUP 0> 214 | IF CR ." Adding " DUP R/BLK * . ." more message dir slots. Please wait." 215 | TREE #BLOCKS 1- 216 | ?DO I OVER + I SWAP COPY -1 +LOOP \ move message text up 217 | DUP #BLOCKS + =: #BLOCKS \ update # of blocks 218 | DUP TREE + =: TREE \ update tree 219 | R/BLK * #DIR + DUP #DIR 1+ \ calculate new # of dir slots 220 | DO I 1+ I RECORD ! UPDATE \ make linked list of new empties 221 | LOOP MT.PTR @ 0= \ check to see if we already ran out 222 | IF #DIR 1+ MT.PTR ! THEN \ and point to first new one 223 | =: #DIR 224 | 0 #DIR RECORD ! \ zero the last slot 225 | PUTV RE-BOPEN 226 | ELSE DROP THEN ; 227 | 228 | \ CNT-SLOTS 22JAN88TJB 229 | 230 | : GET-SLOT ( --n) \ find an empty directory slot 231 | MT.PTR @ DUP 0= 232 | IF DROP 2 MORE-DIR MT.PTR @ THEN \ add more if needed 233 | DUP RECORD @ MT.PTR ! ; \ put next empty to MT.PTR 234 | \ 235 | : CNT-SLOTS ( --n) \ count # of free slots in dir. 236 | 0 MT.PTR @ BEGIN DUP WHILE \ while not last slot 237 | SWAP 1+ SWAP \ advance count 238 | RECORD @ REPEAT DROP ; 239 | 240 | : TAB ( n--) \ tab over to col. N 241 | #OUT @ - SPACES ; 242 | 243 | \ directory managment 244 | 245 | : ERA-SLOT ( n--) \ free up a directory slot 246 | MT.PTR @ OVER RECORD ! UPDATE 247 | MT.PTR ! ; 248 | 249 | : >PARENT ( a--b) \ go to parent message 250 | RECORD /PARENT + @ ; 251 | 252 | : >DTR ( a--b) \ go to daughter 253 | RECORD /DAUGHTER + @ ; 254 | 255 | : >SISTER ( a--b) \ go to sister 256 | RECORD /SISTER + @ ; 257 | 258 | \ traversing the tree 259 | 260 | : >YOUNGEST ( a--b) \ go to youngest sister 261 | BEGIN DUP >SISTER ?DUP 262 | WHILE SWAP DROP REPEAT ; 263 | 264 | : >OLDER ( a--b) \ find older sister 265 | DUP >R >PARENT >DTR \ get oldest 266 | BEGIN DUP >SISTER ?DUP 267 | IF R@ <> ELSE DROP 0 0 THEN 268 | WHILE >SISTER REPEAT 269 | R> DROP ; 270 | 271 | \ more directory stuff 012288TJB 272 | 273 | : PARENT! ( n,rec--) \ write to parent filed 274 | RECORD /PARENT + ! UPDATE ; 275 | 276 | : DTR! ( n,rec--) 277 | RECORD /DAUGHTER + ! UPDATE ; 278 | 279 | : SISTER! ( n,rec--) 280 | RECORD /SISTER + ! UPDATE ; 281 | 282 | : ADDR! ( d,rec--) 283 | RECORD /ADDR + 2! UPDATE ; 284 | 285 | : NAME! ( $,rec--) \ put $ to name field 286 | RECORD /NAME + NAME-LEN CMOVE UPDATE ; 287 | \ more directory stuff 012288TJB 288 | 289 | : DATE@ ( rec--n) 290 | RECORD /DATE + @ ; 291 | 292 | : DATE! ( n,rec--) 293 | RECORD /DATE + ! UPDATE ; 294 | 295 | : USAGE@ ( rec--n) 296 | RECORD /USAGE + DUP 1 SWAP +! @ UPDATE ; 297 | 298 | : ADDR@ ( rec--adr32) 299 | RECORD /ADDR + 2@ ; 300 | 301 | \ date check 302 | 303 | : DATE-OK? ( rec--f) \ used for date restrictions 304 | ?DUP \ return -1 if record # is 0 305 | IF DATE@ SINCE @ U< NOT \ if msg date not before since 306 | ELSE TRUE THEN ; 307 | 308 | \ link new element into tree 012288TJB 309 | 310 | : CLR-LINKS ( n--) \ set all links to 0 311 | DUP RECORD /LENGTH + \ first field to clear 312 | R-LEN /LENGTH - 0 FILL UPDATE 313 | TODAY @ SWAP DATE! ; \ set the date 314 | 315 | : SET-LINKS ( parent,new--) \ link new element 316 | 0 OVER SISTER! \ clear sister of moved msg 317 | 2DUP PARENT! \ tell new item its parent 318 | OVER >DTR ?DUP IF \ if parent has children 319 | >YOUNGEST SISTER! DROP \ tell it about new sister 320 | ELSE SWAP DTR! THEN ; \ else we are only child 321 | 322 | \ serial file i/o ; THIS SCREEN WAS DAMAGED 22JAN88TJB 323 | 324 | : VADR ( adr32--adr) \ convert to virtual address 325 | 1K UM/MOD TREE + BLOCK + ; 326 | 327 | : 1.+! ( n--) \ inc a 32b variable 328 | DUP 2@ 1. D+ ROT 2! ; 329 | 330 | ( FROM HERE ON WAS DAMAGED, I WILL IMPROVISE ) 331 | : RD-S ( -- C ) \ READ BYTE FROM VIRTUAL MEMORY 332 | RD.PTR 2@ VADR C@ RD.PTR 1.+! ; 333 | 334 | : WR-S ( c -- ) \ writes byte to virtual memory using pointer 335 | WR.PTR 2@ VADR C! WR.PTR 1.+! UPDATE ; 336 | 337 | \ serial file i/o 012288TJB 338 | 339 | : TYPE-S ( adr32--) \ type message till eof 340 | RD.PTR 2! \ set the pointer 341 | BEGIN RD-S DUP EOF - \ while no end-of-file 342 | WHILE DUP EMIT 343 | 10 = IF 1 #LINE +! NUF? 344 | IF EXIT THEN \ if a K for kill 345 | THEN 346 | REPEAT DROP ; 347 | 348 | comment: experimental code for outline processing 349 | : LEV-TAB LEVEL @ ?DUP IF 0 DO 9 EMIT LOOP THEN ; 350 | : TYPE-S ( adr32--) \ type message till eof 351 | RD.PTR 2! \ set the pointer 352 | BEGIN RD-S DUP EOF - \ while not end-of-file 353 | WHILE 354 | CASE 355 | 13 OF CR LEV-TAB ENDOF 356 | 10 OF ENDOF 357 | EMIT DROP 358 | ENDCASE 359 | NUF? IF EXIT THEN \ if a K for kill 360 | REPEAT DROP ; 361 | comment; 362 | 363 | : INTERPRET-S ( adr32--) \ Interpret message as FORTH cmds till eof 364 | RD.PTR 2! \ set the pointer 365 | >IN OFF TIB 366 | BEGIN RD-S DUP EOF - \ while not end-of-file 367 | WHILE DUP 13 = 368 | IF DROP BL OVER C! 1+ TIB - #TIB ! 369 | INTERPRET >IN OFF #TIB OFF TIB 370 | ELSE DUP 10 = 371 | IF DROP ELSE OVER C! 1+ THEN 372 | THEN 373 | NUF? IF DROP EXIT THEN \ if a K for kill 374 | REPEAT 2DROP ; 375 | 376 | \ more file i/o 012288TJB 377 | 378 | : WR-CR ( --) 13 WR-S 10 WR-S ; 379 | 380 | : FULL? ( --f) \ is disk getting full? 381 | WR.PTR 2@ 256. D+ #BYTES D> DUP 382 | IF 2 MORE-TEXT DROP FALSE THEN ; 383 | 384 | : GET-TEXT ( --) \ to current pointer 385 | CR ." Enter an empty line to terminate input" CR CR 386 | BEGIN FULL? ABORT" disk full" 387 | QUERY 1 WORD COUNT DUP 0= 388 | IF 2DROP EOF WR-S EXIT THEN \ if input complete 389 | OVER + SWAP 390 | DO I C@ WR-S LOOP 391 | WR-CR CR AGAIN ; \ move it to the file 392 | 393 | \ MAKE-HEAD 022292TJB 394 | : S/BL/_ ( a n - ) \ Replace blanks with underbars 395 | OVER + SWAP 396 | DO I C@ BL = 397 | IF ASCII _ I C! THEN 398 | LOOP ; 399 | 400 | DEFER GET-NAME 401 | : GET-NAME-KB ( -- ) \ prompts for message name and stores it in pad 402 | CR ." Message name? " 403 | PAD 31 BL FILL \ Clear out pad 404 | PAD 1+ 30 EXPECT \ get 30 char name into PAD 405 | PAD 1+ SPAN @ -TRAILING \ find true length 406 | PAD C! DROP \ store length for counted string 407 | \ PAD COUNT UPPER \ make the name upper case (optional) 408 | PAD COUNT S/BL/_ \ replace blanks with underscores 409 | ; 410 | 411 | : GET-NAME-DATE \ PUTS DATE INTO PAD AS MESSAGE NAME 412 | PAD 31 BL FILL \ Clear out pad 413 | GETDATE FORM-DATE \ BUILD DATE 414 | DUP C@ 1+ PAD SWAP CMOVE \ MOVE DATE into PAD 415 | PAD COUNT 1+ >R R@ + \ GET ADDRESS IN PAD AFTER THE DATE 416 | GETTIME FORM-TIME \ GET ADDRESS OF COUNTED TIME STRING 417 | COUNT DROP 5 \ TRUNCATE TO MINUTES 418 | DUP R> + >R \ CALCULATE NEW LENGTH 419 | ROT SWAP CMOVE \ MOVE THE TIME TO PAD AFTER THE DATE 420 | R> PAD C! \ STORE NEW LENGTH IN PAD 421 | PAD COUNT S/BL/_ \ REPLACE BLANK WITH UNDERSCORE 422 | ; 423 | 424 | ' GET-NAME-KB IS GET-NAME \ Use the interactive one as default 425 | 426 | : MAKE-HEAD ( --n) \ make a directory entry using pad for name 427 | GET-SLOT >R \ find a directory slot 428 | WR.PTR 2@ R@ ADDR! \ message addr --> directory 429 | R@ CLR-LINKS \ clear links of new item 430 | PAD 1+ R@ NAME! R> ; \ name --> directory 431 | 432 | : ENTER-TOP \ put first message in the tree 433 | SET-DATE INIT-TREE 434 | MAKE-HEAD CLR-LINKS 435 | GET-TEXT TODAY @ 1 DATE! PUTV ; 436 | 437 | \ .NAME .SUB 22jan88tjb 438 | 439 | : .NAME ( n--) \ print dir# and name of directory entry 440 | DUP 3 .R SPACE RECORD NAME-LEN -TRAILING BOUNDS 441 | DO I C@ DUP ASCII _ = 442 | IF DROP BL THEN EMIT 443 | LOOP ; 444 | 445 | : .SUBS ( n--) \ list submessages 446 | >DTR ?DUP 447 | IF ." Submessages" .SINCE ." :" CR 448 | BEGIN DUP DATE-OK? IF DUP .NAME CR THEN 449 | >SISTER DUP 0= NUF? OR UNTIL DROP 450 | ELSE ." No submessages" CR THEN ; 451 | 452 | \ .HEAD 22jan88tjb 453 | 454 | : .HEAD ( n--) \ print a message heading 455 | ." Message: " DUP .NAME 40 TAB 456 | ." Date: " DUP DATE@ .MSG-DATE CR 457 | ." Parent: " DUP >PARENT ?DUP IF .NAME 458 | ELSE ." none" THEN 40 TAB 459 | ." Usage: " USAGE@ . CR CR ; 460 | 461 | : ( n--) 462 | CR DUP .HEAD LEVEL @ >R 0 LEVEL ! 463 | DUP ADDR@ 2DUP VADR C@ 3 = 464 | IF 1. D+ INTERPRET-S ELSE TYPE-S CR THEN 465 | .SUBS R> LEVEL ! ; 466 | 467 | \ scaning the tree 468 | 469 | : NEXT-MSG ( a--b) \ traverse the tree 470 | 1 MAX DUP >DTR ?DUP 471 | IF 1 LEVEL +! \ if it has a dtr 472 | SWAP DROP EXIT THEN \ if it has a dtr 473 | DUP >SISTER ?DUP 474 | IF SWAP DROP EXIT THEN \ if a sister 475 | BEGIN >PARENT -1 LEVEL +! \ while not at top of tree 476 | 1 MAX DUP 1- WHILE \ while not at top of tree 477 | DUP >SISTER ?DUP \ see if parent has sister 478 | IF SWAP DROP EXIT THEN 479 | REPEAT 1- ; \ return 0 if at top 480 | 481 | \ looking for a message 21sep89tjb 482 | : -MSG ( n--f) \ msg matches pad? 483 | RECORD PAD COUNT DUP ( if pad is empty than force match ) 484 | IF COMPARE 0= 485 | ELSE 3DROP TRUE THEN ; 486 | 487 | VARIABLE MSG# 1 MSG# ! 488 | : NFINDER ( n--n) \ find message only after message n 489 | BEGIN DUP -MSG ( IF FOUND, done ) 490 | IF PAD C@ 0= 491 | IF DROP MSG# @ THEN TRUE ( NULL STRING ) 492 | ELSE NEXT-MSG DUP 0= THEN \ last message 493 | UNTIL ; 494 | 495 | : FINDER ( --n) \ find message under previous one first 496 | BL TEXT ( PAD COUNT UPPER ) 497 | MSG# @ NEXT-MSG DUP IF NFINDER THEN DUP 0= 498 | IF 1+ NFINDER DUP 0= ABORT" <- not found " 499 | THEN DUP MSG# ! \ Remember msg number found 500 | ?DATE SINCE ! ; \ parse off date, if any 501 | 502 | \ READ and BROWSE 22jan88tjb 503 | 504 | : READ ( msg-name ) 505 | 0#LINE! FINDER ; 506 | 507 | : BROWSE ( ) 508 | FINDER CR DUP .HEAD 509 | DUP ADDR@ RD.PTR 2! 510 | BEGIN RD-S DUP EMIT 13 = UNTIL 511 | CR .SUBS ; 512 | 513 | : RE-ENTER \ re-enter message text 514 | WR.PTR 2@ FINDER CR 515 | ADDR! GET-TEXT PUTV ; 516 | 517 | : RE-NAME ( -- | [] ) 518 | FINDER CR ." Old message name " DUP .NAME 519 | DUP RECORD DUP 30 BL FILL CR ." Enter new message name -> " 520 | DUP 30 EXPECT 521 | SPAN S/BL/_ \ Replace blanks with _'s 522 | UPDATE CR .NAME ; 523 | 524 | \ addto and index 22FEB92TJB 525 | 526 | : ADDTO ( --) 527 | FULL? ABORT" disk full" 528 | FINDER DUP CR .HEAD 529 | ." Is this the parent message you want to ADDTO to abort" 530 | KEY 27 = ABORT" aborted" SET-DATE GET-NAME MAKE-HEAD 531 | SET-LINKS GET-TEXT PUTV ; 532 | 533 | : ADD-DATED \ use the date as message name 534 | ['] GET-NAME-DATE IS GET-NAME 535 | ADDTO 536 | ['] GET-NAME-KB IS GET-NAME ; 537 | 538 | \ NET CODE FOR INDEX TO LOOK AT NUMBER ON STACK AND USE AS MAX 539 | VARIABLE MAX-LEVEL 540 | : SET-MAX ( [n] -- ) \ REMOVES STACK ITEM ONLY IF ONE 541 | DEPTH 1 <> IF 32000 THEN MAX-LEVEL ! ; 542 | : LEV-OK? ( - T/F ) 543 | LEVEL @ MAX-LEVEL @ <= ; 544 | 545 | : INDEX ( --) \ show structure of tree 546 | 0#LINE! SET-MAX FINDER CR 0 LEVEL ! DUP .NAME CR 547 | BEGIN 548 | NEXT-MSG LEVEL @ 0> WHILE 549 | DUP DATE-OK? LEV-OK? AND IF 550 | LEVEL @ 2* SPACES DUP .NAME 551 | CR NUF? IF EXIT THEN THEN 552 | REPEAT DROP ; 553 | 554 | : READALL ( -- | [msgName] [mmddyy] ) \ read message and all subs 555 | 0#LINE! FINDER CR 0 LEVEL ! DUP CR 556 | BEGIN 557 | NEXT-MSG LEVEL @ 0> WHILE 558 | DUP DATE-OK? IF 559 | LEVEL @ 2* SPACES DUP 560 | CR KEY? IF EXIT THEN THEN 561 | REPEAT DROP ; 562 | 563 | comment: experimental outline processing stuff 564 | : .MSG ( N -- ) 565 | LEVEL @ ?DUP IF 0 DO 9 EMIT LOOP THEN 566 | CR DUP .NAME 2 SPACES DUP DATE@ .MSG-DATE CR LEV-TAB 567 | DUP ADDR@ TYPE-S ; 568 | 569 | : makeoutline ( -- | [msgName] [mmddyy] ) \ read message and all subs 570 | FINDER CR 0 LEVEL ! DUP .MSG CR 571 | BEGIN 572 | NEXT-MSG LEVEL @ 0> WHILE 573 | DUP DATE-OK? 574 | IF DUP .MSG CR KEY? 575 | IF EXIT THEN THEN 576 | REPEAT DROP ; 577 | comment; 578 | 579 | \ import and export from files 580 | : GET-FILE-TEXT \ from open file to current pointer 581 | CR BEGIN FULL? ABORT" disk full" 582 | LINEREAD COUNT DUP 0= \ read line from file EOF if 0 583 | IF 2DROP EOF WR-S EXIT THEN \ if input complete 584 | CR 2DUP 2- DUP 0> 585 | IF TYPE ELSE 2DROP THEN \ echo line to screen EXCEPT CR LF 586 | OVER + SWAP NUF? ?DUP \ Interupt with esc key 587 | IF EOF WR-S ABORT" interupted" THEN 588 | ?DO I C@ WR-S LOOP \ move it to the file msg file 589 | AGAIN ; 590 | 591 | : RE-IMPORT ( - | FILE [MSG] ) \ re-enter message text 592 | OPEN WR.PTR 2@ FINDER CR 593 | ADDR! GET-FILE-TEXT PUTV ; 594 | 595 | : IMPORT ( -- | FILENAME [MSG] ) 596 | OPEN FULL? ABORT" disk full" 597 | FINDER SET-DATE MAKE-HEAD 598 | SET-LINKS GET-FILE-TEXT PUTV ; 599 | 600 | : EXPORT ( - | FILENAME [MSG] ) \ WRITES IT TO A FILE 601 | PFILE PRINTING ON READ PRINTING OFF PCLOSE ; 602 | 603 | \ type a file to the screen, can be used in executed messages 604 | : TYPE-F ( | --- ) 605 | CR ." Reading file " \ open a file 606 | BL WORD $HOPEN ABORT" File open error" 607 | 0.0 SEEK .FILE \ reset file pointer buffer 608 | BEGIN 609 | LINEREAD \ read a line, returns an address of counted $ 610 | DUP C@ \ check for length, 611 | 0<> ( NUF? 0= AND ) WHILE \ while buffer contains something 612 | CR COUNT 2- TYPE \ type line just read without the CRLF chars. 613 | REPEAT DROP CR \ repeat till file empty. 614 | ( CLOSE ) ; \ close the file. 615 | 616 | \ de-link 04/06/91 TJB 617 | 618 | : DE-LINK ( n--) \ break a branch off the tree 619 | DUP >PARENT >DTR OVER = \ see if eldest child 620 | IF DUP >SISTER SWAP >PARENT DTR! 621 | ELSE DUP >SISTER SWAP >OLDER SISTER! THEN ; 622 | 623 | : MOVE FINDER ; \ for MOVE xxx TO xxx 624 | 625 | : TO ( n--) 626 | 1 ?ENOUGH FINDER 627 | SWAP DUP DE-LINK SET-LINKS FLUSH ; 628 | 629 | \ REMOVE 630 | 631 | : REMOVE ( --) \ remove a message 632 | FINDER CR DUP 1 = 633 | ABORT" atempt to remove top" 634 | DUP >PARENT MSG# ! 635 | DUP DE-LINK 0 LEVEL ! 636 | BEGIN DUP ERA-SLOT NEXT-MSG 637 | LEVEL @ 0> NOT 638 | UNTIL DROP PUTV ; 639 | 640 | \ Routines for CRUNCH 641 | 642 | : -ADDR ( a,b--) \ compare addr fields 643 | ADDR@ ROT ADDR@ D> ; 644 | 645 | : PAD-END ( --n) \ get end of pad list 646 | PAD DUP @ 1+ 2* + ; 647 | 648 | : >PAD ( n--) \ sort slot into list 649 | PAD-END PAD 2+ \ set up to scan list 650 | DO DUP I @ -ADDR IF \ if new addr lower 651 | I @ SWAP I ! THEN 2 +LOOP 652 | PAD-END ! 1 PAD +! ; 653 | 654 | \ routines for CRUNCH 012288TJB 655 | 656 | : BUILD-LIST ( --) \ make a dir. list sorted by addr 657 | 1 PAD ! 1 PAD 2+ ! \ init dir list 658 | 1 BEGIN NEXT-MSG DUP WHILE \ while not thru tree 659 | DUP >PAD REPEAT DROP ; 660 | 661 | : SHOW-FREE ( -- ) \ SHOWS FREE SPACE IN MSG DB 662 | .BLOCKFILE CR ." FREE SLOTS = " CNT-SLOTS . SPACE 663 | ." FREE MESSAGE TEXT BYTES = " #BYTES WR.PTR 2@ D- D. ; 664 | 665 | : SHOW-SLOT ( n--) \ shows links, name and addr 666 | CR DUP 5 .R DUP >PARENT 7 .R 667 | DUP >DTR 7 .R DUP >SISTER 7 .R 668 | DUP ADDR@ 8 D.R 3 SPACES .NAME ; 669 | 670 | : SHOW-LIST ( --) \ show the list 671 | BUILD-LIST 672 | CR ." dir# parent dtr sister addr name" 673 | PAD-END PAD 2+ DO I @ 674 | SHOW-SLOT NUF? ?LEAVE 675 | 2 +LOOP SHOW-FREE ; 676 | 677 | \ routines for CRUNCH 012288TJB 678 | 679 | : CRUNCH ( --) \ crunch the disk 680 | BUILD-LIST 0. WR.PTR 2! 681 | PAD-END PAD 2+ DO 682 | I @ ADDR@ RD.PTR 2! \ set read pointer 683 | WR.PTR 2@ I @ ADDR! \ update addr field 684 | BEGIN RD-S DUP WR-S \ move it down 685 | EOF = UNTIL 686 | 42 EMIT 2 +LOOP 687 | PUTV ; 688 | 689 | \ some nice shortcut commands, NN 22jan88tjb 690 | 691 | : NN \ reads next msg in tree with no name required 692 | 0#LINE! ?DATE SINCE ! MSG# @ 693 | BEGIN NEXT-MSG DUP DATE-OK? UNTIL ?DUP 694 | IF DUP MSG# ! 695 | ELSE ." End of tree " THEN ; 696 | 697 | : P \ Backs up to current message's parent 698 | 0#LINE! MSG# @ >PARENT DUP 699 | IF DUP ELSE ." At top " 1+ THEN 700 | MSG# ! ; 701 | 702 | : >SISTER-SINCE ( n--n) \ trys to read sister, true if found 703 | DUP 704 | IF BEGIN >SISTER DUP DATE-OK? UNTIL 705 | THEN ; 706 | 707 | : SKIP ( -- | [] ) \ reads next sister in tree with no name required 708 | ?DATE SINCE ! MSG# @ \ get since date 709 | BEGIN DUP >SISTER-SINCE ?DUP 0= 710 | WHILE >PARENT DUP DUP 1 = SWAP 0= OR 711 | IF DROP ." No more sisters" .SINCE EXIT THEN 712 | REPEAT NIP DUP MSG# ! ; 713 | 714 | : BB \ Backs up to current message's older sister or parent 715 | MSG# @ >OLDER ?DUP 716 | IF DUP 717 | ELSE MSG# @ >PARENT ?DUP 718 | IF DUP ELSE ." At top " 1 THEN 719 | THEN MSG# ! ; 720 | 721 | : SEL ( n - ) \ selects message using its number, NO CHECKING FOR EMPTIES 722 | MSG# ! ; 723 | 724 | : #READ ( n - ) DUP SEL ; 725 | 726 | : HELP CR ." try READ HELP" CR ; 727 | 728 | : EDIT ( - | [MSG] ) \ WRITES IT TO A FILE 729 | " TEMP.MSG" DROP 1- DUP $PFILE ABORT" temp file prob" 730 | CR FINDER 731 | PRINTING ON ADDR@ TYPE-S PRINTING OFF 732 | PCLOSE CLOSE READ-WRITE 733 | $HOPEN DROP ED WR.PTR 2@ MSG# @ ADDR! 734 | CR 1 >LINE GET-FILE-TEXT PUTV ; 735 | 736 | : MAKE-EXEC ( -- | [MSG] [MMDDYY] ) 737 | FINDER ADDR@ VADR 3 SWAP C! UPDATE ; 738 | 739 | : MAKE-TEXT ( -- | [MSG] [MMDDYY] ) 740 | FINDER ADDR@ VADR ASCII # SWAP C! UPDATE ; 741 | 742 | : BYE FLUSH BCLOSE BYE ; 743 | 744 | : F FINDER CR .NAME ; 745 | 746 | : last ( - ) 747 | MSG# @ DUP >YOUNGEST ?DUP 748 | IF DUP MSG# ! NIP THEN CR .NAME ; 749 | 750 | \ FBBS aliases 751 | ' INDEX ALIAS IND 752 | ' #READ ALIAS #R 753 | ' READALL ALIAS RA 754 | ' SHOW-LIST ALIAS SL 755 | ' BROWSE ALIAS BR 756 | ' READ ALIAS R 757 | ' NN ALIAS N 758 | ' BB ALIAS B 759 | ' LAST ALIAS Y 760 | ' INDEX ALIAS I 761 | ' ADDTO ALIAS A 762 | ' LAST ALIAS L 763 | ' SKIP ALIAS S 764 | forth definitions 765 | : NRUN ( -- ) \ New run command so entering a blank line will execute NN 766 | 0#LINE! #TIB @ 0= IF [ FBBS ] NN [ FORTH ] THEN DEFERS RUN ; 767 | : AUTOREAD ['] NRUN IS RUN ; 768 | ' AUTOREAD ALIAS AR 769 | cr 770 | .( You should also turn off the vocabulary display with VOCOFF ) cr 771 | .( Then enter the FBBS vocabulary and open the message file:) cr 772 | .( fbbs use fbbs43.dat ) cr 773 | .( At this point both FBBS and FORTH words will work) cr 774 | .( Now enter: read help ) cr 775 | 776 | 777 | -------------------------------------------------------------------------------- /from_author/FBBS_PRECOMPILED.EXE: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/RickCarlino/fbbs2/ebedde08efdae22c630cd8861445585dbd9dc71e/from_author/FBBS_PRECOMPILED.EXE -------------------------------------------------------------------------------- /from_author/instructions.md: -------------------------------------------------------------------------------- 1 | A lot of the history is in the messages in the last FBBS file. 2 | The date code is pre 2k, so needs updating. 3 | The fbbs45.dat file has a new entry from yesterday using a new command I (Tom) added: add-dated - make entry with date as name. 4 | Turns out the F-PC.exe I sent you requires the block code to load the FBBS. 5 | all you have to do to is specify the fbbs dictionary and 'use' the .dat file: `fbbs use fbbs45.dat` 6 | The OS on Z80's was CPM. 7 | https://github.com/RickCarlino/fbbs2/issues/1#issuecomment-998279944 8 | -------------------------------------------------------------------------------- /from_author/main.bat: -------------------------------------------------------------------------------- 1 | MOUNT C . 2 | C: 3 | FBBS_P~1.EXE FBBS45.DAT fbbs use FBBS45.DAT read help 4 | -------------------------------------------------------------------------------- /modern/README.txt: -------------------------------------------------------------------------------- 1 | A note to F83 users from John Peters 119MAY85JAP 2 | 3 | Dear F83 BBS interested person, May 15, 1985 4 | 5 | I have gone thru the various disks and versions I have in the library. The 6 | files on this disk are the best of all. The BBS was originally obtained by me 7 | from Jeff Wilson in the form of a MVP Forth disk. I sent a copy of version 8 | 0.0 to Tom Belpasso who modified it for F83 and added Virtual I/O so that the 9 | data can be in a separate file. There is a working version on the disk called 10 | FBBS1.COM. It works fine with FBBS2.DAT. However later Jeff sent me version 11 | 2.0 of FBBS. The COM file I have for that version? gives me a "bad load". 12 | That is why I have included a copy of FBBS1.COM as it is the only working 13 | version I have. This is on top of the old F83 1.0.0, doen not contain any of 14 | my developement tools and requires you to reset VBLK to zero as it was 15 | originally set to 40. 16 | 17 | JP 18 | 19 | ------------ 20 | 21 | A HAND WRITTEN NOTE ENCLOSED WITH THE DISK from Tom. 15MAY85JAP 22 | 23 | Hi John, Jan 12, 1985 24 | 25 | Here is the FBBS stuff. Pack dosen't work. There is a file that contains the 26 | old FBBS.BBS messages only. To access that file. 27 | 28 | OPEN FBBS.BBS 29 | 0 IS VBLK ( Set virtual block ) 30 | START ( Reads the setup data ) 31 | 32 | NOTE: You have to be in the FBBS vocabulary to exicute the above. 33 | 34 | Good luck with it. 35 | 36 | Please send me SCRPRINT.COM, NDIR.BLK and SDIR.BLK when you get a chance. 37 | 38 | Tom Belpasso 39 | 40 | ------------ 41 | 42 | LETTER TO TOM BELPASSO 15MAY85JAP 43 | 44 | Dear Tom, May 15, 1985 45 | 46 | I am uploading what I have in the library to CL BBS as a Library so it is not 47 | dependant on you to fix what ails it. I do want you to have the latest 48 | information on it. When I compile the file FBBS2.BLK on to F83 2.1.2 it has 49 | problems. I think it might be in the area of Virtual file I/O. Currently I 50 | have tried both the VIO in the file FBBS2.BLK and the V-I/0 from EZDIR.BLK 51 | which I have in a seprate file.^ 52 | -------------------------------------------------------------------------------- /modern/fbbs.fth: -------------------------------------------------------------------------------- 1 | \ ===== WORDS THAT NEED REPLACEMENT ON MODERN (NON-F83) SYSTEMS: 2 | \ Some of these words may be listed in the F-PC Forth documentation. 3 | : DOS ." MISSING DOS" ; 4 | : UPPER ." MISSING UPPER" ; 5 | : #OUT ." MISSING #OUT" ; 6 | : NOT ." MISSING NOT" ; 7 | : OPEN ." MISSING OPEN" ; 8 | : (SOURCE) ." MISSING SOURCE " ; 9 | : START ." MISSING START" ; 10 | : VADDR ." MISSING VADDR" ; 11 | : RES ." MISSING RES" ; 12 | : V.PTR ." MISSING V.PTR" ; 13 | : V> ." MISSING V>" ; 14 | : V ." MISSING V" ; 15 | : >V ." MISSING >V" ; 16 | : VDP ." MISSING VDP" ; 17 | : VBLK ." MISSING VBLK" ; 18 | : V- ." MISSING V-" ; 19 | : PC@ ." MISSING PC@" ; 20 | : (?ERROR) ." MISSING (?ERROR)" ; 21 | : ?ERROR ." MISSING ?ERROR" ; 22 | : ." I think this word is 'modem emit'." ; 23 | : CHAT ." This is a modem word, probably." ; 24 | : MKEY ." Possible meaning: 'modem key'" ; 25 | \ ===== END STUBS ===== 26 | 27 | \ ==== Words missing from standard GForth: 28 | : 2+ 2 + ; 29 | \ ==== END GFORTH ADDITIONS 30 | 31 | ONLY FORTH ALSO 32 | VOCABULARY FBBS FBBS DEFINITIONS ALSO 33 | : OPENFILE [ DOS ] OPEN-FILE ; 34 | : UWORD WORD DUP COUNT UPPER ; 35 | : TEXT HERE C/L 1+ BLANK UWORD PAD C/L 1+ CMOVE ; 36 | : TAB ( n -- ) 37 | #OUT @ - DUP 0> IF SPACES ELSE DROP THEN ; 38 | : 2AND ( d d -- d ) 2 ROLL AND ROT ROT AND SWAP ; 39 | : 2NOT ( d -- d ) NOT SWAP NOT SWAP ; 40 | : "FBBS2.DAT" ( -- addr len ) s" FBBS2.DAT" ; 41 | : OPEN-DATA ( -- ) ['] "FBBS2.DAT" IS SOURCE >IN OFF OPEN ['] (SOURCE) IS SOURCE ; 42 | : INIT-BBS OPEN-DATA START ; 43 | : TY.R OVER - SPACES TYPE ; 44 | : DATE> ( mm/dd/yy -- u ) 100 UM/MOD 0 100 UM/MOD 32 * + SWAP 416 * + ; ( this is sortable) 45 | : >MDY ( U -- yy dd mm) 0 416 UM/MOD SWAP 32 /MOD ; 46 | : >DATE ( u -- mm/dd/yy) >MDY 100 * + 100 UM* ROT 0 D+ ; 47 | : .DATE ( u -- ) SPACE >DATE <# # # 47 HOLD # # 47 HOLD # # #> TYPE SPACE ; 48 | 49 | 2VARIABLE CUR-MSG 50 | 2VARIABLE NEW.PTR 2VARIABLE SCAN-ROOT 51 | 0. CUR-MSG 2! 52 | VARIABLE TODAY 53 | CREATE DATE 2 , 0 , 54 | CREATE LENGTH 4 , 2 , 55 | CREATE PARENT 4 , 6 , 56 | CREATE YOUNGER 4 , 10 , 57 | CREATE OLDER 4 , 14 , 58 | CREATE DAUGHTER 4 , 18 , 59 | CREATE USAGE 2 , 22 , 60 | CREATE FILE-TYPE 1 , 24 , 61 | 62 | : >NAME 25. D+ ; 63 | 64 | CREATE HEADER 25 ALLOT 2VARIABLE HADDR 65 | 66 | : HEADER@ 67 | 2DUP HADDR 2! VADDR RES @ 25 > 68 | IF 69 | HEADER 25 CMOVE HADDR 2@ >NAME V.PTR 2! 70 | ELSE 71 | HADDR 2@ V.PTR 2! HEADER 25 + HEADER 72 | DO 73 | V> I C! 74 | LOOP 75 | THEN ; 76 | 77 | : HEADER! 78 | V.PTR 2! HEADER 25 + HEADER 79 | DO 80 | I C@ >V 81 | LOOP ; 82 | : HADDR! HADDR 2@ HEADER! ; 83 | : >HEADER 84 | DUP 2+ @ HEADER + SWAP @ DUP 4 = 85 | IF 86 | DROP 2! 87 | ELSE 88 | 2 = 89 | IF 90 | ! 91 | ELSE 92 | C! 93 | THEN 94 | THEN ; 95 | 96 | : HEADER> 97 | DUP 2+ @ HEADER + SWAP @ DUP 4 = 98 | IF 99 | DROP 2@ 100 | ELSE 101 | 2 = 102 | IF 103 | @ 104 | ELSE 105 | C@ 106 | THEN 107 | THEN ; 108 | 109 | : CLR-HEADER 110 | HEADER 25 + HEADER 111 | DO 112 | 0 I C! 113 | LOOP ; 114 | 115 | : HEADER? CR 116 | ." haddr: " HADDR 2@ D. CR 117 | ." date: " DATE HEADER> .DATE CR 118 | ." length: " LENGTH HEADER> D. CR 119 | ." parent: " PARENT HEADER> D. CR 120 | ." younger: " YOUNGER HEADER> D. CR 121 | ." older: " OLDER HEADER> D. CR 122 | ." daughter: " DAUGHTER HEADER> D. CR 123 | ." usage: " USAGE HEADER> U. CR 124 | ." file type: " FILE-TYPE HEADER> U. CR 125 | ." cur-msg: " CUR-MSG 2@ D. CR 126 | ." vdp: " VDP 2@ D. CR CR ; 127 | : CUR-HEAD? CUR-MSG 2@ HEADER@ HEADER? ; 128 | 129 | : START OPENFILE VBLK BLOCK 2@ VDP 2! 0. CUR-MSG 2! 130 | VBLK BLOCK 4 + @ TODAY ! ; 131 | 132 | : STOP VDP 2@ VBLK BLOCK 2! 133 | TODAY @ VBLK BLOCK 4 + ! UPDATE FLUSH ; 134 | 135 | : SET-DATE 136 | BEGIN 137 | CR ." system date is " 138 | TODAY @ .DATE CR 139 | ." Hit if correct, else enter new mmddyy: " 140 | QUERY BL WORD NUMBER? DROP DATE> DUP 0= 141 | IF 142 | NOT 143 | ELSE 144 | TODAY ! 0 145 | THEN 146 | UNTIL 147 | CR ; 148 | 149 | : >DTR CUR-MSG 2@ HEADER@ DAUGHTER HEADER> CUR-MSG 2! ; 150 | 151 | : YOUNGEST \ find youngest sister of cur-msg 152 | BEGIN 153 | CUR-MSG 2@ HEADER@ YOUNGER HEADER> 2DUP D0= NOT 154 | WHILE 155 | CUR-MSG 2! 156 | REPEAT 157 | 2DROP ; 158 | 159 | : INIT-BBS 0. VDP 2! 0. CUR-MSG 2! ; 160 | 161 | : SET-LINKS 162 | NEW.PTR 2@ HEADER@ CUR-MSG 2@ PARENT >HEADER NEW.PTR 2@ HEADER! 163 | CUR-MSG 2@ HEADER@ DAUGHTER HEADER> D0= 164 | IF 165 | NEW.PTR 2@ DAUGHTER >HEADER CUR-MSG 2@ HEADER! NEW.PTR 2@ 166 | HEADER@ CUR-MSG 2@ OLDER >HEADER 167 | ELSE 168 | >DTR YOUNGEST NEW.PTR 2@ YOUNGER >HEADER HADDR! NEW.PTR 169 | 2@ HEADER@ CUR-MSG 2@ OLDER >HEADER 170 | THEN 171 | 0. YOUNGER >HEADER NEW.PTR 2@ HEADER! ; 172 | 173 | : DO-HEADER ( d --) \ set up header for new message 174 | CLR-HEADER TODAY @ DATE >HEADER 175 | VDP 2@ NEW.PTR 2@ D- LENGTH >HEADER 176 | 1 FILE-TYPE >HEADER NEW.PTR 2@ HEADER! SET-LINKS ; 177 | 178 | : K? KEY? IF KEY 31 AND DUP 11 = ABORT" killed. " 19 = 179 | IF KEY DROP THEN THEN ; ( K to kill or S to pause ) 180 | \ K? is case and control independent any S or K will do 181 | : TYPER BEGIN K? V> DUP 127 AND DUP EMIT 182 | 13 = IF 10 EMIT THEN 127 > UNTIL ; 183 | 184 | : TYPE-LINE BEGIN V> DUP 127 AND DUP 13 = IF DROP 128 OR 185 | ELSE EMIT THEN 127 > UNTIL CR ; 186 | : INCU USAGE HEADER> 1+ USAGE >HEADER HADDR 2@ HEADER! ; 187 | : .HEAD CUR-MSG 2@ HEADER@ INCU CR ." PARENT: " PARENT HEADER> 188 | >NAME V.PTR 2! TYPER 40 TAB DATE HEADER> ." DATE: " .DATE 189 | CR CUR-MSG 2@ >NAME V.PTR 2! ." MESSAGE: " TYPER 190 | 40 TAB USAGE HEADER> ." USAGE: " U. CR CR ; 191 | 2VARIABLE E.PTR 192 | : VMARK V- V> 128 OR V- >V ; 193 | 194 | : LINE>V QUERY 1 WORD COUNT DUP >R 195 | 0 ?DO DUP C@ >V 1+ LOOP 196 | DROP CR 13 >V R> ; 197 | 198 | : MNH ( Message Name Header ) 199 | VDP 2@ 2DUP NEW.PTR 2! >NAME 2DUP VADDR DROP V.PTR 2! 200 | SET-DATE ." MESSAGE NAME? " QUERY 32 UWORD COUNT 32 MIN 201 | DUP 0= ABORT" bad name" 202 | 0 DO DUP C@ >V 1+ LOOP DROP VMARK CR ; 203 | 204 | : ED MNH ." Press CR twice to exit editor" CR CR 205 | BEGIN LINE>V 0= UNTIL V- VMARK V.PTR 2@ 2DUP E.PTR 2! 206 | VDP 2@ D- ." MESSAGE LENGTH: " D. ." BYTES." CR 207 | ." OPTIONS: LL SAVEIT" CR ; 208 | 209 | : LL NEW.PTR 2@ >NAME V.PTR 2! CR ." name: " TYPER CR CR 210 | TYPER CR ; 211 | : LIST LL ; 212 | : SAVEIT E.PTR 2@ VDP 2! DO-HEADER CR ; 213 | : SAVEPERMANENT SAVEIT ; 214 | : S SAVEIT ; 215 | 216 | VARIABLE SINCE 217 | 218 | : SUB-MSG CR CR CUR-MSG 2@ HEADER@ DAUGHTER HEADER> 2DUP D0= 219 | IF 2DROP ." no submessages" ELSE ." SUBMESSAGES: " CR 220 | BEGIN HEADER@ DATE HEADER> SINCE @ U< NOT IF 221 | HADDR 2@ >NAME V.PTR 2! TYPER 222 | 35 TAB DATE HEADER> .DATE CR THEN 223 | YOUNGER HEADER> 2DUP D0= UNTIL 2DROP THEN CR ; 224 | 225 | VARIABLE LEVEL 226 | 227 | : NEXT-MSG ( --f) CUR-MSG 2@ HEADER@ DAUGHTER HEADER> 228 | 2DUP D0= NOT IF CUR-MSG 2! 1 LEVEL +! 1 ELSE 2DROP 229 | YOUNGER HEADER> 2DUP D0= NOT IF CUR-MSG 2! 1 ELSE 2DROP BEGIN 230 | PARENT HEADER> 2DUP CUR-MSG 2! -1 LEVEL +! 2DUP SCAN-ROOT 231 | 2@ D= IF 2DROP 0 1 ELSE HEADER@ YOUNGER HEADER> 2DUP D0= NOT 232 | IF CUR-MSG 2! 1 1 ELSE 2DROP 0 THEN THEN K? UNTIL THEN THEN ; 233 | \ K? allows user to escape long searches 234 | : NN 0. SCAN-ROOT 2! NEXT-MSG IF .HEAD TYPER SUB-MSG ELSE 235 | CR ." nothing more to read" CR THEN ; 236 | 237 | : BB CUR-MSG 2@ HEADER@ OLDER HEADER> CUR-MSG 2! 238 | .HEAD TYPER SUB-MSG ; 239 | CREATE NAME-BUF 40 ALLOT VARIABLE NAME-LEN 240 | 241 | : ?NAME BL TEXT PAD 1+ NAME-BUF 40 CMOVE 242 | NAME-BUF 40 -TRAILING DUP 0= ABORT" bad name" 243 | DUP NAME-LEN ! 1- + DUP C@ 128 OR SWAP C! 244 | BL WORD NUMBER? DROP DATE> SINCE ! ; 245 | 246 | : -NAME >NAME V.PTR 2! 1 NAME-BUF DUP NAME-LEN @ + 247 | SWAP DO I C@ V> = AND DUP 0= IF LEAVE THEN LOOP ; 248 | 249 | : FIND-NAME 0. 2DUP CUR-MSG 2! SCAN-ROOT 2! 250 | BEGIN CUR-MSG 2@ -NAME IF 0 EXIT THEN NEXT-MSG 0= UNTIL 1 ; 251 | 252 | : FINDER ?NAME FIND-NAME IF ." <-- message not in tree." 253 | ABORT THEN CR ; : GOTO FINDER ; 254 | : READ FINDER .HEAD TYPER SUB-MSG ; 255 | : R READ ; 256 | : BROWSE FINDER .HEAD TYPE-LINE CR SUB-MSG ; 257 | 258 | : ADDTO FINDER ED ; 259 | 260 | : INDEX FINDER CUR-MSG 2@ 2DUP SCAN-ROOT 2! HEADER@ 0 LEVEL ! 261 | DAUGHTER HEADER> D0= ABORT" nothing to index" 262 | BEGIN NEXT-MSG WHILE CUR-MSG 2@ HEADER@ DATE HEADER> SINCE @ 263 | U< NOT IF LEVEL @ 2* SPACES CUR-MSG 2@ HEADER@ 264 | TYPER 40 TAB DATE HEADER> .DATE 55 TAB USAGE HEADER> . 265 | LENGTH HEADER> 65 TAB D. CR THEN REPEAT CR ; 266 | 267 | : DE-LINK CUR-MSG 2@ HEADER@ PARENT HEADER> OLDER HEADER> 268 | D= IF YOUNGER HEADER> 2DUP PARENT HEADER> HEADER@ DAUGHTER 269 | >HEADER HADDR! 2DUP D0= IF 2DROP ELSE HEADER@ PARENT HEADER> 270 | OLDER >HEADER HADDR! THEN 271 | ELSE YOUNGER HEADER> 2DUP OLDER HEADER> HEADER@ YOUNGER 272 | >HEADER HADDR! D0= NOT IF HADDR 2@ YOUNGER HEADER> 273 | HEADER@ OLDER >HEADER HADDR! THEN THEN ; 274 | 275 | : REMOVE FINDER CUR-MSG 2@ NEW.PTR 2! DE-LINK CR ; 276 | 277 | : MOVETO FINDER SET-LINKS CR ; 278 | 279 | \ Z80 SIO WORDS 21oct84jap 18may85jap 280 | \ MODIFIED FOR MORROW DECISION'S 8251 281 | HEX 282 | 283 | \ CREATE SIO$ 1818 , 1 , 4C04 , 5103 , EA05 , 284 | FC CONSTANT ADAT FD CONSTANT BDAT 285 | FF CONSTANT ACON FF CONSTANT BCON 286 | 287 | : SINIT ; 288 | \ SIO$ DUP 0A + SWAP DO I C@ BCON PC! LOOP ; 289 | : MSTAT 0FF PC@ ; 290 | : DCD? MSTAT 80 AND ; \ 10 BCON PC! BCON PC@ 8 AND 8 = ; 291 | 292 | \ BAUD 12C = IF 5 ELSE 7 THEN 0C PC! ; 293 | 294 | DECIMAL \ more modem/serial support 21oct84jap 295 | : GEMIT DUP (EMIT) ; 296 | : SHARE CHAT ; \ ' GKEY CFA 'KEY ! ' GEMIT CFA 'EMIT ! 297 | : TALK CR ." Use control C to exit talk mode" CR 298 | BEGIN MKEY DUP GEMIT 13 = IF 10 EMIT THEN AGAIN ; 299 | 300 | : BYE ." so long!" CR SHARE BEGIN DCD? NOT UNTIL 301 | BEGIN KEY? ABORT" BROKE" DCD? UNTIL SINIT KEY KEY 2DROP 302 | ." Welcome to Jeff's bulletin board!" CR 303 | ." type READ BBS to start, READ HELP for help" CR CR ; 304 | 305 | : HELP CR ." type READ HELP if you need help." CR ; 306 | 307 | \ limiting the trouble we get into 21oct84jap 308 | 309 | : TPEE \ this is the command to return to forth 310 | ['] (?ERROR) IS ?ERROR STOP CR TRUE ABORT" back to forth" ; 311 | 312 | CREATE CMDS 313 | ' READ , 314 | ' BROWSE , 315 | ' INDEX , 316 | ' NN , 317 | ' HELP , 318 | ' TALK , 319 | ' BYE , 320 | ' TPEE , 321 | ' ADDTO , 322 | ' SAVEIT , 323 | ' LL , 324 | ' REMOVE , 325 | ' MOVETO , 326 | 327 | 12 CONSTANT #CMDS 328 | 329 | : CMD-OK? 0 #CMDS 0 DO OVER I 2* CMDS + @ = OR LOOP ; 330 | 331 | \ limiting the trouble we get into 15MAY85JAP 332 | : GET-CMD 333 | \ DEFINED NOT ABORT" What??? " 334 | ." This word needs to be re-written. - RC 20 DEC 21 " 335 | BYE ; 336 | 337 | : RUNBBS BEGIN CR ." COMMAND? " QUERY GET-CMD 338 | CMD-OK? NOT 339 | IF ." BBS CMDS ONLY " HELP DROP ELSE EXECUTE THEN AGAIN ; 340 | 341 | : (?BBSERROR) ( adr len f -- ) 342 | IF >R >R SP0 @ SP! 343 | R> R> SPACE TYPE SPACE RUNBBS 344 | ELSE 2DROP THEN ; 345 | 346 | : SAFER ['] (?BBSERROR) IS ?ERROR START ONLY FBBS ALSO 347 | TRUE ABORT" enter TPEE to return to forth " ; 348 | -------------------------------------------------------------------------------- /pristine/FBBS2.DAT: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/RickCarlino/fbbs2/ebedde08efdae22c630cd8861445585dbd9dc71e/pristine/FBBS2.DAT -------------------------------------------------------------------------------- /pristine/FBBS2.DOC: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/RickCarlino/fbbs2/ebedde08efdae22c630cd8861445585dbd9dc71e/pristine/FBBS2.DOC -------------------------------------------------------------------------------- /pristine/FBBS2.SCR: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/RickCarlino/fbbs2/ebedde08efdae22c630cd8861445585dbd9dc71e/pristine/FBBS2.SCR -------------------------------------------------------------------------------- /pristine/README.SCR: -------------------------------------------------------------------------------- 1 | A note to F83 users from John Peters 119MAY85JAPDear F83 BBS interested person, May 15, 1985 I have gone thru the various disks and versions I have in thelibrary. The files on this disk are the best of all. The BBS was originally obtained by me from Jeff Wilson in the form of a MVP Forth disk. I sent a copy of version 0.0 to Tom Belpasso who modified it for F83 and added Virtual I/O so that the data can be in a separate file. There is a working version on the disk called FBBS1.COM. It works fine with FBBS2.DAT. However later Jeff sent me version 2.0 of FBBS. The COM file I have for that version? gives me a "bad load". That is why I have included a copy of FBBS1.COM as it is the only working version Ihave. This is on top of the old F83 1.0.0, doen not contain anyof my developement tools and requires you to reset VBLK to zero as it was originally set to 40. JP A HAND WRITTEN NOTE ENCLOSED WITH THE DISK from Tom. 15MAY85JAPHi John, Jan 12, 1985 Here is the FBBS stuff. Pack dosen't work. There is a file that contains the old FBBS.BBS messages only. To access that file. OPEN FBBS.BBS 0 IS VBLK ( Set virtual block ) START ( Reads the setup data ) NOTE: You have to be in the FBBS vocabulary to exicute the above. Good luck with it. Please send me SCRPRINT.COM, NDIR.BLK and SDIR.BLK when you get a chance. Tom Belpasso LETTER TO TOM BELPASSO 15MAY85JAPDear Tom, May 15, 1985 I am uploading what I have in the library to CL BBS as a Library so it is not dependant on you to fix what ails it. I do want you to have the latest information on it. When I compile the file FBBS2.BLK on to F83 2.1.2 it has problems. I think it might be in the area of Virtual file I/O. Currently I have tried both the VIO in the file FBBS2.BLK and the V-I/0 from EZDIR.BLK which I have in a seprate file.^ -------------------------------------------------------------------------------- /screens/screen_00.txt: -------------------------------------------------------------------------------- 1 | FORTH Bulletin Board, with data in a separate file. 15MAY85JAP 2 | You can run the BBS from your keyboard. "Screen 31 EXPERIMENT 3 | must be modified for your system to pack the data." 4 | The orginal concept execution and code is Jeff's. I started 5 | the conversion from MVP to F83, but Tom actually succeded. You 6 | may see my initials on the ID date but let me assure you it is 7 | Jeffs progrm. 8 | John Peters, F83 Disk Librarian 9 | (415) 239-5393 after 7 pm. 10 | 11 | Jeff Wilson WA2KCM Tom Belpasso 12 | 55 Bedford Ave. 852-116 Minnesota Avenue 13 | Bergenfield NJ 07621 San Jose, CA 95125 14 | (201) 384-1596 MVP version (408) 292-0352 LP F-83 version 15 | 16 | -------------------------------------------------------------------------------- /screens/screen_01.txt: -------------------------------------------------------------------------------- 1 | \ Load screen for FORTH BBS 26nov84tjb 15MAY85JAP 2 | 15 VIEWS FBBS2.BLK .( LOADING ) FILE? CR 3 | : GOODBYE BYE ; 4 | 3 4 THRU \ 5 6 THRU \ Virtual I/O 5 | 7 25 THRU 6 | S-S FBBS2.COM EXIT 7 | \ 26 36 THRU EXIT data packing ( SYSCALL is undefined JP) 8 | To begin the BBS type: INIT-BBS which is the same as below. 9 | OPEN FBBS2.DAT FBBS 0 IS VBLK and START or SAFER 10 | Safer allows only BBS commands, and protects the system from the 11 | user. Type TPEE to return to Forth. Type READ BBS to start at 12 | the trunk of the tree. READ HELP or READ COMMANDS are good too. 13 | See also: STOP PACK INPORT EXPORT REMOVE MOVETO 14 | When I compile FBBS2.BLK and start it FIND-NAME never does!, 15 | however there is a working version called FBBS1.COM on this disk 16 | that runs on top of F83 1.0.0 -------------------------------------------------------------------------------- /screens/screen_02.txt: -------------------------------------------------------------------------------- 1 | \ mods to F83-FORTH version 08dec84tjb 15MAY85JAP 2 | 3 | 1) The first block of the virtual memory is the value of the 4 | constant VBLK. Default value is 40 to allow both the source 5 | and BBS to reside in the same file to facilitate debuging. 6 | You can dedicate a seperate file for the BBS messages by 7 | changing the value of VBLK to 0. I added a double precision 8 | constant VOFF to allow greater flexablity for the virtual 9 | memory support. 10 | 2) K? is now case and control key insensitive, ie. upper, lower 11 | or control K will kill the message. The same for S to pause 12 | 3) Pack, import and export are untested and not loaded with OK. 13 | TOM 14 | P! and P@ changed to PC! and PC@ in this file. 15 | I am unable to compile a working system on F83 2.1.2 JP 16 | -------------------------------------------------------------------------------- /screens/screen_03.txt: -------------------------------------------------------------------------------- 1 | \ LIST OF WORDS KNOT KNOWN BY LP-83 2.1.0 15MAY85JAP 2 | ONLY FORTH ALSO 3 | VOCABULARY FBBS FBBS DEFINITIONS ALSO 4 | : OPENFILE [ DOS ] OPEN-FILE ; 5 | : UWORD WORD DUP COUNT UPPER ; 6 | : TEXT HERE C/L 1+ BLANK UWORD PAD C/L 1+ CMOVE ; 7 | : TAB ( n--) #OUT @ - DUP 0> IF SPACES ELSE DROP THEN ; 8 | : 2AND (S d d -- d ) 2 ROLL AND ROT ROT AND SWAP ; 9 | : 2NOT (S d -- d ) NOT SWAP NOT SWAP ; 10 | : "FBBS2.DAT" ( -- addr len ) " FBBS2.DAT" ; 11 | : OPEN-DATA ( -- ) ['] "FBBS2.DAT" IS SOURCE >IN OFF 12 | OPEN ['] (SOURCE) IS SOURCE ; 13 | : INIT-BBS OPEN-DATA START ; 14 | 15 | 16 | -------------------------------------------------------------------------------- /screens/screen_04.txt: -------------------------------------------------------------------------------- 1 | \ COMPRESSION/FORMATING ) 03dec84tjb 2 | 3 | : TY.R OVER - SPACES TYPE ; 4 | : DATE> ( mm/dd/yy -- u ) 100 UM/MOD 0 100 UM/MOD 5 | 32 * + SWAP 416 * + ; ( this is sortable) 6 | : >MDY ( U -- yy dd mm) 0 416 UM/MOD SWAP 32 /MOD ; 7 | : >DATE ( u -- mm/dd/yy) >MDY 100 * + 100 UM* ROT 0 D+ ; 8 | : .DATE ( u -- ) SPACE >DATE 9 | <# # # 47 HOLD # # 47 HOLD # # #> TYPE SPACE ; 10 | 11 | \s 12 | \ : TRUE 1 ; : FALSE 0 ; 13 | 14 | 15 | 16 | -------------------------------------------------------------------------------- /screens/screen_05.txt: -------------------------------------------------------------------------------- 1 | \ high-speed vm i/o * NOT IN USE * 03dec84tjb 15MAY85JAP 2 | \ CODE 1KU/MOD ( d -- n n ) 3 | \ D POP H POP B PUSH ( save bc we need the room ) 4 | \ H A MOV 3 ANI A B MOV L C MOV B PUSH ( REMAINDER) 5 | \ H L MOV E H MOV D E MOV 0 D MVI ( /256 ) 6 | \ STC CMC ( reset cy flag ) 7 | \ E A MOV RAR A E MOV H A MOV RAR A H MOV 8 | \ L A MOV RAR A L MOV ( D/2 ) 9 | \ STC CMC ( reset cy flag ) 10 | \ E A MOV RAR A E MOV H A MOV RAR A H MOV 11 | \ L A MOV RAR A L MOV ( D/2 ) 12 | \ D POP B POP D PUSH ( fix up stack push remainder ) 13 | \ HPUSH JMP C; ( push divident ) 14 | \ or in high level 15 | : 1KU/MOD ( d -- n n ) OVER 1023 AND ROT ROT 16 | 10 0 DO D2/ LOOP DROP ; \ dividend on top -------------------------------------------------------------------------------- /screens/screen_06.txt: -------------------------------------------------------------------------------- 1 | \ Some Vars and virtual stuff * NOT IN USE * 15MAY85JAP 2 | 2VARIABLE VDP 2VARIABLE V.PTR 3 | 0. VDP 2! 0. V.PTR 2! 4 | 0 CONSTANT VBLK VARIABLE RES 128. 2CONSTANT VOFF 5 | : V+ V.PTR DUP 2@ 1. D+ ROT 2! ; 6 | : V- V.PTR DUP 2@ -1. D+ ROT 2! ; 7 | : VADDR ( d--n) VOFF D+ 1KU/MOD VBLK + BLOCK 8 | OVER 1024 SWAP - RES ! + ; 9 | : V@ ( d--c) VADDR C@ ; 10 | : V! ( c d --) VADDR C! UPDATE ; 11 | : >V ( c --) V.PTR 2@ V! V+ ; 12 | : V> ( -- c) V.PTR 2@ V@ V+ ; 13 | : V V.PTR 2@ ; 14 | 15 | 16 | -------------------------------------------------------------------------------- /screens/screen_07.txt: -------------------------------------------------------------------------------- 1 | \ multi-char VM I/0 03dec84tjb 2 | 2VARIABLE CUR-MSG 3 | 2VARIABLE NEW.PTR 2VARIABLE SCAN-ROOT 4 | 0. CUR-MSG 2! 5 | VARIABLE TODAY 6 | CREATE DATE 2 , 0 , 7 | CREATE LENGTH 4 , 2 , 8 | CREATE PARENT 4 , 6 , 9 | CREATE YOUNGER 4 , 10 , 10 | CREATE OLDER 4 , 14 , 11 | CREATE DAUGHTER 4 , 18 , 12 | CREATE USAGE 2 , 22 , 13 | CREATE FILE-TYPE 1 , 24 , 14 | 15 | : >NAME 25. D+ ; 16 | -------------------------------------------------------------------------------- /screens/screen_08.txt: -------------------------------------------------------------------------------- 1 | \ more vm i/o 03dec84tjb 2 | 3 | CREATE HEADER 25 ALLOT 2VARIABLE HADDR 4 | 5 | : HEADER@ 2DUP HADDR 2! VADDR RES @ 25 > IF 6 | HEADER 25 CMOVE HADDR 2@ >NAME V.PTR 2! ELSE HADDR 2@ 7 | V.PTR 2! HEADER 25 + HEADER DO V> I C! LOOP THEN ; 8 | 9 | : HEADER! V.PTR 2! HEADER 25 + HEADER DO I C@ >V LOOP ; 10 | : HADDR! HADDR 2@ HEADER! ; 11 | : >HEADER DUP 2+ @ HEADER + SWAP @ DUP 4 = IF DROP 2! ELSE 12 | 2 = IF ! ELSE C! THEN THEN ; 13 | : HEADER> DUP 2+ @ HEADER + SWAP @ DUP 4 = IF DROP 2@ ELSE 14 | 2 = IF @ ELSE C@ THEN THEN ; 15 | : CLR-HEADER HEADER 25 + HEADER DO 0 I C! LOOP ; 16 | -------------------------------------------------------------------------------- /screens/screen_09.txt: -------------------------------------------------------------------------------- 1 | \ Routine to show whats in the header 03dec84tjb 2 | 3 | : HEADER? CR 4 | ." haddr: " HADDR 2@ D. CR 5 | ." date: " DATE HEADER> .DATE CR 6 | ." length: " LENGTH HEADER> D. CR 7 | ." parent: " PARENT HEADER> D. CR 8 | ." younger: " YOUNGER HEADER> D. CR 9 | ." older: " OLDER HEADER> D. CR 10 | ." daughter: " DAUGHTER HEADER> D. CR 11 | ." usage: " USAGE HEADER> U. CR 12 | ." file type: " FILE-TYPE HEADER> U. CR 13 | ." cur-msg: " CUR-MSG 2@ D. CR 14 | ." vdp: " VDP 2@ D. CR CR ; 15 | : CUR-HEAD? CUR-MSG 2@ HEADER@ HEADER? ; 16 | -------------------------------------------------------------------------------- /screens/screen_10.txt: -------------------------------------------------------------------------------- 1 | \ START STOP SET-DATE 03dec84tjb 2 | 3 | : START OPENFILE VBLK BLOCK 2@ VDP 2! 0. CUR-MSG 2! 4 | VBLK BLOCK 4 + @ TODAY ! ; 5 | 6 | 7 | : STOP VDP 2@ VBLK BLOCK 2! 8 | TODAY @ VBLK BLOCK 4 + ! UPDATE FLUSH ; 9 | 10 | : SET-DATE BEGIN CR ." system date is " TODAY @ .DATE CR 11 | ." Hit if correct, else enter new mmddyy: " 12 | QUERY BL WORD NUMBER? DROP DATE> DUP 0= IF NOT ELSE TODAY ! 13 | 0 THEN UNTIL CR ; 14 | 15 | 16 | -------------------------------------------------------------------------------- /screens/screen_11.txt: -------------------------------------------------------------------------------- 1 | \ routines used to set up the header 03dec84tjb 2 | 3 | : >DTR CUR-MSG 2@ HEADER@ DAUGHTER HEADER> CUR-MSG 2! ; 4 | 5 | : YOUNGEST \ find youngest sister of cur-msg 6 | BEGIN CUR-MSG 2@ HEADER@ YOUNGER HEADER> 2DUP D0= NOT 7 | WHILE CUR-MSG 2! REPEAT 2DROP ; 8 | 9 | 10 | : INIT-BBS 0. VDP 2! 0. CUR-MSG 2! ; 11 | 12 | 13 | 14 | 15 | 16 | -------------------------------------------------------------------------------- /screens/screen_12.txt: -------------------------------------------------------------------------------- 1 | \ header-related things 03dec84tjb 2 | 3 | 4 | : SET-LINKS NEW.PTR 2@ HEADER@ CUR-MSG 2@ PARENT >HEADER 5 | NEW.PTR 2@ HEADER! CUR-MSG 2@ HEADER@ DAUGHTER HEADER> 6 | D0= IF NEW.PTR 2@ DAUGHTER >HEADER CUR-MSG 2@ HEADER! 7 | NEW.PTR 2@ HEADER@ CUR-MSG 2@ OLDER >HEADER ELSE >DTR 8 | YOUNGEST NEW.PTR 2@ YOUNGER >HEADER HADDR! 9 | NEW.PTR 2@ HEADER@ CUR-MSG 2@ OLDER >HEADER THEN 10 | 0. YOUNGER >HEADER NEW.PTR 2@ HEADER! ; 11 | 12 | : DO-HEADER ( d --) \ set up header for new message 13 | CLR-HEADER TODAY @ DATE >HEADER 14 | VDP 2@ NEW.PTR 2@ D- LENGTH >HEADER 15 | 1 FILE-TYPE >HEADER NEW.PTR 2@ HEADER! SET-LINKS ; 16 | -------------------------------------------------------------------------------- /screens/screen_13.txt: -------------------------------------------------------------------------------- 1 | \ The LIST function (reads current message) 03dec84tjb 2 | 3 | : K? KEY? IF KEY 31 AND DUP 11 = ABORT" killed. " 19 = 4 | IF KEY DROP THEN THEN ; ( K to kill or S to pause ) 5 | \ K? is case and control independent any S or K will do 6 | : TYPER BEGIN K? V> DUP 127 AND DUP EMIT 7 | 13 = IF 10 EMIT THEN 127 > UNTIL ; 8 | 9 | : TYPE-LINE BEGIN V> DUP 127 AND DUP 13 = IF DROP 128 OR 10 | ELSE EMIT THEN 127 > UNTIL CR ; 11 | : INCU USAGE HEADER> 1+ USAGE >HEADER HADDR 2@ HEADER! ; 12 | : .HEAD CUR-MSG 2@ HEADER@ INCU CR ." PARENT: " PARENT HEADER> 13 | >NAME V.PTR 2! TYPER 40 TAB DATE HEADER> ." DATE: " .DATE 14 | CR CUR-MSG 2@ >NAME V.PTR 2! ." MESSAGE: " TYPER 15 | 40 TAB USAGE HEADER> ." USAGE: " U. CR CR ; 16 | -------------------------------------------------------------------------------- /screens/screen_14.txt: -------------------------------------------------------------------------------- 1 | \ a simple editor 03dec84tjb 2 | 2VARIABLE E.PTR 3 | : VMARK V- V> 128 OR V- >V ; 4 | 5 | : LINE>V QUERY 1 WORD COUNT DUP >R 6 | 0 ?DO DUP C@ >V 1+ LOOP 7 | DROP CR 13 >V R> ; 8 | 9 | : MNH ( Message Name Header ) 10 | VDP 2@ 2DUP NEW.PTR 2! >NAME 2DUP VADDR DROP V.PTR 2! 11 | SET-DATE ." MESSAGE NAME? " QUERY 32 UWORD COUNT 32 MIN 12 | DUP 0= ABORT" bad name" 13 | 0 DO DUP C@ >V 1+ LOOP DROP VMARK CR ; 14 | 15 | 16 | -------------------------------------------------------------------------------- /screens/screen_15.txt: -------------------------------------------------------------------------------- 1 | \ MESSEGE ENTRY RELATED STUFF 03dec84tjb 2 | 3 | 4 | : ED MNH ." Press CR twice to exit editor" CR CR 5 | BEGIN LINE>V 0= UNTIL V- VMARK V.PTR 2@ 2DUP E.PTR 2! 6 | VDP 2@ D- ." MESSAGE LENGTH: " D. ." BYTES." CR 7 | ." OPTIONS: LL SAVEIT" CR ; 8 | 9 | 10 | : LL NEW.PTR 2@ >NAME V.PTR 2! CR ." name: " TYPER CR CR 11 | TYPER CR ; 12 | : LIST LL ; 13 | : SAVEIT E.PTR 2@ VDP 2! DO-HEADER CR ; 14 | : SAVEPERMANENT SAVEIT ; 15 | : S SAVEIT ; 16 | -------------------------------------------------------------------------------- /screens/screen_16.txt: -------------------------------------------------------------------------------- 1 | \ submessage function 03dec84tjb 2 | 3 | VARIABLE SINCE 4 | 5 | : SUB-MSG CR CR CUR-MSG 2@ HEADER@ DAUGHTER HEADER> 2DUP D0= 6 | IF 2DROP ." no submessages" ELSE ." SUBMESSAGES: " CR 7 | BEGIN HEADER@ DATE HEADER> SINCE @ U< NOT IF 8 | HADDR 2@ >NAME V.PTR 2! TYPER 9 | 35 TAB DATE HEADER> .DATE CR THEN 10 | YOUNGER HEADER> 2DUP D0= UNTIL 2DROP THEN CR ; 11 | 12 | 13 | 14 | 15 | 16 | -------------------------------------------------------------------------------- /screens/screen_17.txt: -------------------------------------------------------------------------------- 1 | \ scanning the tree 03dec84tjb 2 | VARIABLE LEVEL 3 | 4 | : NEXT-MSG ( --f) CUR-MSG 2@ HEADER@ DAUGHTER HEADER> 5 | 2DUP D0= NOT IF CUR-MSG 2! 1 LEVEL +! 1 ELSE 2DROP 6 | YOUNGER HEADER> 2DUP D0= NOT IF CUR-MSG 2! 1 ELSE 2DROP BEGIN 7 | PARENT HEADER> 2DUP CUR-MSG 2! -1 LEVEL +! 2DUP SCAN-ROOT 8 | 2@ D= IF 2DROP 0 1 ELSE HEADER@ YOUNGER HEADER> 2DUP D0= NOT 9 | IF CUR-MSG 2! 1 1 ELSE 2DROP 0 THEN THEN K? UNTIL THEN THEN ; 10 | \ K? allows user to escape long searches 11 | : NN 0. SCAN-ROOT 2! NEXT-MSG IF .HEAD TYPER SUB-MSG ELSE 12 | CR ." nothing more to read" CR THEN ; 13 | 14 | : BB CUR-MSG 2@ HEADER@ OLDER HEADER> CUR-MSG 2! 15 | .HEAD TYPER SUB-MSG ; 16 | -------------------------------------------------------------------------------- /screens/screen_18.txt: -------------------------------------------------------------------------------- 1 | \ stuff for findin things by name 03dec84tjb 2 | CREATE NAME-BUF 40 ALLOT VARIABLE NAME-LEN 3 | 4 | : ?NAME BL TEXT PAD 1+ NAME-BUF 40 CMOVE 5 | NAME-BUF 40 -TRAILING DUP 0= ABORT" bad name" 6 | DUP NAME-LEN ! 1- + DUP C@ 128 OR SWAP C! 7 | BL WORD NUMBER? DROP DATE> SINCE ! ; 8 | 9 | : -NAME >NAME V.PTR 2! 1 NAME-BUF DUP NAME-LEN @ + 10 | SWAP DO I C@ V> = AND DUP 0= IF LEAVE THEN LOOP ; 11 | 12 | : FIND-NAME 0. 2DUP CUR-MSG 2! SCAN-ROOT 2! 13 | BEGIN CUR-MSG 2@ -NAME IF 0 EXIT THEN NEXT-MSG 0= UNTIL 1 ; 14 | 15 | 16 | -------------------------------------------------------------------------------- /screens/screen_19.txt: -------------------------------------------------------------------------------- 1 | \ some real stuff 03dec84tjb 2 | : FINDER ?NAME FIND-NAME IF ." <-- message not in tree." 3 | ABORT THEN CR ; : GOTO FINDER ; 4 | : READ FINDER .HEAD TYPER SUB-MSG ; 5 | : R READ ; 6 | : BROWSE FINDER .HEAD TYPE-LINE CR SUB-MSG ; 7 | 8 | : ADDTO FINDER ED ; 9 | 10 | : INDEX FINDER CUR-MSG 2@ 2DUP SCAN-ROOT 2! HEADER@ 0 LEVEL ! 11 | DAUGHTER HEADER> D0= ABORT" nothing to index" 12 | BEGIN NEXT-MSG WHILE CUR-MSG 2@ HEADER@ DATE HEADER> SINCE @ 13 | U< NOT IF LEVEL @ 2* SPACES CUR-MSG 2@ HEADER@ 14 | TYPER 40 TAB DATE HEADER> .DATE 55 TAB USAGE HEADER> . 15 | LENGTH HEADER> 65 TAB D. CR THEN REPEAT CR ; 16 | -------------------------------------------------------------------------------- /screens/screen_20.txt: -------------------------------------------------------------------------------- 1 | \ start of file maintainence 03dec84tjb 2 | 3 | : DE-LINK CUR-MSG 2@ HEADER@ PARENT HEADER> OLDER HEADER> 4 | D= IF YOUNGER HEADER> 2DUP PARENT HEADER> HEADER@ DAUGHTER 5 | >HEADER HADDR! 2DUP D0= IF 2DROP ELSE HEADER@ PARENT HEADER> 6 | OLDER >HEADER HADDR! THEN 7 | ELSE YOUNGER HEADER> 2DUP OLDER HEADER> HEADER@ YOUNGER 8 | >HEADER HADDR! D0= NOT IF HADDR 2@ YOUNGER HEADER> 9 | HEADER@ OLDER >HEADER HADDR! THEN THEN ; 10 | 11 | 12 | 13 | 14 | 15 | 16 | -------------------------------------------------------------------------------- /screens/screen_21.txt: -------------------------------------------------------------------------------- 1 | \ more file maintanence 03dec84tjb 2 | 3 | : REMOVE FINDER CUR-MSG 2@ NEW.PTR 2! DE-LINK CR ; 4 | 5 | : MOVETO FINDER SET-LINKS CR ; 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | -------------------------------------------------------------------------------- /screens/screen_22.txt: -------------------------------------------------------------------------------- 1 | \ Z80 SIO WORDS 21oct84jap 18may85jap 2 | \ MODIFIED FOR MORROW DECISION'S 8251 3 | HEX 4 | 5 | \ CREATE SIO$ 1818 , 1 , 4C04 , 5103 , EA05 , 6 | FC CONSTANT ADAT FD CONSTANT BDAT 7 | FF CONSTANT ACON FF CONSTANT BCON 8 | 9 | : SINIT ; 10 | \ SIO$ DUP 0A + SWAP DO I C@ BCON PC! LOOP ; 11 | : MSTAT 0FF PC@ ; 12 | : DCD? MSTAT 80 AND ; \ 10 BCON PC! BCON PC@ 8 AND 8 = ; 13 | 14 | \ BAUD 12C = IF 5 ELSE 7 THEN 0C PC! ; 15 | 16 | DECIMAL -------------------------------------------------------------------------------- /screens/screen_23.txt: -------------------------------------------------------------------------------- 1 | \ more modem/serial support 21oct84jap 2 | : GEMIT DUP (EMIT) ; 3 | : SHARE CHAT ; \ ' GKEY CFA 'KEY ! ' GEMIT CFA 'EMIT ! 4 | : TALK CR ." Use control C to exit talk mode" CR 5 | BEGIN MKEY DUP GEMIT 13 = IF 10 EMIT THEN AGAIN ; 6 | 7 | : BYE ." so long!" CR SHARE BEGIN DCD? NOT UNTIL 8 | BEGIN KEY? ABORT" BROKE" DCD? UNTIL SINIT KEY KEY 2DROP 9 | ." Welcome to Jeff's bulletin board!" CR 10 | ." type READ BBS to start, READ HELP for help" CR CR ; 11 | 12 | : HELP CR ." type READ HELP if you need help." CR ; 13 | 14 | 15 | 16 | -------------------------------------------------------------------------------- /screens/screen_24.txt: -------------------------------------------------------------------------------- 1 | \ limiting the trouble we get into 21oct84jap 2 | 3 | : TPEE \ this is the command to return to forth 4 | ['] (?ERROR) IS ?ERROR STOP CR TRUE ABORT" back to forth" ; 5 | 6 | CREATE CMDS ' READ , ' BROWSE , ' INDEX , ' NN , ' HELP , 7 | ' TALK , ' BYE , 8 | ' TPEE , ' ADDTO , ' SAVEIT , ' LL , ' REMOVE , 9 | ' MOVETO , 10 | 12 CONSTANT #CMDS 11 | 12 | : CMD-OK? 0 #CMDS 0 DO OVER I 2* CMDS + @ = OR LOOP ; 13 | 14 | 15 | 16 | -------------------------------------------------------------------------------- /screens/screen_25.txt: -------------------------------------------------------------------------------- 1 | \ limiting the trouble we get into 15MAY85JAP 2 | : GET-CMD 3 | DEFINED NOT ABORT" What??? " ; 4 | 5 | : RUNBBS BEGIN CR ." COMMAND? " QUERY GET-CMD 6 | CMD-OK? NOT 7 | IF ." BBS CMDS ONLY " HELP DROP ELSE EXECUTE THEN AGAIN ; 8 | 9 | : (?BBSERROR) (S adr len f -- ) 10 | IF >R >R SP0 @ SP! 11 | R> R> SPACE TYPE SPACE RUNBBS 12 | ELSE 2DROP THEN ; 13 | 14 | : SAFER ['] (?BBSERROR) IS ?ERROR START ONLY FBBS ALSO 15 | TRUE ABORT" enter TPEE to return to forth " ; 16 | \S **** End of the first part of the BBS, less File maintenance. -------------------------------------------------------------------------------- /screens/screen_26.txt: -------------------------------------------------------------------------------- 1 | \ words used by PACK 03dec84tjb 2 | 2VARIABLE T.BASE 2VARIABLE T.PTR VARIABLE #MSGS 3 | 4 | : T.PTR+ T.PTR 2@ 4. D+ T.PTR 2! ; 5 | : >TABLE T.PTR 2@ VADDR 2! UPDATE T.PTR+ ; 6 | : TABLE> T.PTR 2@ VADDR 2@ T.PTR+ ; 7 | 8 | : MAKE-TABLE VDP 2@ 8. D+ 7. 2NOT 2AND 2DUP 9 | T.BASE 2! T.PTR 2! 0. CUR-MSG 2! 0 #MSGS ! 10 | BEGIN CUR-MSG 2@ 2DUP >TABLE >TABLE 1 #MSGS +! 11 | NEXT-MSG 0= UNTIL -1. >TABLE -1. >TABLE 12 | CR #MSGS @ . ." messages in tree" CR ; 13 | 14 | : IN-TBL? T.BASE 2@ T.PTR 2! BEGIN 2DUP TABLE> D= NOT 15 | WHILE TABLE> 0. D< IF 0 EXIT THEN REPEAT 1 ; 16 | \ syntax = ( d -- d f) -------------------------------------------------------------------------------- /screens/screen_27.txt: -------------------------------------------------------------------------------- 1 | \ more words for pack 03dec84tjb 2 | 3 | : FIND-LINK IN-TBL? 0= IF ." WARNING! bad link: " D. CR 4 | 0. 2SWAP THEN 2DROP ; 5 | : SET-NEW ( old, new--) 2SWAP FIND-LINK >TABLE ; 6 | 7 | : NEW-LINK ( old -- new) FIND-LINK TABLE> ; 8 | 9 | 10 | : NEW-LINKS ( d --) HEADER@ 11 | PARENT HEADER> NEW-LINK PARENT >HEADER 12 | DAUGHTER HEADER> NEW-LINK DAUGHTER >HEADER 13 | YOUNGER HEADER> NEW-LINK YOUNGER >HEADER 14 | OLDER HEADER> NEW-LINK OLDER >HEADER HADDR! ; 15 | 16 | -------------------------------------------------------------------------------- /screens/screen_28.txt: -------------------------------------------------------------------------------- 1 | \ more words for pack 03dec84tjb 2 | 2VARIABLE SRC.PTR 2VARIABLE DES.PTR 3 | 4 | : >DES DES.PTR 2@ V! DES.PTR DUP 2@ 1. D+ ROT 2! ; 5 | : SRC+ SRC.PTR DUP 2@ LENGTH HEADER> D+ ROT 2! ; 6 | : >>DES ( d.src d.cnt ) 7 | BEGIN 2DUP 0. D> WHILE 2SWAP 2DUP 8 | V@ >DES 1. D+ 2SWAP 1. D- REPEAT 2DROP 2DROP ; 9 | 10 | : SQUISH 0. HEADER@ LENGTH HEADER> 2DUP SRC.PTR 2! 11 | DES.PTR 2! #MSGS @ 1 DO 42 EMIT 12 | SRC.PTR 2@ BEGIN 2DUP HEADER@ IN-TBL? 0= WHILE 45 EMIT 13 | LENGTH HEADER> 2+ REPEAT SRC.PTR 2! DES.PTR 2@ >TABLE 14 | CR SRC.PTR 2@ D. DES.PTR 2@ D. 15 | SRC.PTR 2@ LENGTH HEADER> >>DES SRC+ LOOP DES.PTR 2@ VDP 2! ; 16 | -------------------------------------------------------------------------------- /screens/screen_29.txt: -------------------------------------------------------------------------------- 1 | \ PACK 03dec84tjb 2 | 3 | : RE-LINK #MSGS @ 0 DO I 8 UM* T.BASE 2@ D+ 4. D+ VADDR 2@ 4 | NEW-LINKS LOOP ; 5 | 6 | : PACK CR ." are you sure? " KEY 89 = NOT ABORT" pack aborted." 7 | CR ." making link table" MAKE-TABLE 8 | CR ." squishing the tree" CR SQUISH 9 | CR ." reseting links" RE-LINK 10 | CR ." all done!" CR ; 11 | 12 | : .TABLE CR #MSGS @ 0 DO I 8 UM* T.BASE 2@ D+ VADDR 13 | DUP 2@ D. 4 + 2@ D. CR LOOP CR ; 14 | 15 | 16 | -------------------------------------------------------------------------------- /screens/screen_30.txt: -------------------------------------------------------------------------------- 1 | \ file i/o to cp/m 2 | 3 | CREATE SECBUF 128 ALLOT VARIABLE DCNT 4 | 5 | : ?FILE ?NAME PAD 33 0 FILL PAD 1+ 11 BLANK 6 | NAME-LEN @ 0 DO I NAME-BUF + C@ 127 AND I PAD + 1+ C! LOOP ; 7 | 8 | : READ-FILE ?FILE 15 PAD SYSCALL 4 > ABORT" file not found" ; 9 | 10 | : READIT CR BEGIN 26 SECBUF SYSCALL DROP 20 PAD SYSCALL 0= 11 | WHILE SECBUF 128 + SECBUF DO I C@ DUP 26 = 12 | IF DROP CR ." EOF" LEAVE ELSE EMIT THEN LOOP REPEAT ; 13 | 14 | : READF READ-FILE READIT ; 15 | 16 | -------------------------------------------------------------------------------- /screens/screen_31.txt: -------------------------------------------------------------------------------- 1 | \ file i/o to cp/m 03dec84tjb 2 | 3 | 4 | : IMPORT READ-FILE MNH 5 | BEGIN 26 SECBUF SYSCALL DROP 6 | 20 PAD SYSCALL 0= WHILE 128 0 DO SECBUF I + C@ 7 | 127 AND DUP 10 = IF DROP ELSE DUP 26 = IF DROP LEAVE ELSE 8 | >V THEN THEN LOOP REPEAT VMARK V.PTR 2@ E.PTR 2! CR ; 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | -------------------------------------------------------------------------------- /screens/screen_32.txt: -------------------------------------------------------------------------------- 1 | \ file i/o to cp/m 03dec84tjb 2 | 3 | : WR-SEC 26 SECBUF SYSCALL DROP 21 PAD SYSCALL 0= 4 | NOT ABORT" ERROR: disk full" ; 5 | 6 | : >DISK DCNT @ DUP 128 U< IF SECBUF + C! 1 DCNT +! ELSE 7 | DROP 0 DCNT ! WR-SEC SECBUF 128 26 FILL THEN ; 8 | 9 | : EXPORT 13 0 SYSCALL DROP 14 0 SYSCALL DROP ?FILE 10 | 22 PAD SYSCALL 4 > ABORT" disk directory full" 11 | CUR-MSG 2@ >NAME V.PTR 2! ." exporting " TYPER CR 12 | 0 DCNT ! BEGIN V> DUP 127 AND DUP 13 = IF 10 >DISK THEN 13 | >DISK 127 > UNTIL WR-SEC 16 PAD SYSCALL DROP ; 14 | 15 | 16 | -------------------------------------------------------------------------------- /screens/screen_33.txt: -------------------------------------------------------------------------------- 1 | \ back pointer fixer upper 03dec84tjb 2 | 3 | 4 | : FIX-DTRS CUR-MSG 2@ 2DUP HEADER@ DAUGHTER HEADER> BEGIN 5 | 2DUP D0= NOT WHILE HEADER@ OLDER >HEADER HADDR! HADDR 2@ 6 | YOUNGER HEADER> REPEAT 2DROP 2DROP ; 7 | 8 | : FIX-BACK 0. 2DUP CUR-MSG 2! SCAN-ROOT 2! BEGIN 9 | FIX-DTRS NEXT-MSG 0= UNTIL CR ; 10 | 11 | : LIST-PHYS CR 0. CUR-MSG 2! BEGIN CUR-MSG 2@ VDP 2@ D= 12 | NOT WHILE CUR-MSG 2@ 2DUP HEADER@ TYPER 35 TAB D. 50 TAB 13 | LENGTH HEADER> 2DUP D. CR 14 | CUR-MSG 2@ D+ CUR-MSG 2! REPEAT ; 15 | 16 | -------------------------------------------------------------------------------- /screens/screen_34.txt: -------------------------------------------------------------------------------- 1 | \ MESSAGE MOVING WORDS 2 | 3 | : TYPE>V (S addr -- | puts memory into virtual ) 4 | BEGIN DUP C@ DUP EMIT DUP >V DUP > 128 SWAP 0= OR 5 | SWAP 1+ SWAP 6 | UNTIL DROP ; 7 | 8 | : MED MNH ." Enter address of existing message " CR CR 9 | QUERY INTERPRET TYPE>V V- VMARK V.PTR D@ DDUP E.PTR D! 10 | VDP D@ D- ." MESSAGE LENGTH: " D. ." BYTES." CR 11 | ." OPTIONS: LL SAVEIT" CR ; 12 | 13 | 14 | 15 | 16 | -------------------------------------------------------------------------------- /screens/screen_35.txt: -------------------------------------------------------------------------------- 1 | \ BBS TOOLS 17oct84jap 2 | 3 | : CUR? CUR-HEAD? ; 4 | : NPAR PARENT >HEADER ; 5 | : NYOUNG YOUNGER >HEADER ; 6 | : NKID DAUGHTER >HEADER ; 7 | : UNUSED 0 USAGE >HEADER ; 8 | : NOLDER OLDER >HEADER ; 9 | : CUR! CUR-MSG D@ HEADER! ; 10 | 11 | 12 | 13 | 14 | 15 | 16 | -------------------------------------------------------------------------------- /screens/screen_36.txt: -------------------------------------------------------------------------------- 1 | \ MESSAGE MOVING WORDS 2 | 3 | : TYPE>V (S addr -- | puts memory into virtual ) 4 | BEGIN DUP C@ DUP EMIT DUP >V DUP > 128 SWAP 0= OR 5 | SWAP 1+ SWAP 6 | UNTIL DROP ; 7 | 8 | : MED MNH ." Enter address of existing message " CR CR 9 | QUERY INTERPRET TYPE>V V- VMARK V.PTR D@ DDUP E.PTR D! 10 | VDP D@ D- ." MESSAGE LENGTH: " D. ." BYTES." CR 11 | ." OPTIONS: LL SAVEIT" CR ; 12 | 13 | 14 | 15 | 16 | -------------------------------------------------------------------------------- /screens/screen_37.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/RickCarlino/fbbs2/ebedde08efdae22c630cd8861445585dbd9dc71e/screens/screen_37.txt -------------------------------------------------------------------------------- /screens/screen_38.txt: -------------------------------------------------------------------------------- 1 | \ start of file maintainence 03dec84tjb 2 | 3 | : DE-LINK CUR-MSG 2@ HEADER@ PARENT HEADER> OLDER HEADER> 4 | D= IF YOUNGER HEADER> 2DUP PARENT HEADER> HEADER@ DAUGHTER 5 | >HEADER HADDR! 2DUP D0= IF 2DROP ELSE HEADER@ PARENT HEADER> 6 | OLDER >HEADER HADDR! THEN 7 | ELSE YOUNGER HEADER> 2DUP OLDER HEADER> HEADER@ YOUNGER 8 | >HEADER HADDR! D0= NOT IF HADDR 2@ YOUNGER HEADER> 9 | HEADER@ OLDER >HEADER HADDR! THEN THEN ; 10 | 11 | 12 | 13 | 14 | 15 | 16 | -------------------------------------------------------------------------------- /screens/screen_39.txt: -------------------------------------------------------------------------------- 1 | \ more file maintanence 03dec84tjb 2 | 3 | : REMOVE FINDER CUR-MSG 2@ NEW.PTR 2! DE-LINK CR ; 4 | 5 | : MOVETO FINDER SET-LINKS CR ; 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | -------------------------------------------------------------------------------- /screens/screen_40.txt: -------------------------------------------------------------------------------- 1 | FORTH Bulitin Board System (FBBS) 15JAN85JAP 15MAY85JAP 2 | I can't get it to compile of F83 2.1.2 (See FBBS1.COM it works) 3 | 4 | Screen 2 is ideas, 3 is patches to F83 to match M.V.P. Forth. 5 | 4-25 is code for basic BBS 26-36 file handling stuff(untested) 6 | Data in the tree is now in a separate file. You can run FBBS2 7 | .COM from your keyboard. Screen 31 must be modified for your 8 | system. To allow for a larger BBS, change construct VBLK to 0 9 | and use a new file. The BBS is in a seperate vocabulary, FBBS. 10 | To begin the BBS type: 11 | FBBS 0 IS VBLK and START or SAFER 12 | SAFER allows only BBS commands, and protects the system from the 13 | user. Type TPEE to return to FORTH. Type READ BBS to start. 14 | READ HELP or READ COMMANDS are good too. 15 | 16 | -------------------------------------------------------------------------------- /screens/screen_41.txt: -------------------------------------------------------------------------------- 1 | \ Load screen for FORTH BBS 26nov84tjb 15MAY85JAP 2 | 15 VIEWS BBS2.BLK .( LOADING ) FILE? CR 3 | 3 4 THRU \ 5 6 THRU ( Virtual I/O ) 4 | 7 25 THRU ( 0 IS VBLK ) 5 | S-S BBS2.COM EXIT 6 | 26 36 THRU EXIT data packing ( SYSCALL is undefined JP) 7 | Type OPEN BBS2.DAT 0 IS VBLK and START or SAFER 8 | The orginal concept execution and code is Jeff's baby. 9 | I started the conversion to F83, but Tom actually succeded. 10 | You will see my initials on the ID date but let me assure you it 11 | is Jeffs progrm. John Peters, F83 Disk Librarian 12 | (415) 239-5393 after 7 pm. 13 | Jeff Wilson WA2KCM Tom Belpasso 14 | 55 Bedford Ave. 852-116 Minnesota Avenue 15 | Bergenfield NJ 07621 San Jose, CA 95125 16 | (201) 384-1596 MVP version (408) 292-0352 LP F-83 version -------------------------------------------------------------------------------- /screens/screen_42.txt: -------------------------------------------------------------------------------- 1 | 15MAY85JAP 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | -------------------------------------------------------------------------------- /screens/screen_43.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/RickCarlino/fbbs2/ebedde08efdae22c630cd8861445585dbd9dc71e/screens/screen_43.txt -------------------------------------------------------------------------------- /screens/screens_all.fth: -------------------------------------------------------------------------------- 1 | FORTH Bulletin Board, with data in a separate file. 15MAY85JAP 2 | You can run the BBS from your keyboard. "Screen 31 EXPERIMENT 3 | must be modified for your system to pack the data." 4 | The orginal concept execution and code is Jeff's. I started 5 | the conversion from MVP to F83, but Tom actually succeded. You 6 | may see my initials on the ID date but let me assure you it is 7 | Jeffs progrm. 8 | John Peters, F83 Disk Librarian 9 | (415) 239-5393 after 7 pm. 10 | 11 | Jeff Wilson WA2KCM Tom Belpasso 12 | 55 Bedford Ave. 852-116 Minnesota Avenue 13 | Bergenfield NJ 07621 San Jose, CA 95125 14 | (201) 384-1596 MVP version (408) 292-0352 LP F-83 version 15 | 16 | \ Load screen for FORTH BBS 26nov84tjb 15MAY85JAP 17 | 15 VIEWS FBBS2.BLK .( LOADING ) FILE? CR 18 | : GOODBYE BYE ; 19 | 3 4 THRU \ 5 6 THRU \ Virtual I/O 20 | 7 25 THRU 21 | S-S FBBS2.COM EXIT 22 | \ 26 36 THRU EXIT data packing ( SYSCALL is undefined JP) 23 | To begin the BBS type: INIT-BBS which is the same as below. 24 | OPEN FBBS2.DAT FBBS 0 IS VBLK and START or SAFER 25 | Safer allows only BBS commands, and protects the system from the 26 | user. Type TPEE to return to Forth. Type READ BBS to start at 27 | the trunk of the tree. READ HELP or READ COMMANDS are good too. 28 | See also: STOP PACK INPORT EXPORT REMOVE MOVETO 29 | When I compile FBBS2.BLK and start it FIND-NAME never does!, 30 | however there is a working version called FBBS1.COM on this disk 31 | that runs on top of F83 1.0.0 32 | \ mods to F83-FORTH version 08dec84tjb 15MAY85JAP 33 | 34 | 1) The first block of the virtual memory is the value of the 35 | constant VBLK. Default value is 40 to allow both the source 36 | and BBS to reside in the same file to facilitate debuging. 37 | You can dedicate a seperate file for the BBS messages by 38 | changing the value of VBLK to 0. I added a double precision 39 | constant VOFF to allow greater flexablity for the virtual 40 | memory support. 41 | 2) K? is now case and control key insensitive, ie. upper, lower 42 | or control K will kill the message. The same for S to pause 43 | 3) Pack, import and export are untested and not loaded with OK. 44 | TOM 45 | P! and P@ changed to PC! and PC@ in this file. 46 | I am unable to compile a working system on F83 2.1.2 JP 47 | 48 | \ LIST OF WORDS KNOT KNOWN BY LP-83 2.1.0 15MAY85JAP 49 | ONLY FORTH ALSO 50 | VOCABULARY FBBS FBBS DEFINITIONS ALSO 51 | : OPENFILE [ DOS ] OPEN-FILE ; 52 | : UWORD WORD DUP COUNT UPPER ; 53 | : TEXT HERE C/L 1+ BLANK UWORD PAD C/L 1+ CMOVE ; 54 | : TAB ( n--) #OUT @ - DUP 0> IF SPACES ELSE DROP THEN ; 55 | : 2AND (S d d -- d ) 2 ROLL AND ROT ROT AND SWAP ; 56 | : 2NOT (S d -- d ) NOT SWAP NOT SWAP ; 57 | : "FBBS2.DAT" ( -- addr len ) " FBBS2.DAT" ; 58 | : OPEN-DATA ( -- ) ['] "FBBS2.DAT" IS SOURCE >IN OFF 59 | OPEN ['] (SOURCE) IS SOURCE ; 60 | : INIT-BBS OPEN-DATA START ; 61 | 62 | \ COMPRESSION/FORMATING ) 03dec84tjb 63 | 64 | : TY.R OVER - SPACES TYPE ; 65 | : DATE> ( mm/dd/yy -- u ) 100 UM/MOD 0 100 UM/MOD 66 | 32 * + SWAP 416 * + ; ( this is sortable) 67 | : >MDY ( U -- yy dd mm) 0 416 UM/MOD SWAP 32 /MOD ; 68 | : >DATE ( u -- mm/dd/yy) >MDY 100 * + 100 UM* ROT 0 D+ ; 69 | : .DATE ( u -- ) SPACE >DATE 70 | <# # # 47 HOLD # # 47 HOLD # # #> TYPE SPACE ; 71 | 72 | \s 73 | \ : TRUE 1 ; : FALSE 0 ; 74 | 75 | \ high-speed vm i/o * NOT IN USE * 03dec84tjb 15MAY85JAP 76 | \ CODE 1KU/MOD ( d -- n n ) 77 | \ D POP H POP B PUSH ( save bc we need the room ) 78 | \ H A MOV 3 ANI A B MOV L C MOV B PUSH ( REMAINDER) 79 | \ H L MOV E H MOV D E MOV 0 D MVI ( /256 ) 80 | \ STC CMC ( reset cy flag ) 81 | \ E A MOV RAR A E MOV H A MOV RAR A H MOV 82 | \ L A MOV RAR A L MOV ( D/2 ) 83 | \ STC CMC ( reset cy flag ) 84 | \ E A MOV RAR A E MOV H A MOV RAR A H MOV 85 | \ L A MOV RAR A L MOV ( D/2 ) 86 | \ D POP B POP D PUSH ( fix up stack push remainder ) 87 | \ HPUSH JMP C; ( push divident ) 88 | \ or in high level 89 | : 1KU/MOD ( d -- n n ) OVER 1023 AND ROT ROT 90 | 10 0 DO D2/ LOOP DROP ; \ dividend on top 91 | \ Some Vars and virtual stuff * NOT IN USE * 15MAY85JAP 92 | 2VARIABLE VDP 2VARIABLE V.PTR 93 | 0. VDP 2! 0. V.PTR 2! 94 | 0 CONSTANT VBLK VARIABLE RES 128. 2CONSTANT VOFF 95 | : V+ V.PTR DUP 2@ 1. D+ ROT 2! ; 96 | : V- V.PTR DUP 2@ -1. D+ ROT 2! ; 97 | : VADDR ( d--n) VOFF D+ 1KU/MOD VBLK + BLOCK 98 | OVER 1024 SWAP - RES ! + ; 99 | : V@ ( d--c) VADDR C@ ; 100 | : V! ( c d --) VADDR C! UPDATE ; 101 | : >V ( c --) V.PTR 2@ V! V+ ; 102 | : V> ( -- c) V.PTR 2@ V@ V+ ; 103 | : V V.PTR 2@ ; 104 | 105 | \ multi-char VM I/0 03dec84tjb 106 | 2VARIABLE CUR-MSG 107 | 2VARIABLE NEW.PTR 2VARIABLE SCAN-ROOT 108 | 0. CUR-MSG 2! 109 | VARIABLE TODAY 110 | CREATE DATE 2 , 0 , 111 | CREATE LENGTH 4 , 2 , 112 | CREATE PARENT 4 , 6 , 113 | CREATE YOUNGER 4 , 10 , 114 | CREATE OLDER 4 , 14 , 115 | CREATE DAUGHTER 4 , 18 , 116 | CREATE USAGE 2 , 22 , 117 | CREATE FILE-TYPE 1 , 24 , 118 | 119 | : >NAME 25. D+ ; 120 | 121 | \ more vm i/o 03dec84tjb 122 | 123 | CREATE HEADER 25 ALLOT 2VARIABLE HADDR 124 | 125 | : HEADER@ 2DUP HADDR 2! VADDR RES @ 25 > IF 126 | HEADER 25 CMOVE HADDR 2@ >NAME V.PTR 2! ELSE HADDR 2@ 127 | V.PTR 2! HEADER 25 + HEADER DO V> I C! LOOP THEN ; 128 | 129 | : HEADER! V.PTR 2! HEADER 25 + HEADER DO I C@ >V LOOP ; 130 | : HADDR! HADDR 2@ HEADER! ; 131 | : >HEADER DUP 2+ @ HEADER + SWAP @ DUP 4 = IF DROP 2! ELSE 132 | 2 = IF ! ELSE C! THEN THEN ; 133 | : HEADER> DUP 2+ @ HEADER + SWAP @ DUP 4 = IF DROP 2@ ELSE 134 | 2 = IF @ ELSE C@ THEN THEN ; 135 | : CLR-HEADER HEADER 25 + HEADER DO 0 I C! LOOP ; 136 | 137 | \ Routine to show whats in the header 03dec84tjb 138 | 139 | : HEADER? CR 140 | ." haddr: " HADDR 2@ D. CR 141 | ." date: " DATE HEADER> .DATE CR 142 | ." length: " LENGTH HEADER> D. CR 143 | ." parent: " PARENT HEADER> D. CR 144 | ." younger: " YOUNGER HEADER> D. CR 145 | ." older: " OLDER HEADER> D. CR 146 | ." daughter: " DAUGHTER HEADER> D. CR 147 | ." usage: " USAGE HEADER> U. CR 148 | ." file type: " FILE-TYPE HEADER> U. CR 149 | ." cur-msg: " CUR-MSG 2@ D. CR 150 | ." vdp: " VDP 2@ D. CR CR ; 151 | : CUR-HEAD? CUR-MSG 2@ HEADER@ HEADER? ; 152 | 153 | \ START STOP SET-DATE 03dec84tjb 154 | 155 | : START OPENFILE VBLK BLOCK 2@ VDP 2! 0. CUR-MSG 2! 156 | VBLK BLOCK 4 + @ TODAY ! ; 157 | 158 | : STOP VDP 2@ VBLK BLOCK 2! 159 | TODAY @ VBLK BLOCK 4 + ! UPDATE FLUSH ; 160 | 161 | : SET-DATE BEGIN CR ." system date is " TODAY @ .DATE CR 162 | ." Hit if correct, else enter new mmddyy: " 163 | QUERY BL WORD NUMBER? DROP DATE> DUP 0= IF NOT ELSE TODAY ! 164 | 0 THEN UNTIL CR ; 165 | 166 | 167 | \ routines used to set up the header 03dec84tjb 168 | 169 | : >DTR CUR-MSG 2@ HEADER@ DAUGHTER HEADER> CUR-MSG 2! ; 170 | 171 | : YOUNGEST \ find youngest sister of cur-msg 172 | BEGIN CUR-MSG 2@ HEADER@ YOUNGER HEADER> 2DUP D0= NOT 173 | WHILE CUR-MSG 2! REPEAT 2DROP ; 174 | 175 | : INIT-BBS 0. VDP 2! 0. CUR-MSG 2! ; 176 | 177 | \ header-related things 03dec84tjb 178 | 179 | : SET-LINKS NEW.PTR 2@ HEADER@ CUR-MSG 2@ PARENT >HEADER 180 | NEW.PTR 2@ HEADER! CUR-MSG 2@ HEADER@ DAUGHTER HEADER> 181 | D0= IF NEW.PTR 2@ DAUGHTER >HEADER CUR-MSG 2@ HEADER! 182 | NEW.PTR 2@ HEADER@ CUR-MSG 2@ OLDER >HEADER ELSE >DTR 183 | YOUNGEST NEW.PTR 2@ YOUNGER >HEADER HADDR! 184 | NEW.PTR 2@ HEADER@ CUR-MSG 2@ OLDER >HEADER THEN 185 | 0. YOUNGER >HEADER NEW.PTR 2@ HEADER! ; 186 | 187 | : DO-HEADER ( d --) \ set up header for new message 188 | CLR-HEADER TODAY @ DATE >HEADER 189 | VDP 2@ NEW.PTR 2@ D- LENGTH >HEADER 190 | 1 FILE-TYPE >HEADER NEW.PTR 2@ HEADER! SET-LINKS ; 191 | 192 | \ The LIST function (reads current message) 03dec84tjb 193 | 194 | : K? KEY? IF KEY 31 AND DUP 11 = ABORT" killed. " 19 = 195 | IF KEY DROP THEN THEN ; ( K to kill or S to pause ) 196 | \ K? is case and control independent any S or K will do 197 | : TYPER BEGIN K? V> DUP 127 AND DUP EMIT 198 | 13 = IF 10 EMIT THEN 127 > UNTIL ; 199 | 200 | : TYPE-LINE BEGIN V> DUP 127 AND DUP 13 = IF DROP 128 OR 201 | ELSE EMIT THEN 127 > UNTIL CR ; 202 | : INCU USAGE HEADER> 1+ USAGE >HEADER HADDR 2@ HEADER! ; 203 | : .HEAD CUR-MSG 2@ HEADER@ INCU CR ." PARENT: " PARENT HEADER> 204 | >NAME V.PTR 2! TYPER 40 TAB DATE HEADER> ." DATE: " .DATE 205 | CR CUR-MSG 2@ >NAME V.PTR 2! ." MESSAGE: " TYPER 206 | 40 TAB USAGE HEADER> ." USAGE: " U. CR CR ; 207 | 208 | \ a simple editor 03dec84tjb 209 | 2VARIABLE E.PTR 210 | : VMARK V- V> 128 OR V- >V ; 211 | 212 | : LINE>V QUERY 1 WORD COUNT DUP >R 213 | 0 ?DO DUP C@ >V 1+ LOOP 214 | DROP CR 13 >V R> ; 215 | 216 | : MNH ( Message Name Header ) 217 | VDP 2@ 2DUP NEW.PTR 2! >NAME 2DUP VADDR DROP V.PTR 2! 218 | SET-DATE ." MESSAGE NAME? " QUERY 32 UWORD COUNT 32 MIN 219 | DUP 0= ABORT" bad name" 220 | 0 DO DUP C@ >V 1+ LOOP DROP VMARK CR ; 221 | 222 | 223 | \ MESSEGE ENTRY RELATED STUFF 03dec84tjb 224 | 225 | : ED MNH ." Press CR twice to exit editor" CR CR 226 | BEGIN LINE>V 0= UNTIL V- VMARK V.PTR 2@ 2DUP E.PTR 2! 227 | VDP 2@ D- ." MESSAGE LENGTH: " D. ." BYTES." CR 228 | ." OPTIONS: LL SAVEIT" CR ; 229 | 230 | : LL NEW.PTR 2@ >NAME V.PTR 2! CR ." name: " TYPER CR CR 231 | TYPER CR ; 232 | : LIST LL ; 233 | : SAVEIT E.PTR 2@ VDP 2! DO-HEADER CR ; 234 | : SAVEPERMANENT SAVEIT ; 235 | : S SAVEIT ; 236 | 237 | \ submessage function 03dec84tjb 238 | 239 | VARIABLE SINCE 240 | 241 | : SUB-MSG CR CR CUR-MSG 2@ HEADER@ DAUGHTER HEADER> 2DUP D0= 242 | IF 2DROP ." no submessages" ELSE ." SUBMESSAGES: " CR 243 | BEGIN HEADER@ DATE HEADER> SINCE @ U< NOT IF 244 | HADDR 2@ >NAME V.PTR 2! TYPER 245 | 35 TAB DATE HEADER> .DATE CR THEN 246 | YOUNGER HEADER> 2DUP D0= UNTIL 2DROP THEN CR ; 247 | 248 | \ scanning the tree 03dec84tjb 249 | VARIABLE LEVEL 250 | 251 | : NEXT-MSG ( --f) CUR-MSG 2@ HEADER@ DAUGHTER HEADER> 252 | 2DUP D0= NOT IF CUR-MSG 2! 1 LEVEL +! 1 ELSE 2DROP 253 | YOUNGER HEADER> 2DUP D0= NOT IF CUR-MSG 2! 1 ELSE 2DROP BEGIN 254 | PARENT HEADER> 2DUP CUR-MSG 2! -1 LEVEL +! 2DUP SCAN-ROOT 255 | 2@ D= IF 2DROP 0 1 ELSE HEADER@ YOUNGER HEADER> 2DUP D0= NOT 256 | IF CUR-MSG 2! 1 1 ELSE 2DROP 0 THEN THEN K? UNTIL THEN THEN ; 257 | \ K? allows user to escape long searches 258 | : NN 0. SCAN-ROOT 2! NEXT-MSG IF .HEAD TYPER SUB-MSG ELSE 259 | CR ." nothing more to read" CR THEN ; 260 | 261 | : BB CUR-MSG 2@ HEADER@ OLDER HEADER> CUR-MSG 2! 262 | .HEAD TYPER SUB-MSG ; 263 | 264 | \ stuff for findin things by name 03dec84tjb 265 | CREATE NAME-BUF 40 ALLOT VARIABLE NAME-LEN 266 | 267 | : ?NAME BL TEXT PAD 1+ NAME-BUF 40 CMOVE 268 | NAME-BUF 40 -TRAILING DUP 0= ABORT" bad name" 269 | DUP NAME-LEN ! 1- + DUP C@ 128 OR SWAP C! 270 | BL WORD NUMBER? DROP DATE> SINCE ! ; 271 | 272 | : -NAME >NAME V.PTR 2! 1 NAME-BUF DUP NAME-LEN @ + 273 | SWAP DO I C@ V> = AND DUP 0= IF LEAVE THEN LOOP ; 274 | 275 | : FIND-NAME 0. 2DUP CUR-MSG 2! SCAN-ROOT 2! 276 | BEGIN CUR-MSG 2@ -NAME IF 0 EXIT THEN NEXT-MSG 0= UNTIL 1 ; 277 | 278 | 279 | \ some real stuff 03dec84tjb 280 | : FINDER ?NAME FIND-NAME IF ." <-- message not in tree." 281 | ABORT THEN CR ; : GOTO FINDER ; 282 | : READ FINDER .HEAD TYPER SUB-MSG ; 283 | : R READ ; 284 | : BROWSE FINDER .HEAD TYPE-LINE CR SUB-MSG ; 285 | 286 | : ADDTO FINDER ED ; 287 | 288 | : INDEX FINDER CUR-MSG 2@ 2DUP SCAN-ROOT 2! HEADER@ 0 LEVEL ! 289 | DAUGHTER HEADER> D0= ABORT" nothing to index" 290 | BEGIN NEXT-MSG WHILE CUR-MSG 2@ HEADER@ DATE HEADER> SINCE @ 291 | U< NOT IF LEVEL @ 2* SPACES CUR-MSG 2@ HEADER@ 292 | TYPER 40 TAB DATE HEADER> .DATE 55 TAB USAGE HEADER> . 293 | LENGTH HEADER> 65 TAB D. CR THEN REPEAT CR ; 294 | 295 | \ start of file maintainence 03dec84tjb 296 | 297 | : DE-LINK CUR-MSG 2@ HEADER@ PARENT HEADER> OLDER HEADER> 298 | D= IF YOUNGER HEADER> 2DUP PARENT HEADER> HEADER@ DAUGHTER 299 | >HEADER HADDR! 2DUP D0= IF 2DROP ELSE HEADER@ PARENT HEADER> 300 | OLDER >HEADER HADDR! THEN 301 | ELSE YOUNGER HEADER> 2DUP OLDER HEADER> HEADER@ YOUNGER 302 | >HEADER HADDR! D0= NOT IF HADDR 2@ YOUNGER HEADER> 303 | HEADER@ OLDER >HEADER HADDR! THEN THEN ; 304 | 305 | 306 | \ more file maintanence 03dec84tjb 307 | 308 | : REMOVE FINDER CUR-MSG 2@ NEW.PTR 2! DE-LINK CR ; 309 | 310 | : MOVETO FINDER SET-LINKS CR ; 311 | 312 | \ Z80 SIO WORDS 21oct84jap 18may85jap 313 | \ MODIFIED FOR MORROW DECISION'S 8251 314 | HEX 315 | 316 | \ CREATE SIO$ 1818 , 1 , 4C04 , 5103 , EA05 , 317 | FC CONSTANT ADAT FD CONSTANT BDAT 318 | FF CONSTANT ACON FF CONSTANT BCON 319 | 320 | : SINIT ; 321 | \ SIO$ DUP 0A + SWAP DO I C@ BCON PC! LOOP ; 322 | : MSTAT 0FF PC@ ; 323 | : DCD? MSTAT 80 AND ; \ 10 BCON PC! BCON PC@ 8 AND 8 = ; 324 | 325 | \ BAUD 12C = IF 5 ELSE 7 THEN 0C PC! ; 326 | 327 | DECIMAL 328 | \ more modem/serial support 21oct84jap 329 | : GEMIT DUP (EMIT) ; 330 | : SHARE CHAT ; \ ' GKEY CFA 'KEY ! ' GEMIT CFA 'EMIT ! 331 | : TALK CR ." Use control C to exit talk mode" CR 332 | BEGIN MKEY DUP GEMIT 13 = IF 10 EMIT THEN AGAIN ; 333 | 334 | : BYE ." so long!" CR SHARE BEGIN DCD? NOT UNTIL 335 | BEGIN KEY? ABORT" BROKE" DCD? UNTIL SINIT KEY KEY 2DROP 336 | ." Welcome to Jeff's bulletin board!" CR 337 | ." type READ BBS to start, READ HELP for help" CR CR ; 338 | 339 | : HELP CR ." type READ HELP if you need help." CR ; 340 | 341 | 342 | \ limiting the trouble we get into 21oct84jap 343 | 344 | : TPEE \ this is the command to return to forth 345 | ['] (?ERROR) IS ?ERROR STOP CR TRUE ABORT" back to forth" ; 346 | 347 | CREATE CMDS ' READ , ' BROWSE , ' INDEX , ' NN , ' HELP , 348 | ' TALK , ' BYE , 349 | ' TPEE , ' ADDTO , ' SAVEIT , ' LL , ' REMOVE , 350 | ' MOVETO , 351 | 12 CONSTANT #CMDS 352 | 353 | : CMD-OK? 0 #CMDS 0 DO OVER I 2* CMDS + @ = OR LOOP ; 354 | 355 | 356 | \ limiting the trouble we get into 15MAY85JAP 357 | : GET-CMD 358 | DEFINED NOT ABORT" What??? " ; 359 | 360 | : RUNBBS BEGIN CR ." COMMAND? " QUERY GET-CMD 361 | CMD-OK? NOT 362 | IF ." BBS CMDS ONLY " HELP DROP ELSE EXECUTE THEN AGAIN ; 363 | 364 | : (?BBSERROR) (S adr len f -- ) 365 | IF >R >R SP0 @ SP! 366 | R> R> SPACE TYPE SPACE RUNBBS 367 | ELSE 2DROP THEN ; 368 | 369 | : SAFER ['] (?BBSERROR) IS ?ERROR START ONLY FBBS ALSO 370 | TRUE ABORT" enter TPEE to return to forth " ; 371 | \S **** End of the first part of the BBS, less File maintenance. 372 | \ words used by PACK 03dec84tjb 373 | 2VARIABLE T.BASE 2VARIABLE T.PTR VARIABLE #MSGS 374 | 375 | : T.PTR+ T.PTR 2@ 4. D+ T.PTR 2! ; 376 | : >TABLE T.PTR 2@ VADDR 2! UPDATE T.PTR+ ; 377 | : TABLE> T.PTR 2@ VADDR 2@ T.PTR+ ; 378 | 379 | : MAKE-TABLE VDP 2@ 8. D+ 7. 2NOT 2AND 2DUP 380 | T.BASE 2! T.PTR 2! 0. CUR-MSG 2! 0 #MSGS ! 381 | BEGIN CUR-MSG 2@ 2DUP >TABLE >TABLE 1 #MSGS +! 382 | NEXT-MSG 0= UNTIL -1. >TABLE -1. >TABLE 383 | CR #MSGS @ . ." messages in tree" CR ; 384 | 385 | : IN-TBL? T.BASE 2@ T.PTR 2! BEGIN 2DUP TABLE> D= NOT 386 | WHILE TABLE> 0. D< IF 0 EXIT THEN REPEAT 1 ; 387 | \ syntax = ( d -- d f) 388 | \ more words for pack 03dec84tjb 389 | 390 | : FIND-LINK IN-TBL? 0= IF ." WARNING! bad link: " D. CR 391 | 0. 2SWAP THEN 2DROP ; 392 | : SET-NEW ( old, new--) 2SWAP FIND-LINK >TABLE ; 393 | 394 | : NEW-LINK ( old -- new) FIND-LINK TABLE> ; 395 | 396 | : NEW-LINKS ( d --) HEADER@ 397 | PARENT HEADER> NEW-LINK PARENT >HEADER 398 | DAUGHTER HEADER> NEW-LINK DAUGHTER >HEADER 399 | YOUNGER HEADER> NEW-LINK YOUNGER >HEADER 400 | OLDER HEADER> NEW-LINK OLDER >HEADER HADDR! ; 401 | 402 | \ more words for pack 03dec84tjb 403 | 2VARIABLE SRC.PTR 2VARIABLE DES.PTR 404 | 405 | : >DES DES.PTR 2@ V! DES.PTR DUP 2@ 1. D+ ROT 2! ; 406 | : SRC+ SRC.PTR DUP 2@ LENGTH HEADER> D+ ROT 2! ; 407 | : >>DES ( d.src d.cnt ) 408 | BEGIN 2DUP 0. D> WHILE 2SWAP 2DUP 409 | V@ >DES 1. D+ 2SWAP 1. D- REPEAT 2DROP 2DROP ; 410 | 411 | : SQUISH 0. HEADER@ LENGTH HEADER> 2DUP SRC.PTR 2! 412 | DES.PTR 2! #MSGS @ 1 DO 42 EMIT 413 | SRC.PTR 2@ BEGIN 2DUP HEADER@ IN-TBL? 0= WHILE 45 EMIT 414 | LENGTH HEADER> 2+ REPEAT SRC.PTR 2! DES.PTR 2@ >TABLE 415 | CR SRC.PTR 2@ D. DES.PTR 2@ D. 416 | SRC.PTR 2@ LENGTH HEADER> >>DES SRC+ LOOP DES.PTR 2@ VDP 2! ; 417 | 418 | \ PACK 03dec84tjb 419 | 420 | : RE-LINK #MSGS @ 0 DO I 8 UM* T.BASE 2@ D+ 4. D+ VADDR 2@ 421 | NEW-LINKS LOOP ; 422 | 423 | : PACK CR ." are you sure? " KEY 89 = NOT ABORT" pack aborted." 424 | CR ." making link table" MAKE-TABLE 425 | CR ." squishing the tree" CR SQUISH 426 | CR ." reseting links" RE-LINK 427 | CR ." all done!" CR ; 428 | 429 | : .TABLE CR #MSGS @ 0 DO I 8 UM* T.BASE 2@ D+ VADDR 430 | DUP 2@ D. 4 + 2@ D. CR LOOP CR ; 431 | 432 | 433 | \ file i/o to cp/m 434 | 435 | CREATE SECBUF 128 ALLOT VARIABLE DCNT 436 | 437 | : ?FILE ?NAME PAD 33 0 FILL PAD 1+ 11 BLANK 438 | NAME-LEN @ 0 DO I NAME-BUF + C@ 127 AND I PAD + 1+ C! LOOP ; 439 | 440 | : READ-FILE ?FILE 15 PAD SYSCALL 4 > ABORT" file not found" ; 441 | 442 | : READIT CR BEGIN 26 SECBUF SYSCALL DROP 20 PAD SYSCALL 0= 443 | WHILE SECBUF 128 + SECBUF DO I C@ DUP 26 = 444 | IF DROP CR ." EOF" LEAVE ELSE EMIT THEN LOOP REPEAT ; 445 | 446 | : READF READ-FILE READIT ; 447 | 448 | \ file i/o to cp/m 03dec84tjb 449 | 450 | : IMPORT READ-FILE MNH 451 | BEGIN 26 SECBUF SYSCALL DROP 452 | 20 PAD SYSCALL 0= WHILE 128 0 DO SECBUF I + C@ 453 | 127 AND DUP 10 = IF DROP ELSE DUP 26 = IF DROP LEAVE ELSE 454 | >V THEN THEN LOOP REPEAT VMARK V.PTR 2@ E.PTR 2! CR ; 455 | 456 | 457 | 458 | \ file i/o to cp/m 03dec84tjb 459 | 460 | : WR-SEC 26 SECBUF SYSCALL DROP 21 PAD SYSCALL 0= 461 | NOT ABORT" ERROR: disk full" ; 462 | 463 | : >DISK DCNT @ DUP 128 U< IF SECBUF + C! 1 DCNT +! ELSE 464 | DROP 0 DCNT ! WR-SEC SECBUF 128 26 FILL THEN ; 465 | 466 | : EXPORT 13 0 SYSCALL DROP 14 0 SYSCALL DROP ?FILE 467 | 22 PAD SYSCALL 4 > ABORT" disk directory full" 468 | CUR-MSG 2@ >NAME V.PTR 2! ." exporting " TYPER CR 469 | 0 DCNT ! BEGIN V> DUP 127 AND DUP 13 = IF 10 >DISK THEN 470 | >DISK 127 > UNTIL WR-SEC 16 PAD SYSCALL DROP ; 471 | 472 | 473 | \ back pointer fixer upper 03dec84tjb 474 | 475 | : FIX-DTRS CUR-MSG 2@ 2DUP HEADER@ DAUGHTER HEADER> BEGIN 476 | 2DUP D0= NOT WHILE HEADER@ OLDER >HEADER HADDR! HADDR 2@ 477 | YOUNGER HEADER> REPEAT 2DROP 2DROP ; 478 | 479 | : FIX-BACK 0. 2DUP CUR-MSG 2! SCAN-ROOT 2! BEGIN 480 | FIX-DTRS NEXT-MSG 0= UNTIL CR ; 481 | 482 | : LIST-PHYS CR 0. CUR-MSG 2! BEGIN CUR-MSG 2@ VDP 2@ D= 483 | NOT WHILE CUR-MSG 2@ 2DUP HEADER@ TYPER 35 TAB D. 50 TAB 484 | LENGTH HEADER> 2DUP D. CR 485 | CUR-MSG 2@ D+ CUR-MSG 2! REPEAT ; 486 | 487 | \ MESSAGE MOVING WORDS 488 | 489 | : TYPE>V (S addr -- | puts memory into virtual ) 490 | BEGIN DUP C@ DUP EMIT DUP >V DUP > 128 SWAP 0= OR 491 | SWAP 1+ SWAP 492 | UNTIL DROP ; 493 | 494 | : MED MNH ." Enter address of existing message " CR CR 495 | QUERY INTERPRET TYPE>V V- VMARK V.PTR D@ DDUP E.PTR D! 496 | VDP D@ D- ." MESSAGE LENGTH: " D. ." BYTES." CR 497 | ." OPTIONS: LL SAVEIT" CR ; 498 | 499 | \ BBS TOOLS 17oct84jap 500 | 501 | : CUR? CUR-HEAD? ; 502 | : NPAR PARENT >HEADER ; 503 | : NYOUNG YOUNGER >HEADER ; 504 | : NKID DAUGHTER >HEADER ; 505 | : UNUSED 0 USAGE >HEADER ; 506 | : NOLDER OLDER >HEADER ; 507 | : CUR! CUR-MSG D@ HEADER! ; 508 | 509 | \ MESSAGE MOVING WORDS 510 | 511 | : TYPE>V (S addr -- | puts memory into virtual ) 512 | BEGIN DUP C@ DUP EMIT DUP >V DUP > 128 SWAP 0= OR 513 | SWAP 1+ SWAP 514 | UNTIL DROP ; 515 | 516 | : MED MNH ." Enter address of existing message " CR CR 517 | QUERY INTERPRET TYPE>V V- VMARK V.PTR D@ DDUP E.PTR D! 518 | VDP D@ D- ." MESSAGE LENGTH: " D. ." BYTES." CR 519 | ." OPTIONS: LL SAVEIT" CR ; 520 | 521 | ���������������������������������������������������������������� 522 | ���������������������������������������������������������������� 523 | ���������������������������������������������������������������� 524 | ���������������������������������������������������������������� 525 | ���������������������������������������������������������������� 526 | ���������������������������������������������������������������� 527 | ���������������������������������������������������������������� 528 | ���������������������������������������������������������������� 529 | 530 | 531 | \ start of file maintainence 03dec84tjb 532 | 533 | : DE-LINK CUR-MSG 2@ HEADER@ PARENT HEADER> OLDER HEADER> 534 | D= IF YOUNGER HEADER> 2DUP PARENT HEADER> HEADER@ DAUGHTER 535 | >HEADER HADDR! 2DUP D0= IF 2DROP ELSE HEADER@ PARENT HEADER> 536 | OLDER >HEADER HADDR! THEN 537 | ELSE YOUNGER HEADER> 2DUP OLDER HEADER> HEADER@ YOUNGER 538 | >HEADER HADDR! D0= NOT IF HADDR 2@ YOUNGER HEADER> 539 | HEADER@ OLDER >HEADER HADDR! THEN THEN ; 540 | 541 | 542 | \ more file maintanence 03dec84tjb 543 | 544 | : REMOVE FINDER CUR-MSG 2@ NEW.PTR 2! DE-LINK CR ; 545 | 546 | : MOVETO FINDER SET-LINKS CR ; 547 | 548 | FORTH Bulitin Board System (FBBS) 15JAN85JAP 15MAY85JAP 549 | I can't get it to compile of F83 2.1.2 (See FBBS1.COM it works) 550 | 551 | Screen 2 is ideas, 3 is patches to F83 to match M.V.P. Forth. 552 | 4-25 is code for basic BBS 26-36 file handling stuff(untested) 553 | Data in the tree is now in a separate file. You can run FBBS2 554 | .COM from your keyboard. Screen 31 must be modified for your 555 | system. To allow for a larger BBS, change construct VBLK to 0 556 | and use a new file. The BBS is in a seperate vocabulary, FBBS. 557 | To begin the BBS type: 558 | FBBS 0 IS VBLK and START or SAFER 559 | SAFER allows only BBS commands, and protects the system from the 560 | user. Type TPEE to return to FORTH. Type READ BBS to start. 561 | READ HELP or READ COMMANDS are good too. 562 | 563 | \ Load screen for FORTH BBS 26nov84tjb 15MAY85JAP 564 | 15 VIEWS BBS2.BLK .( LOADING ) FILE? CR 565 | 3 4 THRU \ 5 6 THRU ( Virtual I/O ) 566 | 7 25 THRU ( 0 IS VBLK ) 567 | S-S BBS2.COM EXIT 568 | 26 36 THRU EXIT data packing ( SYSCALL is undefined JP) 569 | Type OPEN BBS2.DAT 0 IS VBLK and START or SAFER 570 | The orginal concept execution and code is Jeff's baby. 571 | I started the conversion to F83, but Tom actually succeded. 572 | You will see my initials on the ID date but let me assure you it 573 | is Jeffs progrm. John Peters, F83 Disk Librarian 574 | (415) 239-5393 after 7 pm. 575 | Jeff Wilson WA2KCM Tom Belpasso 576 | 55 Bedford Ave. 852-116 Minnesota Avenue 577 | Bergenfield NJ 07621 San Jose, CA 95125 578 | (201) 384-1596 MVP version (408) 292-0352 LP F-83 version 579 | 15MAY85JAP 580 | 581 | 582 | 583 | 584 | Aborts current command��yFORT�This branch 585 | is dedicated to the programming language FORTH. 586 | This BBS was wr 587 | itten in FORTH.���� TEST-WOR�This is a test 588 | message to check out the system after completely 589 | converting the 590 | code to FORTH-83.��c�' COMMAND�Allowable co 591 | mmands are: 592 | READ BROWSE INDEX ADDTO LL SAVEIT and BYE��l� 593 | ' COMMAND�Allowable commands are: 594 | READ BROWSE INDEX 595 | NN ADDTO LL SAVEIT TALK and BYE � 596 | UUUUUUUUUUUUUUUUUUUUUUUUUUUUU 597 | UUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUU 598 | UUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUU 599 | UUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUU 600 | UUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUU 601 | UUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUU 602 | UUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUU 603 | UUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUU 604 | UUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUU 605 | --------------------------------------------------------------------------------