F.I.G. MACRO V04.00 00:03:00 PAGE 1 1 .TITLE F.I.G. 2 ; **************************************************************** 3 ; 4 ; PDP-11 FORTH INTRODUCTION PDP-11 FORTH 5 ; 6 ; **************************************************************** 7 ; 8 ; 9 ; 10 ; PDP-11 FORTH RT-11, RSX-11M, AND STAND-ALONE JANUARY 1980 11 ; 12 ; 13 ; 14 ; DEVELOPED BY THE 15 ; FORTH INTEREST GROUP / FORTH IMPLEMENTATION TEAM 16 ; P.O. BOX 1105 17 ; SAN CARLOS, CA. 94070 18 ; 19 ; 20 ; IMPLEMENTED BY 21 ; JOHN S. JAMES 22 ; P.O. BOX 348 23 ; BERKELEY, CA. 94701 24 ; 25 ; 26 ; THIS SYSTEM IS IN THE PUBLIC DOMAIN AND CAN BE USED 27 ; WITHOUT RESTRICTION. PLEASE CREDIT THE FORTH INTEREST 28 ; GROUP IF YOU REPUBLISH SUBSTANTIAL PORTIONS. 29 ; 30 ; 31 ; THE FORTH INTEREST GROUP / FORTH IMPLEMENTATION TEAM 32 ; ALSO HAS DEVELOPED NEARLY IDENTICAL VERSIONS OF THIS 33 ; SYSTEM FOR THE 34 ; 8080 35 ; 6800 36 ; 6502 37 ; 9900 38 ; PACE 39 ; 40 ; 41 ; FOR MORE INFORMATION, WRITE: 42 ; 43 ; JOHN S. JAMES 44 ; P.O. BOX 348 45 ; BERKELEY, CA. 94701 46 ; 47 ; OR 48 ; 49 ; FORTH INTEREST GROUP 50 ; P.O. BOX 1105 51 ; SAN CARLOS, CA. 94070 52 ; 53 ; 54 ; 'PDP' AND 'RSX' ARE TRADEMARKS OF DIGITAL EQUIPMENT CORPORATION. F.I.G. MACRO V04.00 00:03:00 PAGE 2 1 ; THIS FORTH SYSTEM HAS 2 ; - FULL LENGTH NAMES 3 ; - EXTENSIVE COMPILE-TIME CHECKS AND ERROR MESSAGES 4 ; - DOUBLE INTEGER I/O 5 ; - A FORTH ASSEMBLER, PERMITTING STRUCTURED, INTERACTIVE 6 ; DEVELOPMENT OF DEVICE HANDLERS, SPEED-CRITICAL 7 ; ROUTINES, AND LINKAGE TO OPERATING SYSTEMS OR TO 8 ; SUBROUTINE PACKAGES WRITTEN IN OTHER LANGUAGES. 9 ; - STRING-HANDLING ROUTINES 10 ; - A STRING-SEARCH EDITOR 11 ; - LINKED VOCABULARIES 12 ; - HOOKS FOR MULTITASKING/MULTIUSER (CURRENTLY SINGLE TASK) 13 ; - AND AS CURRENTLY CONFIGURED IT RUNS IN A 24K BYTE 14 ; TASK IMAGE (THIS INCLUDES BUFFERS, OPERATING-SYSTEM 15 ; AREA, AND ROOM FOR SUBSTANTIAL ADDITIONAL FORTH 16 ; PROGRAMMING) ON ANY PDP-11 OR LSI-11 CPU, WITH OR 17 ; WITHOUT HARDWARE MULTIPLY/DIVIDE. THIS DISKETTE 18 ; WILL BOOT AND RUN STAND-ALONE; ALSO IT CONTAINS A 19 ; SOURCE PROGRAM WHICH CAN BE ASSEMBLED TO RUN 20 ; UNDER RT-11, RSX-11M, OR STAND-ALONE. THIS SYSTEM 21 ; CAN BE MODIFIED TO INTERFACE WITH ANY OTHER OPERATING 22 ; SYSTEM WHICH SUPPORTS READ AND WRITE A CHARACTER, 23 ; DETECT A CHARACTER (OPTIONAL), AND READ AND WRITE 24 ; A DISK BLOCK. 25 ; 26 ; 27 ; IT IS ALIGNED WITH THE 1978 STANDARD OF THE FORTH INTERNATIONAL 28 ; STANDARDS TEAM. 29 ; 30 ; 31 ; 32 ; RECOMMENDED DOCUMENTATION: 33 ; - A FORTH LANGUAGE MANUAL. WE PARTICULARLY RECOMMEND EITHER 34 ; (A) 'USING FORTH', BY FORTH, INC. 35 ; OR 36 ; (B) 'A FORTH PRIMER', BY W. RICHARD STEVENS, KITT 37 ; PEAK NATIONAL OBSERVATORY. 38 ; EITHER IS AVAILABLE THROUGH THE FORTH INTEREST GROUP, 39 ; P.O. BOX 1105, SAN CARLOS, CA. 94070. 40 ; - PDP-11 FORTH USER'S GUIDE, AVAILABLE FROM JOHN S. JAMES, 41 ; ADDRESS ABOVE. 42 ; - FORTH REFERENCE CARD FOR THE FORTH IMPLEMENTATION TEAM 43 ; COMMON MODEL, AVAILABLE FROM FIG. 44 ; - 'FIG-FORTH INSTALLATION MANUAL', ALSO FROM FIG. 45 ; 46 ; 47 ; 48 ; ACKNOWLEDGMENTS: 49 ; THIS FORTH SYSTEM (IN 'FORTH.MAC') IS A GROUP PRODUCT 50 ; OF THE FORTH IMPLEMENTATION TEAM OF THE FORTH INTEREST 51 ; GROUP (P.O. BOX 1105, SAN CARLOS CA. 94070). THE IMPLEMENTER 52 ; IS RESPONSIBLE FOR THIS PDP-11 VERSION OF THE MODEL, AND FOR 53 ; THE SOFTWARE ON SCREENS IN 'FORTH.DAT'. ALTHOUGH THE LATTER 54 ; IS NOT AN OFFICIAL RELEASE OF THE F.I.G., THE CONTRIBUTIONS 55 ; FROM MEMBERS OF THE GROUP ARE TOO NUMEROUS TO CITE 56 ; INDIVIDUALLY. 57 ; IN ADDITION WE APPRECIATE THE PDP-11 CODING F.I.G. MACRO V04.00 00:03:00 PAGE 2-1 58 ; IMPROVEMENTS SUGGESTED BY STUART R. DOLE, DOLE & FARMER, 59 ; PO BOX 142, PETALUMA, CA. 94952; BY PAUL EDELSTEIN; 60 ; BY RICK STEVENS OF KITT PEAK; AND OTHERS. F.I.G. MACRO V04.00 00:03:00 PAGE 3 1 ; **************************************************************** 2 ; 3 ; BRINGING UP THE SYSTEM 4 ; 5 ; **************************************************************** 6 ; 7 ; 8 ; 9 ; TO RUN STAND-ALONE: 10 ; - BOOT THE DISKETTE LIKE ANY OTHER SYSTEM DISK, FROM DX0. 11 ; FORTH SHOULD COME UP AND TYPE 'FIG FORTH' AND THE VERSION 12 ; NUMBER. TEST AS DESCRIBED FOR RT-11 BELOW. 13 ; - MAKE A COPY OF THE DISK; THIS STAND-ALONE SYSTEM DOES NOT 14 ; PROTECT AGAINST ACCIDENTALLY OVERWRITING THE SYSTEM OR THE 15 ; SOURCE PROGRAMS. TO MAKE AN EXACT COPY OF THE ENTIRE DISK, 16 ; 1. PUT A BLANK DISK INTO THE SECOND DRIVE (DX1). FOR 17 ; SAFETY, SET THE WRITE-PROTECT SWITCH ON THE DRIVE 18 ; WHICH CONTAINS THE ORIGINAL SYSTEM DISK. 19 ; 2. TYPE '38 LOAD', AND CARRIAGE RETURN. THE SYSTEM SHOULD 20 ; RESPOND 'OK'. THEN TYPE 'COPY' AND RETURN. EACH OF 21 ; THE 77 TRACKS WILL BE READ FROM DX0 AND WRITTEN ON DX1. 22 ; - NOTE THE LAYOUT OF THE DISKETTE. IT IS SET UP TO BOOT AND 23 ; RUN STAND-ALONE, BUT IT ALSO CONTAINS AN RT-11 DIRECTORY, 24 ; AND A MACRO-11 SOURCE PROGRAM 'FORTH.MAC' (WHICH PRODUCED 25 ; THIS LISTING). THIS ALLOWS THE SAME DISK TO BE BOOTED 26 ; AND RUN, OR TO PROVIDE SOURCE FOR MODIFICATION AND RE-ASSEMBLY. 27 ; AS PROVIDED, THE FILE 'FORTH.DAT' CONTAINS FORTH SCREENS 28 ; 1-70. YOU CAN USE LOCATIONS BEYOND 70, BUT THESE WILL 29 ; OVERWRITE THE 'FORTH.MAC' SOURCE PROGRAM. STAND-ALONE USERS 30 ; MAY NEVER NEED TO USE THIS SOURCE, AND MAY WANT TO REMOVE IT 31 ; AND USE THE SPACE FOR SOMETHING ELSE. MAKE A COPY FIRST. 32 ; - STAND-ALONE USERS CAN ADD THEIR OWN OPERATIONS AND THEN 33 ; SAVE A BOOTABLE IMAGE OF THE NEW SYSTEM. THE NEW OPERATIONS 34 ; WILL BE AVAILABLE WHEN THE DISK IS BOOTED IN THE FUTURE. 35 ; THE LOADER WHICH IS USED WILL ONLY LOAD IMAGES UP TO 7.9K; 36 ; THIS LEAVES SEVERAL HUNDRED BYTES FOR NEW OPERATIONS, WHICH 37 ; CAN INCLUDE EXTENDING THE SYSTEM BY BRINGING IN SOURCE OR 38 ; OBJECT CODE. TO SAVE THE CURRENT SYSTEM, EXECUTE 'FORTH DEFINITIONS' 39 ; IF NECESSARY TO GET INTO THE FORTH VOCABULARY, THEN 'DECIMAL 34 LOAD'. 40 ; SOME WARNING MESSAGES WILL BE PRINTED (MSG #4); THEY CAN BE 41 ; IGNORED. 42 ; - IF YOU DO WANT TO RE-ASSEMBLE THE SYSTEM FOR STAND-ALONE 43 ; USE (WHICH MOST USERS SHOULD NEVER FIND NECESSARY), 44 ; YOU MUST USE RT-11 TO EDIT AND ASSEMBLE 'FORTH.MAC'. NOTE 45 ; THAT ALTHOUGH THIS LISTING IS ASSEMBLED FOR STAND-ALONE, 46 ; THE SOURCE PROGRAM SUPPLIED IS SET FOR RT-11 ASSEMBLY; 47 ; COMMENT OUT THE 'RT11' DEFINITION, AND REMOVE THE COMMENTING 48 ; ON 'ALONE'. ASSEMBLE, LINK, AND RUN, AND THE SYSTEM SHOULD 49 ; COME UP STAND-ALONE. IMMEDIATELY REMOVE THE RT-11 SYSTEM DISK 50 ; AND PLACE THE FORTH DISK IN DRIVE ZERO. TO REVISE 51 ; THE BOOTABLE IMAGE ON THE FORTH DISK SO THAT YOUR NEW SYSTEM 52 ; BOOTS STAND-ALONE, LIST SCREEN 34 (DECIMAL), AND FOLLOW THE 53 ; INSTRUCTIONS THERE. THE RUN TAKES ABOUT ONE MINUTE. 54 ; - THE BOOTABLE SYSTEM DOES NOT USE HARDWARE MULTIPLY AND DIVIDE. 55 ; IF YOU DON'T HAVE RT-11 TO EDIT AND RECOMPILE WITH 'EIS' 56 ; CONDITIONAL ASSEMBLY, THE MULTIPLY/DIVIDE ROUTINES CAN BE 57 ; PATCHED. IF YOU PATCH FROM THE KEYBOARD MONITOR, THE F.I.G. MACRO V04.00 00:03:00 PAGE 3-1 58 ; RESTART ADDRESS IS 1000 OCTAL ( COLD START) OR 1004 (WARM 59 ; START). SAVE THE NEW VERSION AS A BOOTABLE SYSTEM, AS 60 ; DESCRIBED ABOVE. 61 ; - THE SKEWED DISK I/O OPERATIONS SKIP TRACK ZERO, FOR COMPATIBILITY 62 ; WITH STANDARD PDP-11 SECTOR SKEWING. THE PHYSICAL READ 63 ; OPERATIONS ('RTS', 'WTS', 'NRTS', 'NWTS') CAN READ ANY SECTOR, 64 ; HOWEVER. 65 ; - ALSO THE SYSTEM AS DISTRIBUTED SKIPS THE FIRST 56 SECTORS 66 ; (7 SCREENS) IN ORDER TO SKIP THE BOOT BLOCK AND AN 67 ; RT-11 DIRECTORY. THIS CAUSES THE SCREEN POSITIONS TO BE THE 68 ; SAME FOR STAND-ALONE AND FOR RT-11 (WHICH ACCESSES THE FILE 69 ; 'FORTH.DAT'). YOU CAN CHANGE THIS BY CHANGING THE VALUE OF 70 ; THE VARIABLES 'S-SKIP' (NUMBER OF SCREENS SKIPPED) AND 71 ; 'S-USE' (NUMBER OF SCREENS USED BEFORE ACCESSING THE 72 ; SECOND DISK). THESE VARIABLES CAN BE CHANGED AT ANY TIME, 73 ; SO DISK SCREENS CAN BE READ INTO BUFFERS AND THEN FLUSHED 74 ; TO DIFFERENT LOCATIONS ON THE DISK. 75 ; - ADVANCED USERS MAY NOTE THAT THIS SYSTEM IS DESIGNED TO 76 ; ALLOW THE MEMORY LAYOUT - NUMBER AND LOCATION OF DISK 77 ; BUFFERS, LOCATION OF THE STACK, ETC. - TO BE CHANGED 78 ; DYNAMICALLY, WITHOUT REASSEMBLY. 79 ; 80 ; 81 ; TO BRING UP THIS SYSTEM UNDER RT-11: 82 ; - BE SURE THAT RT-11 IS SELECTED BELOW. THE LINES DEFINING 83 ; 'RSX11M' AND 'ALONE' SHOULD BE COMMENTED OUT; 'RT11' SHOULD 84 ; NOT BE. NOTE THAT THIS DISK IS DISTRIBUTED READY FOR RT-11 85 ; ASSEMBLY (EVEN THOUGH THIS LISTING IS FOR STAND-ALONE). 86 ; - IF YOU HAVE HARDWARE MULTIPLY/DIVIDE, ALSO REMOVE THE 87 ; SEMICOLON FROM THE LINE DEFINING 'EIS'. 88 ; - IF YOU ARE USING AN OLDER VERSION OF RT-11 (VERSION 2), 89 ; YOU MAY NEED TO USE THE MACROS '..V2..' AND '.REGDEF'. 90 ; - ASSEMBLE, LINK, AND RUN. THE SYSTEM SHOULD COME UP AND 91 ; TYPE 'FIG-FORTH' AND THE VERSION NUMBER. 92 ; - TEST THAT IT IS UP BY TRYING SOME ARITHMETIC OR DEFINITIONS, E.G. 93 ; 88 88 * . (NOTE THAT THE '.' MEANS PRINT) 94 ; : SQUARE DUP * ; 95 ; 25 SQUARE . 96 ; OR TYPE 'VLIST' FOR A LIST OF ALL THE FORTH OPERATIONS IN THE 97 ; DICTIONARY. 98 ; - THE DISK SHOULD WORK IF THE DISKETTE IS IN DRIVE 'DK'. 99 ; MAKE SURE THAT 'DK' IS ASSIGNED TO WHATEVER PHYSICAL 100 ; DRIVE YOU ARE USING - OR CHANGE LINE 'RTFILE:' IN 101 ; 'FORTH.MAC'. TEST THE DISK BY TYPING 102 ; 1 LIST 103 ; WHICH SHOULD LIST THE SCREEN WHICH LOADS THE EDITOR, 104 ; ASSEMBLER, AND STRING ROUTINES. 105 ; - IN CASE YOU NEED TO GET A LISTING FROM THE ASSEMBLY OF 106 ; 'FORTH.MAC' (NOT USUALLY NECESSARY), AND YOUR SYSTEM HAS 107 ; ONLY DISKETTES (NO LARGER DISKS), THE 'ALLOCATE' OPTION 108 ; IS NECESSARY BECAUSE OF THE SIZE OF THE '.LST' FILE 109 ; (AROUND 230 BLOCKS). FIRST COPY 'FORTH.MAC' ONTO A 110 ; SEPARATE DISKETTE BY ITSELF. THEN EXECUTE 111 ; .MACRO /LIST:FORTH.LST /ALLOCATE:300. /NOOBJECT 112 ; AND REPLY 'FORTH.MAC' WHEN ASKED FOR 'FILES?'. 113 ; 114 ; F.I.G. MACRO V04.00 00:03:00 PAGE 3-2 115 ; 116 ; TO BRING UP THE SYSTEM UNDER RSX-11M: 117 ; - THE DISKETTE PROVIDED IS IN RT-11 FILE FORMAT. THE TWO FILES 118 ; MUST BE COPIED OFF THE DISKETTE INTO AN RSX DIRECTORY. THE 119 ; 'FORTH.DAT' FILE MUST BE COPIED IN IMAGE MODE. ANY RSX 120 ; DIRECTORY MAY BE USED. ASSUMING THE DISKETTE IS IN DRIVE 0, 121 ; USE THE RSX COMMANDS: 122 ; >FLX =DX:FORTH.MAC/RT 123 ; >FLX =DX:FORTH.DAT/RT/IM 124 ; INCIDENTALLY, 'FORTH.DAT' IS THE SYSTEM'S 'VIRTUAL MEMORY' 125 ; FILE, USED FOR DISK I/O. THE REST OF THE SYSTEM (THIS 126 ; PROGRAM ALONE) CAN RUN INDEPENDENTLY, EVEN IF 'FORTH.DAT' 127 ; IS NOT AVAILABLE. 128 ; - EDIT 'FORTH.MAC' TO SELECT RSX ASSEMBLY. CHANGE THE SEMICOLON 129 ; TO COMMENT OUT 'RT11' NOT 'RSX11'. LET 'EIS' BE DEFINED IF 130 ; YOU HAVE HARDWARE MULTIPLY/DIVIDE. 131 ; - ASSEMBLE, TASK BUILD, AND RUN. TEST AS WITH RT11 ABOVE. 132 ; - THE DISK I/O SHOULD WORK IF 'FORTH.DAT' IS IN THE DEFAULT 133 ; DEVICE AND DIRECTORY. TEST AS ABOVE. 134 ; 135 ; 136 ; 137 ; THE SYSTEM AS SUPPLIED RESERVES 8000. BYTES FOR YOUR FORTH 138 ; PROGRAMMING AND STACK. THIS IS ENOUGH FOR SUBSTANTIAL PROJECTS. 139 ; (NOTE THAT THE EDITOR, ASSEMBLER, AND STRING PACKAGE, IF LOADED, 140 ; USE MORE THAN 5K OF THIS.) TO CHANGE THIS MEMORY SIZE, CHANGE 141 ; THE '8000.' WHICH IS IN THE LINES FOLLOWING THE LABEL 'DP:', 142 ; NEAR THE END OF THIS PROGRAM. INCIDENTALLY, VERY FEW JOBS 143 ; (E.G. RECURSION) WILL EVER USE MORE THAN 100 WORDS OF THIS SPACE 144 ; FOR THE STACK; THE REST OF THE SPACE IS AVAILABLE FOR A STRING 145 ; STACK (IF USED) OR FOR YOUR PROGRAMS - AND FORTH OBJECT CODE IS 146 ; CONSIDERABLY MORE COMPACT THAN ASSEMBLY. 147 ; 148 ; 149 ; 150 ; THE FORTH VIRTUAL FILE 'FORTH.DAT' IS USED FOR STORING SOURCE 151 ; PROGRAMS (OR DATA). THIS FILE HAS 70 1-K SCREENS (1-70), 152 ; I.E. 140 PDP-11 DISK BLOCKS. SCREENS 4 AND 5 ARE USED BY THE 153 ; SYSTEM FOR STORING ERROR AND WARNING MESSAGES. SCREENS 6-30 154 ; CONTAIN A TEXT EDITOR, ASSEMBLER, STRING PACKAGE, AND MISCELLANEOUS 155 ; EXAMPLES. SCREENS 40 THROUGH 47 CONTAIN A BINARY STAND-ALONE 156 ; SYSTEM (NOT USED UNDER RT-11 OR RSX-11M). USERS MAY WANT 157 ; TO SAVE THEIR SOURCE PROGRAMS AND DATA IN THE BLANK SCREENS. 158 ; THE SIZE OF THIS FORTH SCREENS FILE ('FORTH.DAT') CAN BE INCREASED 159 ; IF NEEDED. IF THE SYSTEM IS TO BE BOOTED STAND-ALONE, THE LOCATION 160 ; OF THE SYSTEM BINARY IMAGE ON THE DISK MUST NOT BE CHANGED; 161 ; THEREFORE, IF THE DISK IS TO BE USED TO RUN STAND-ALONE, DO NOT 162 ; USE RT-11 TO MOVE 'FORTH.DAT' TO ANOTHER PLACE ON THE DISK. 163 ; 164 ; 165 ; 166 ; 167 ; 168 ; NOTE THAT THE RT-11 AND RSX-11M SYSTEMS DO NOT ECHO CHARACTERS 169 ; WHICH ARE INPUT FROM THE TERMINAL. INSTEAD, THEY LET THE OPERATING 170 ; SYSTEM (RT-11 OR RSX-11M) ECHO THEM. THIS IS DONE SO THAT TYPING 171 ; CONVENTIONS WILL BE THE SAME AS THE USER IS FAMILIAR WITH. ALSO, F.I.G. MACRO V04.00 00:03:00 PAGE 3-3 172 ; TO AVOID SWAPPING DELAYS, THE RSX VERSION OF 'KEY' READS A LINE OF 173 ; CHARACTERS AT A TIME. 174 ; 175 ; 176 ; 177 ; 178 ; CHANGE THESE LINES TO CONTROL CONDITIONAL ASSEMBLY: 179 ; 180 ;RT11=1 ; COMMENTED OUT UNLESS RT-11 181 ;RSX11=1 ; COMMENTED OUT UNLESS RSX11M 182 000001 ALONE=1 ; COMMENTED OUT UNLESS STAND-ALONE 183 000001 RL02=1 ; COMMENTED OUT UNLESS STAND-ALONE RL02 IMAGE 184 000001 EIS=1 ; COMMENTED OUT UNLESS HARDWARE MULTIPLY-DIVIDE 185 ;LINKS=1 ; COMMENTED OUT UNLESS SUBROUTINE LINKAGE FROM 186 ; FORTH TO OTHER LANGUAGES 187 ; 188 ;.PAGE 189 ; **************************************************************** 190 ; 191 ; VARIATIONS FROM F.I.G. MODEL 192 ; 193 ; **************************************************************** 194 ; 195 ; 196 ; 'FIRST' AND 'LIMIT' HAVE BEEN MADE USER VARIABLES, NOT CONSTANTS. 197 ; THEREFORE WHEN THEY ARE USED, 'FIRST @' AND 'LIMIT @' ARE 198 ; REQUIRED. 199 ; 200 ; ';CODE' AND 'FORTH' ARE NOT PURE CODE, SO THEY WERE MOVED TO THE 201 ; END OF THE DICTIONARY. THIS IS SO THE BULK OF THE DICTIONARY 202 ; COULD BE PUT IN PROM OR USED RE-ENTRANTLY. 203 ; 204 ; THE MACHINE-INDEPENDENT I/O SECTION WAS MOVED TO NEAR THE END OF 205 ; THE DICTIONARY, BECAUSE IT IS NOT ALWAYS PURE CODE, AND ALSO TO 206 ; ALLOW THE I/O TO BE REDEFINED WITHOUT REASSEMBLY. 207 ; 208 ; THIS SYSTEM MUST TEST FOR FIRST-TIME-THROUGH TERMINAL AND DISK 209 ; I/O, TO AVOID ERRONEOUS ATTEMPT TO OPEN FILES TWICE AT LATER COLD 210 ; STARTS. IT CLEARS DISK BUFFERS AT COLD START. 211 ; 212 ; CHANGES IN V 1.3.1 (PAUL HARDY): 213 ; - CHANGED VERSION NUMBER FROM "1.3" TO "1.3.1". 214 ; - CHANGED CPU FROM "11" (OCTAL) TO "11." (DECIMAL). 215 ; - ADDED "BIC #177600,(S)" TO CLEAR PARITY BIT & UPPER 216 ; BYTE FOR STANDALONE TERMINAL ASCII OUTPUT. 217 ; - CHANGED ".WORD" TO ".BLKW" IN DSKBUF AREA SO STANDALONE 218 ; BINARY IMAGE CAN BE VERIFIED TO FIT IN 017400 BYTES, 219 ; TO GUARANTEE ROOM FOR THE 2-SECTOR BOOT LOADER. 220 ; 221 ; CHANGES IN V 1.3.2 (PAUL HARDY): 222 ; - INCREASED USER AREA FROM 8000. BYTES TO 16000. BYTES; 223 ; ALL ADDRESSES ARE STILL BELOW 32768 FOR HANDLING AS SIGNED. 224 ; - ADDED ORIGINAL FIG-FORTH WORDS: +- D+- 225 ; - ADDED WORDS FOR FIG-FORTH 1986 REVISION BY C.H. TING: 226 ; NUCLEUS: 0> 1- 2- D< NOT ( ABSENT: EXIT -- IN SCREEN 83 ) 227 ; INTERPRETER: ( ABSENT: FIND ) 228 ; COMPILER: ( ABSENT: J -- IN SCREEN 81 ) F.I.G. MACRO V04.00 00:03:00 PAGE 3-4 229 ; - ON TERMINAL IN STAND-ALONE MODE, BACKSPACE NOW GENERATES 230 ; ,, TO ERASE LAST CHARACTER FROM SCREEN. 231 ; - ADDED 'OUTPOS' WORD TO STORE OUTPUT CHARACTER COUNT, 232 ; FOR BACKSPACE/DELETE (RUBOUT). DOES NOT HANDLE TABS. 233 ; 234 ; CHANGES IN V 1.3.3 (PAUL HARDY): 235 ; - ADD RL02 SUPPORT IN STAND-ALONE MODE. 236 ; 237 ; F.I.G. MACRO V04.00 00:03:00 PAGE 4 1 ; **************************************************************** 2 ; 3 ; SET UP REGISTERS AND MACROS. 4 ; 5 ; **************************************************************** 6 ; 7 ; 8 000002 W=%2 ; TEMPORARY USED BY 'NEXT' MACRO (THE INNER INTERPRETER) 9 000003 U=%3 ; POINTER TO THE USER AREA 10 000004 IP=%4 ; FORTH INSTRUCTION COUNTER 11 000005 S=%5 ; FORTH STACK POINTER 12 000006 RP=SP ; FORTH RETURN-STACK POINTER 13 ; 14 ; NOTE - CODE ROUTINES CAN USE REGISTERS 0, 1, 4, AND 5, WITHOUT 15 ; RESTORING THEM. 16 ; 17 ; 18 ; MACRO DEFINITIONS 19 ; 20 ; 21 ; 22 ; THE 'HEAD' MACRO CREATES A FORTH DICTIONARY HEADER. ITS ARGUMENTS ARE: 23 ; (1) LENGTH BYTE - THE LENGTH OF THE NAME BEING DEFINED. THE SIGN BIT 24 ; OF THE LENGTH BYTE MUST BE SET, SO THAT THE SYSTEM WILL RECOGNIZE 25 ; THE END OF A VARIABLE-LENGTH NAME FIELD; THEREFORE THE LENGTH BYTE 26 ; IS GIVEN AS 200 OCTAL PLUS THE LENGTH. IF THE OPERATION IS 27 ; IMMEDIATE, THE BIT NEXT TO THE SIGN BIT IS ALSO SET, SO THE LENGTH 28 ; BYTE IS GIVEN AS 300 OCTAL PLUS THE LENGTH. 29 ; (2) NAME - THE NAME OF THE OPERATION BEING DEFINED. 30 ; (3) LCHAR - THE ASCII VALUE OF THE LAST CHARACTER OF THE NAME, WITH THE 31 ; SIGN BIT SET. THE NAME FIELD MUST HAVE AN EVEN LENGTH (INCLUDING 32 ; THE LENGTH BYTE), SO IF THE NUMBER OF CHARACTERS IN THE NAME IS 33 ; EVEN, 'LCHAR' WILL BE GIVEN AS 240 (200 PLUS CODE FOR A SPACE). 34 ; (4) LABEL - THE ASSEMBLY-LANGUAGE LABEL ASSOCIATED WITH THE 'CODE FIELD' 35 ; OF THIS DICTIONARY HEADER. THESE LABELS ARE USED IN THE PRECOMPILED- 36 ; FORTH SECTION OF THE SYSTEM. WHEN POSSIBLE, THE FORTH OPERATION 37 ; NAME ITSELF IS USED AS THE ASSEMBLY LABEL; OTHERWISE AN ABBREVIATION 38 ; IS USED. BY CONVENTION, THESE NAMES ARE LIMITED TO FIVE CHARACTERS, 39 ; FOR CONSISTENCY AMONG VARIOUS ASSEMBLERS FOR DIFFERENT MICROPROCESSORS. 40 ; (THE FORTH IMPLEMENTATION TEAM USES THE SAME LABELS IN ALL OF ITS 41 ; VERSIONS.) 42 ; (5) CODE - POINTER TO THE MACHINE-LANGUAGE "CODE ROUTINE" ASSOCIATED 43 ; WITH THIS OPERATION TYPE OR DATA TYPE. E.G. FOR ANY COLON DEFINITION, 44 ; THIS ARGUMENT IS 'DOCOL', THE LABEL OF A FIVE-INSTRUCTION ASSEMBLY 45 ; ROUTINE WHICH USES THE RETURN STACK TO HANDLE THE NESTED EXECUTION 46 ; OF ANOTHER LEVEL OF FORTH OPERATIONS. FOR ANY CONSTANT, THIS CODE 47 ; ROUTINE IS 'DOCON', AND SIMILARLY FOR ALL OTHER DATA TYPES. 48 ; THE CODE ARGUMENT MAY BE OMITTED. IN THAT CASE, THE 'HEAD' 49 ; MACRO LEAVES THE CODE FIELD POINTING TWO BYTES BEYOND ITSELF, WHERE 50 ; MACHINE-LANGUAGE CODE MUST BEGIN - AND THE OPERATION SO DEFINED IS 51 ; CALLED A "PRIMITIVE". THE "NUCLEUS SECTION" OF THIS VERSION OF 52 ; FORTH CONTAINS ABOUT 45 PRIMITIVES, FROM WHICH THE WHOLE SYSTEM 53 ; IS BUILT; IN EFFECT, THESE PRIMITIVES DEFINE THE VIRTUAL FORTH 54 ; MACHINE. (A FEW OPERATIONS IN THE "PRECOMPILED FORTH" SECTION 55 ; OF THE SYSTEM HAVE BEEN REPLACED WITH PRIMITIVES, TO OPTIMIZE 56 ; EXECUTION SPEED. AND WHEN A FORTH ASSEMBLER IS ADDED TO THIS 57 ; SYSTEM, USERS WILL BE ABLE TO DEFINE THEIR OWN PRIMITIVES DIRECTLY F.I.G. MACRO V04.00 00:03:00 PAGE 4-1 58 ; IN FORTH, IMMEDIATELY READY FOR EXECUTION.) 59 ; 60 ; THE 'HEAD' MACRO CREATES A FORTH HEADER CONSISTING OF 61 ; LENGTH BYTE - SIGN BIT SET 62 ; NAME OF THE OPERATION - VARIABLE LENGTH - SIGN BIT SET ON LAST CHAR. 63 ; LINK FIELD, WHICH POINTS TO THE BEGINNING OF THE PREVIOUS DICTIONARY 64 ; HEADER (USED AT COMPILE TIME) 65 ; CODE POINTER. 66 ; 67 000000 LINK=0 ; LAST LINK FIELD IS 0, INDICATING END OF THE DICTIONARY. 68 69 ; 70 .MACRO HEAD,LENGTH,NAME,LCHAR,LABEL,CODE 71 LINK2=. 72 .BYTE LENGTH 73 .ASCII ^NAME^ 74 .EVEN 75 .=.-1 76 .BYTE LCHAR ; LAST CHARACTER OF NAME (OR BLANK FILL), 77 ; PASSED IN OCTAL, WITH HIGH BIT SET. 78 .WORD LINK 79 LINK=LINK2 80 LABEL: .IF NB CODE 81 .WORD CODE 82 .IFF 83 .WORD .+2 84 .ENDC 85 .ENDM 86 ; 87 ; 88 ; 89 ; THE 'NEXT' MACRO TRANSFERS CONTROL FROM ONE FORTH OPERATION TO THE 90 ; 'CODE ROUTINE' OF THE NEXT. NOTICE THAT ONLY TWO INSTRUCTION 91 ; EXECUTIONS ARE REQUIRED TO TRANSFER CONTROL FROM USEFUL OPERATIONS 92 ; OF ONE FORTH PRIMITIVE TO THOSE OF THE NEXT. 93 ; 94 .MACRO NEXT 95 MOV (IP)+,W 96 JMP @(W)+ 97 .ENDM 98 ; 99 ; 100 ; MACRO CALLS 101 ; 102 ; 103 .IFDF RT11 104 .MCALL .RCTRLO,.TTYIN,.TTINR,.TTYOUT,.EXIT,.TRPSET 105 .MCALL .SETTOP,.DSTATUS,.FETCH,.LOOKUP,.READW,.WRITW 106 .ENDC 107 ; 108 ; 109 .IFDF RSX11 110 .MCALL QIOW$C,EXIT$S,ALUN$C,ASTX$S,SVTK$S 111 .MCALL FDBDF$,FDRC$A,FDBK$A,FDOP$A,FSRSZ$ 112 .MCALL OPEN$M,READ$,WRITE$,WAIT$,CLOSE$ 113 .MCALL QIOW$ 114 .ENDC F.I.G. MACRO V04.00 00:03:00 PAGE 5 1 ; **************************************************************** 2 ; 3 ; START-UP TABLE 4 ; 5 ; **************************************************************** 6 ; 7 ; AT STARTUP, MOST OF THESE VALUES ARE MOVED INTO THE USER AREA 8 ; (STARTING AT 'XDP:'); THEY ARE NORMALLY ACCESSED THERE. THE VALUES 9 ; HERE ARE NOT USUALLY CHANGED, BUT THEY MAY BE CHANGED E.G. TO 10 ; CONTROL WHAT HAPPENS AT COLD START. THIS TABLE COULD BE MOVED OUT OF 11 ; LOW MEMORY IF NECESSARY FOR ROM SYSTEMS. 12 ; 13 ; 14 ; 15 000000 GFORTH:: ; GLOBAL LABEL - NORMALLY NOT USED 16 000000 000167 010120 ORIGIN: JMP CENT ; COLD START ENTRY POINT 17 000004 000167 010204 JMP WENT ; WARM START ENTRY ADDRESS 18 ; NOTE - COLD START WIPES OUT ANY NEW DICTIONARY DEFINITIONS, AND 19 ; THEN DOES A WARM START. WARM START CLEANS UP STACKS, TERMINAL 20 ; BUFFER, ETC. 21 000010 000013 .WORD 11. ; CPU 22 000012 000000 .WORD 0 ; REVISION 23 000014 015324' .WORD TASK-10 ; POINTER TO LATEST WORD DEFINED 24 000016 000010 .WORD 10 ; BACKSPACE CHARACTER 25 000020 063050' .WORD XUP ; POINTER TO USER AREA 26 ; NOTE - THE USER AREA IS A HOOK IN THIS SYSTEM TO ALLOW MULTITASKING 27 ; TO BE ADDED LATER. 28 000022 054540' .WORD XS0 ; POINTER TO BEGINNING OF THE STACK 29 000024 063050' .WORD XR0 ; POINTER TO BEGINNING OF RETURN STACK 30 000026 062560' .WORD XTIB ; POINTER TO TERMINAL INPUT BUFFER 31 000030 000037 .WORD 37 ; MAXIMUM NAME-FIELD WIDTH, NORMALLY 31 32 000032 000000 .WORD 0 ; WARNING MODE; 0=ERROR #, 1=DISK MESSAGE 33 ; NOTE - WARNING MODE INITIALIZED TO ZERO, IN CASE DISK ISN'T UP. 34 000034 015340' .WORD XDP ; FENCE TO PROTECT AGAINST ACCIDENTAL 35 ; 'FORGET' OF THE SYSTEM. 36 000036 015340' .WORD XDP ; POINTER TO NEXT AVAILABLE DICTIONARY 37 ; LOCATION (RETURNED BY 'HERE'). 38 000040 015322' .WORD XXVOC ; POINTER TO INITIAL VOCABULARY LINK 39 000042 054544' .WORD DSKBUF ; INITIALIZE 'FIRST' 40 000044 062560' .WORD ENDBUF ; INITIALIZE 'LIMIT' 41 000046 000000 .WORD 0 ; AVAILABLE 42 000050 000000 .WORD 0 ; AVAILABLE 43 ; F.I.G. MACRO V04.00 00:03:00 PAGE 6 1 ; **************************************************************** 2 ; 3 ; NUCLEUS 4 ; 5 ; **************************************************************** 6 ; 7 ; 8 ; 9 ; THE NUCLEUS CONTAINS THE PRIMITIVES FROM WHICH THE SYSTEM IS BUILT. 10 ; 11 ; 12 ; 13 ; 14 000052 HEAD 203,LIT,324,LIT ; ***** LIT 15 ; USED ONLY BY COMPILER. PUSH FOLLOWING LITERAL ONTO STACK. 16 000062 012445 MOV (IP)+,-(S) 17 000064 NEXT 18 ; 19 000070 HEAD 207,EXECUTE,305,EXEC ; ***** EXECUTE 20 ; EXECUTE FORTH WORD WHOSE CODE ADDRESS IS ON STACK 21 000104 012502 MOV (S)+,W 22 000106 000132 JMP @(W)+ 23 ; 24 ; 25 000110 HEAD 206,BRANCH,240,BRAN ; ***** BRANCH 26 ; USED ONLY BY COMPILER. FORTH BRANCH TO ADDRESS WHICH FOLLOWS. 27 000124 061404 ADD (IP),IP 28 000126 NEXT 29 ; 30 000132 HEAD 207,0BRANCH,310,ZBRAN ; ***** 0BRANCH 31 ; USED ONLY BY COMPILER. FORTH BRANCH IF TOP OF STACK 32 ; IS ZERO (FALSE). 33 000146 005725 TST (S)+ 34 000150 001003 BNE 3$ 35 000152 061404 ADD (IP),IP 36 000154 NEXT 37 000160 062704 000002 3$: ADD #2,IP 38 000164 NEXT 39 ; 40 000170 HEAD 206,(LOOP),240,XLOOP ; ***** (LOOP) 41 ; USED ONLY BY COMPILER. INCREMENT LOOP INDEX BY 1, BRANCH 42 ; IF BELOW LIMIT. 43 000204 005216 INC (RP) 44 000206 021666 000002 CMP (RP),2(RP) 45 000212 002003 BGE 1$ 46 000214 061404 ADD (IP),IP 47 000216 NEXT 48 000222 062706 000004 1$: ADD #4,RP 49 000226 062704 000002 ADD #2,IP 50 000232 NEXT 51 ; 52 000236 HEAD 207,(+LOOP),251,XPLOO ; ***** (+LOOP) 53 ; USED ONLY BY COMPILER. INCREMENT LOOP INDEX BY TOP OF STACK, 54 ; MAYBE BRANCH. 55 000252 061516 ADD (S),(RP) 56 000254 005725 TST (S)+ 57 000256 002414 BLT 2$ F.I.G. MACRO V04.00 00:03:00 PAGE 6-1 58 000260 026616 000002 CMP 2(RP),(RP) 59 000264 003403 BLE 1$ 60 000266 061404 ADD (IP),IP 61 000270 NEXT 62 000274 062706 000004 1$: ADD #4,RP 63 000300 062704 000002 ADD #2,IP 64 000304 NEXT 65 000310 021666 000002 2$: CMP (RP),2(RP) ; HANDLE NEGATIVE INCREMENT 66 000314 003767 BLE 1$ 67 000316 061404 ADD (IP),IP 68 000320 NEXT 69 ; 70 000324 HEAD 204,(DO),240,XDO ; ***** (DO) 71 ; USED ONLY BY COMPILER. SET UP 'DO' LIMIT AND INDEX. 72 000336 016546 000002 MOV 2(S),-(RP) 73 000342 011546 MOV (S),-(RP) 74 000344 062705 000004 ADD #4,S 75 000350 NEXT 76 ; 77 000354 HEAD 201,I,311,I ; ***** I 78 ; RETURN CURRENT LOOP INDEX TO STACK. 79 000362 011645 MOV (RP),-(S) 80 000364 NEXT 81 ; 82 000370 HEAD 205,DIGIT,324,DIGIT ; ***** DIGIT 83 ; USED BY COMPILER. 84 ; ( ASCII-DIGIT BASE ==> DIGIT-VALUE TRUE (OR FALSE)) 85 000402 162765 000060 000002 SUB #60,2(S) ; VALID DIGIT IS ASCII 60 - 86 000410 026527 000002 000011 CMP 2(S),#11 ; IF GREATER THAN 9, 87 000416 003407 BLE 1$ 88 000420 162765 000007 000002 SUB #7,2(S) ; SUBTRACT 7. 89 000426 026527 000002 000012 CMP 2(S),#12 ; AND THEN IF <10 (A) 90 000434 002412 BLT 2$ ; ERROR 91 000436 005765 000002 1$: TST 2(S) ; IF LESS THAN ZERO, ERROR 92 000442 002407 BLT 2$ 93 000444 026515 000002 CMP 2(S),(S) ; OR IF NOT LESS THAN BASE, ERR 94 000450 002004 BGE 2$ 95 000452 012715 000001 MOV #1,(S) ; VALID RETURN 96 000456 NEXT 97 000462 062705 000002 2$: ADD #2,S 98 000466 005015 CLR (S) ; ERROR - RETURN '0' FLAG 99 000470 NEXT 100 ; 101 ; 102 000474 HEAD 206,(FIND),240,PFIND ; ***** (FIND) 103 ; USED BY COMPILER. FIND A WORD IN THE DICTIONARY. 104 ; ( STRING-ADDRESS NFA ==> PFA LENGTH TRUE (OR FALSE)). 105 ; STRING-ADDRESS IS ADDRESS OF THE LENGTH BYTE OF THE 106 ; STRING BEING SOUGHT. NFA IS NAME-FIELD ADDRESS OF 107 ; WORD IN DICTIONARY WHERE SEARCH BEGINS. PFA IS 108 ; PARAMETER-FIELD ADDRESS OF THE DICTIONARY ENTRY 109 ; WHICH IS FOUND. IF WORD NOT FOUND, ONLY ONE RESULT 110 ; (0, FALSE) IS RETURNED. 111 ; SETUP - GET ARGS, PRESERVE NEEDED REGISTERS 112 000510 012500 MOV (S)+,R0 ; DICTIONARY ADDRESS 113 000512 012501 MOV (S)+,R1 ; STRING ADDRESS 114 000514 010546 MOV R5,-(RP) ; PRESERVE REGISTERS F.I.G. MACRO V04.00 00:03:00 PAGE 6-2 115 000516 010446 MOV R4,-(RP) 116 000520 010346 MOV R3,-(RP) 117 000522 005046 CLR -(RP) ; SPACE TO STORE LENGTH BYTE 118 ; PREPARE R2 FOR FAST COMPARE 119 000524 011102 MOV (R1),R2 120 000526 042702 100200 BIC #100200,R2 121 ; 122 000532 FCOMP: 123 ; FAST TEST TO ELIMINATE MOST WORDS 124 ; COMPARE FIRST WORD TO SPECIALLY PREPARED R2 125 ; THEN INCREMENT TO FIND END OF NAME. 126 000532 011003 FAST: MOV (R0),R3 127 000534 042703 100300 BIC #100300,R3 128 000540 020203 CMP R2,R3 129 000542 001406 BEQ NOFAST ; NO FAST ELIMINATION POSSIBLE 130 000544 005720 XMATCH: TST (R0)+ ; BRANCH HERE IF NO MATCH THIS TIME 131 000546 100376 BPL XMATCH 132 ; R0 NOW POINTS TO LINK 133 000550 005710 TST (R0) 134 000552 001435 BEQ FAILED 135 000554 011000 MOV (R0),R0 136 000556 000765 BR FCOMP 137 ; END OF FAST ELIMINATION TEST 138 ; 139 000560 011016 NOFAST: MOV (R0),(RP) ; SAVE LENGTH BYTE 140 000562 010105 MOV R1,R5 ; SET R5 141 000564 000407 BR NOFST1 142 ; NOW DO THE MAIN LOOP TO CHECK FOR MATCH 143 000566 005725 MLOOP: TST (R5)+ 144 000570 011504 MOV (R5),R4 145 000572 011003 MOV (R0),R3 146 000574 042703 100000 BIC #100000,R3 147 000600 020304 CMP R3,R4 148 000602 001360 BNE XMATCH 149 000604 032720 100000 NOFST1: BIT #100000,(R0)+ 150 000610 001766 BEQ MLOOP 151 ; IF GET HERE, FOUND IT. 152 000612 012602 MOV (RP)+,R2 ; POP AND SAVE LENGTH BYTE 153 000614 012603 MOV (RP)+,R3 ; RESTORE REGISTERS 154 000616 012604 MOV (RP)+,R4 155 000620 012605 MOV (RP)+,R5 156 000622 062700 000004 ADD #4,R0 ; GET PARAMETER FIELD ADDRESS 157 000626 010045 MOV R0,-(S) 158 000630 042702 177400 BIC #177400,R2 ; R2 CONTAINS LENGTH BYTE 159 000634 010245 MOV R2,-(S) 160 000636 012745 000001 MOV #1,-(S) 161 000642 NEXT 162 000646 005726 FAILED: TST (RP)+ ; POP LENGTH BYTE 163 000650 012603 MOV (RP)+,R3 ; RESTORE REGISTERS 164 000652 012604 MOV (RP)+,R4 165 000654 012605 MOV (RP)+,R5 166 000656 005045 CLR -(S) ; REPLACE LENGTH BYTE WITH 167 ; FAILURE FLAG. 168 000660 NEXT ; WE ARE DONE - FAILURE TO FIND 169 ; 170 000664 HEAD 207,ENCLOSE,305,ENCL ; ***** ENCLOSE 171 ; USED BY COMPILER. BREAK NEXT WORD OUT OF INPUT BUFFER. F.I.G. MACRO V04.00 00:03:00 PAGE 6-3 172 ; ( START-ADDRESS DELIMITER ==> ADDRESS OFFSET END NEXT-CHARACTER) 173 000700 011500 MOV (S),R0 ; DELIMITER 174 000702 016501 000002 MOV 2(S),R1 ; STARTING ADDRESS 175 000706 162705 000004 SUB #4,S ; MAKE SPACE FOR RESULTS 176 000712 122100 ENC1: CMPB (R1)+,R0 177 000714 001776 BEQ ENC1 ; SKIP OVER LEADING DELIMITERS 178 000716 162701 000001 SUB #1,R1 179 000722 010165 000004 MOV R1,4(S) 180 000726 105711 ENC2: TSTB (R1) ; TEST FOR NULL 181 000730 001420 BEQ ENC4 182 000732 122100 CMPB (R1)+,R0 ; NOT NULL, SO FIND END OF TOKEN 183 000734 001374 BNE ENC2 184 000736 010115 MOV R1,(S) 185 000740 162701 000001 SUB #1,R1 186 000744 010165 000002 ENC3: MOV R1,2(S) ; FINISH UP AND RETURN 187 000750 016501 000006 MOV 6(S),R1 188 000754 160115 SUB R1,(S) 189 000756 160165 000002 SUB R1,2(S) 190 000762 160165 000004 SUB R1,4(S) 191 000766 NEXT 192 000772 010115 ENC4: MOV R1,(S) ; HANDLE NULL CASE 193 000774 020165 000004 CMP R1,4(S) 194 001000 001361 BNE ENC3 195 001002 062701 000001 ADD #1,R1 196 001006 000756 BR ENC3 197 198 ; 199 ; 200 ; THE NEXT 4 HEADERS POINT TO INSTALLATION-DEPENDENT TERMINAL I/O 201 ; ROUTINES. 202 ; 203 ; 204 001010 HEAD 204,EMIT,240,EMIT,PEMIT ; ***** EMIT 205 ; 206 001022 HEAD 203,KEY,331,KEY,PKEY ; ***** KEY 207 ; 208 001032 HEAD 211,?TERMINAL,314,QTERM,PQTER ; ***** ?TERMINAL 209 ; 210 001050 HEAD 202,CR,240,CR,PCR ; ***** CR 211 ; 212 ; 213 ; 214 ; 215 ; 216 001060 HEAD 205,CMOVE,305,CMOVE ; ***** CMOVE 217 ; MOVE BYTES IN MEMORY. ( FROM TO N ==>) 218 001072 005715 TST (S) 219 001074 001407 BEQ 2$ ; NO MOVE 220 001076 016500 000002 MOV 2(S),R0 221 001102 016501 000004 MOV 4(S),R1 222 001106 112120 1$: MOVB (R1)+,(R0)+ 223 001110 005315 DEC (S) 224 001112 001375 BNE 1$ 225 001114 062705 000006 2$: ADD #6,S 226 001120 NEXT 227 ; 228 ; F.I.G. MACRO V04.00 00:03:00 PAGE 6-4 229 001124 HEAD 202,U*,240,USTAR ; ***** U* 230 ; ( N1 N2 ==> PRODUCT). PRODUCT IS 32-BIT DOUBLE INTEGER, 231 ; HIGH WORD TOP. 232 ; THIS MUST BE UNSIGNED MULTIPLICATION. 233 001134 004767 000004 JSR PC,UMULT 234 001140 NEXT 235 001144 UMULT: 236 ; THE VALUES TO MULTIPLY ARE ON THE STACK. 237 001144 012502 MOV (S)+,R2 238 001146 012746 000020 MOV #20,-(RP) ; SET LOOP COUNT 239 001152 005000 CLR R0 240 001154 005001 CLR R1 241 001156 006101 2$: ROL R1 242 001160 006100 ROL R0 243 001162 006102 ROL R2 244 001164 103002 BCC 1$ 245 001166 061501 ADD (S),R1 246 001170 005500 ADC R0 247 001172 005316 1$: DEC (RP) 248 001174 001370 BNE 2$ 249 001176 010115 MOV R1,(S) 250 001200 010045 MOV R0,-(S) 251 001202 005726 TST (RP)+ ; POP TEMPORARY 252 001204 000207 RTS PC 253 ; 254 001206 HEAD 202,U/,240,USLAS ; ***** U/ 255 ; THIS DIVISION MUST BE UNSIGNED. 256 001216 004767 000004 JSR PC,UDIV 257 001222 NEXT 258 001226 UDIV: 259 ; THE VALUES TO DIVIDE ARE ON THE STACK 260 001226 012502 MOV (S)+,R2 ; DIVISOR 261 001230 012500 MOV (S)+,R0 262 001232 012501 MOV (S)+,R1 263 001234 012745 000020 MOV #20,-(S) ; LOOP COUNT 264 001240 006301 1$: ASL R1 265 001242 006100 ROL R0 266 001244 001405 BEQ 2$ ; NO NEED TO SUBTRACT 267 001246 160200 SUB R2,R0 268 001250 005201 INC R1 269 001252 103002 BCC 2$ 270 001254 060200 ADD R2,R0 ; MUST RESTORE 271 001256 005301 DEC R1 272 001260 005315 2$: DEC (S) ; LOOP SIXTEEN TIMES 273 001262 001366 BNE 1$ 274 001264 005725 TST (S)+ ; POP TO DISCARD COUNT 275 001266 010045 MOV R0,-(S) ; REMAINDER 276 001270 010145 MOV R1,-(S) ; QUOTIENT 277 001272 000207 RTS PC 278 ; 279 001274 HEAD 203,AND,304,AND ; ***** AND 280 ; BITWISE AND. ( N1 N2 ==> N3). 281 001304 005115 COM (S) 282 001306 042515 BIC (S)+,(S) 283 001310 NEXT 284 ; 285 001314 HEAD 202,OR,240,OR ; ***** OR F.I.G. MACRO V04.00 00:03:00 PAGE 6-5 286 001324 052515 BIS (S)+,(S) 287 001326 NEXT 288 ; 289 001332 HEAD 203,XOR,322,XOR ; ***** XOR 290 .IFDF EIS 291 001342 012500 MOV (S)+,R0 292 001344 074015 XOR R0,(S) 293 .IFF 294 MOV (S),-(RP) 295 BIC 2(S),(RP) 296 BIC (S)+,(S) 297 BIS (RP)+,(S) 298 .ENDC 299 001346 NEXT 300 ; 301 001352 HEAD 203,SP@,300,SPAT ; ***** SP@ 302 001362 010501 MOV S,R1 303 001364 010145 MOV R1,-(S) 304 001366 NEXT 305 ; 306 001372 HEAD 203,SP!,241,SPSTO ; ***** SP! 307 001402 016305 000006 MOV 6(U),S ; OFFSET 6 IN USER AREA 308 309 001406 NEXT 310 ; 311 001412 HEAD 203,RP!,241,RPSTO ; ***** RP! 312 001422 016706 176376 MOV ORIGIN+24,RP 313 001426 NEXT 314 ; 315 001432 HEAD 202,<;S>,240,SEMIS ; ***** ;S 316 001442 012604 MOV (RP)+,IP 317 001444 NEXT 318 ; 319 001450 HEAD 205,LEAVE,305,LEAVE ; ***** LEAVE 320 001462 011666 000002 MOV (RP),2(RP) 321 001466 NEXT 322 ; 323 001472 HEAD 202,^/>R/,240,TOR ; ***** >R 324 001502 012546 MOV (S)+,-(RP) 325 001504 NEXT 326 ; 327 001510 HEAD 202,R>,240,FROMR ; ***** R> 328 001520 012645 MOV (RP)+,-(S) 329 001522 NEXT 330 ; 331 001526 HEAD 201,R,322,R ; ***** R 332 001534 011645 MOV (RP),-(S) 333 001536 NEXT 334 ; 335 001542 HEAD 202,0=,240,ZEQU ; ***** 0= 336 001552 005715 TST (S) 337 001554 001402 BEQ 1$ 338 001556 005015 CLR (S) 339 001560 000402 BR 2$ 340 001562 012715 000001 1$: MOV #1,(S) 341 001566 2$: 342 001566 NEXT F.I.G. MACRO V04.00 00:03:00 PAGE 6-6 343 ; 344 001572 HEAD 202,0<,240,ZLESS ; ***** 0< 345 001602 005715 TST (S) 346 001604 100402 BMI 1$ 347 001606 005015 CLR (S) 348 001610 000402 BR 2$ 349 001612 012715 000001 1$: MOV #1,(S) 350 001616 2$: 351 001616 NEXT 352 ; 353 001622 HEAD 202,0>,240,ZGT ; ***** 0> 354 001632 005715 TST (S) 355 001634 003002 BGT 1$ 356 001636 005015 CLR (S) 357 001640 000402 BR 2$ 358 001642 012715 000001 1$: MOV #1,(S) 359 001646 2$: 360 001646 NEXT 361 ; 362 001652 HEAD 201,+,253,PLUS ; ***** + 363 001660 062515 ADD (S)+,(S) 364 001662 NEXT 365 ; 366 001666 HEAD 202,D+,240,DPLUS ; ***** D+ 367 001676 066565 000002 000006 ADD 2(S),6(S) ; ADD LOW 368 001704 005565 000004 ADC 4(S) 369 001710 061565 000004 ADD (S),4(S) ; ADD HIGH 370 001714 062705 000004 ADD #4,S 371 001720 NEXT 372 ; 373 001724 HEAD 205,MINUS,323,MINUS ; ***** MINUS 374 ; CHANGE SIGN. 375 001736 005415 NEG (S) 376 001740 NEXT 377 ; 378 001744 HEAD 206,DMINUS,240,DMINU ; ***** DMINUS 379 ; CHANGE SIGN OF DOUBLE INTEGER WORD ON STACK. 380 001760 005415 NEG (S) 381 001762 005465 000002 NEG 2(S) 382 001766 005615 SBC (S) 383 001770 NEXT 384 ; 385 001774 HEAD 204,OVER,240,OVER ; ***** OVER 386 ; ( N1 N2 ==> N1 N2 N1) 387 002006 016545 000002 MOV 2(S),-(S) 388 002012 NEXT 389 ; 390 002016 HEAD 204,DROP,240,DROP ; ***** DROP 391 002030 062705 000002 ADD #2,S 392 002034 NEXT 393 ; 394 002040 HEAD 204,SWAP,240,SWAP ; ***** SWAP 395 002052 016501 000002 MOV 2(S),R1 396 002056 011565 000002 MOV (S),2(S) 397 002062 010115 MOV R1,(S) 398 002064 NEXT 399 ; F.I.G. MACRO V04.00 00:03:00 PAGE 6-7 400 002070 HEAD 203,DUP,320,DUP ; ***** DUP 401 002100 011545 MOV (S),-(S) 402 002102 NEXT 403 ; 404 002106 HEAD 202,+!,240,PSTOR ; ***** +! 405 ; ADD NUMBER SECOND ON STACK TO ADDRESS ON TOP. 406 002116 066575 000002 000000 ADD 2(S),@(S) 407 002124 062705 000004 ADD #4,S 408 002130 NEXT 409 ; 410 002134 HEAD 206,TOGGLE,240,TOGGL ; ***** TOGGLE 411 ; ( BYTE-ADDRESS BIT-PATTERN ==> ) EXCLUSIVE-OR INTO MEMORY BYTE. 412 002150 016545 000002 MOV 2(S),-(S) ; PUSH THE BYTE 413 002154 117515 000000 MOVB @(S),(S) ; TO BE TOGGLED 414 ; AVOID USING 'XOR' INSTRUCTION - NOT AVAILABLE ON ALL PDP-11 415 002160 011546 MOV (S),-(RP) 416 002162 046516 000002 BIC 2(S),(RP) 417 002166 042515 BIC (S)+,(S) 418 002170 052615 BIS (RP)+,(S) 419 002172 016545 000002 MOV 2(S),-(S) ; SET UP RETURN ADDRESS 420 002176 116575 000002 000000 MOVB 2(S),@(S) ; PUT THE TOGGLED BYTE BACK TO MEM. 421 002204 062705 000006 ADD #6,S ; ADJUST STACK POINTER 422 002210 NEXT 423 ; 424 002214 HEAD 201,@,300,AT ; ***** @ 425 002222 017515 000000 MOV @(S),(S) 426 002226 NEXT 427 ; 428 002232 HEAD 202,C@,240,CAT ; ***** C@ 429 002242 117501 000000 MOVB @(S),R1 430 002246 042701 177400 BIC #177400,R1 431 002252 010115 MOV R1,(S) 432 002254 NEXT 433 ; 434 002260 HEAD 201,!,241,STORE ; ***** ! 435 002266 016575 000002 000000 MOV 2(S),@(S) 436 002274 062705 000004 ADD #4,S 437 002300 NEXT 438 ; 439 002304 HEAD 202,C!,240,CSTOR ; ***** C! 440 002314 116575 000002 000000 MOVB 2(S),@(S) 441 002322 062705 000004 ADD #4,S 442 002326 NEXT 443 ; 444 ; F.I.G. MACRO V04.00 00:03:00 PAGE 7 1 ; **************************************************************** 2 ; 3 ; PRE-COMPILED FORTH SECTION 4 ; 5 ; **************************************************************** 6 ; 7 ; 8 ; 9 ; NOTE - A FEW OF THE FOLLOWING OPERATIONS HAVE BEEN 10 ; CONVERTED TO CODE FOR SPEED. HOWEVER, THE WORD ORDER 11 ; IN THE DICTIONARY HAS NOT BEEN CHANGED. 12 ; 13 002332 HEAD 301,:,272,COLON,DOCOL ; ***** : 14 002340 004334' 004226' 003172' .WORD QEXEC,SCSP,CURR,AT,CONT,STORE,CREAT,RBRAC,PSCOD 002346 002220' 003154' 002264' 002354 007032' 004544' 004714' 15 002362 010446 DOCOL: MOV IP,-(RP) 16 002364 010204 MOV W,IP 17 002366 NEXT 18 ; 19 002372 HEAD 301,<;>,273,SEMI,DOCOL ; ***** ; 20 002400 004410' 004500' 001440' .WORD QCSP,COMP,SEMIS,SMUDG,LBRAC,SEMIS 002406 004572' 004526' 001440' 21 ; 22 002414 HEAD 210,CONSTANT,240,CON,DOCOL ; ***** CONSTANT 23 002432 007032' 004572' 003476' .WORD CREAT,SMUDG,COMMA,PSCOD 002440 004714' 24 002442 011245 DOCON: MOV (W),-(S) 25 002444 NEXT 26 ; 27 002450 HEAD 210,VARIABLE,240,VAR,DOCOL ; ***** VARIABLE 28 002466 002430' 004714' .WORD CON,PSCOD 29 002472 010245 DOVAR: MOV W,-(S) 30 002474 NEXT 31 ; 32 002500 HEAD 204,USER,240,USER,DOCOL ; ***** USER 33 ; CREATE A NEW USER VARIABLE. ( N ==> ). 34 002512 002430' 004714' .WORD CON,PSCOD 35 002516 011245 DOUSE: MOV (W),-(S) 36 002520 060315 ADD U,(S) 37 002522 NEXT 38 ; 39 ; 40 ; 41 ; CONSTANTS 42 ; 43 002526 HEAD 201,0,260,ZERO,DOCON ; ***** 0 44 002534 000000 .WORD 0 45 ; 46 002536 HEAD 201,1,261,ONE,DOCON ; ***** 1 47 002544 000001 .WORD 1 48 ; 49 002546 HEAD 201,2,262,TWO,DOCON ; ***** 2 50 002554 000002 .WORD 2 51 ; 52 002556 HEAD 201,3,263,THREE,DOCON ; ***** 3 53 002564 000003 .WORD 3 F.I.G. MACRO V04.00 00:03:00 PAGE 7-1 54 ; 55 002566 HEAD 202,BL,240,BL,DOCON ; ***** BL 56 ; BLANK. 57 002576 000040 .WORD 40 58 ; 59 002600 HEAD 203,C/L,314,CL,DOCON ; ***** C/L 60 ; # OF CHARACTERS PER LINE 61 002610 000100 .WORD 100 62 ; 63 ; 'FIRST' AND 'LIMIT' MOVED TO USER AREA 64 ; 65 002612 HEAD 205,B/BUF,306,BBUF,DOCON ; ***** B/BUF 66 ; BYTES PER DISK-BLOCK BUFFER. 67 002624 002000 .WORD 1024. 68 ; 69 002626 HEAD 205,B/SCR,322,BSCR,DOCON ; ***** B/SCR 70 ; DISK BLOCKS PER FORTH SCREEN. 71 002640 000001 .WORD 1 72 ; 73 002642 HEAD 207,+ORIGIN,316,PORIG,DOCOL ; ***** +ORIGIN 74 ; RETURNS ADDRESS, GIVEN OFFSET FROM ORIGIN. 75 002656 000060' 000000' 001656' .WORD LIT,ORIGIN,PLUS,SEMIS 002664 001440' 76 ; 77 ; USER VARIABLES 78 ; 79 002666 HEAD 202,S0,240,SZERO,DOUSE ; ***** S0 80 ; STACK ORIGIN. 81 002676 000006 .WORD 6 82 ; 83 002700 HEAD 202,R0,240,RZERO,DOUSE ; ***** R0 84 ; RETURN STACK ORIGIN. 85 002710 000010 .WORD 10 86 ; 87 002712 HEAD 203,TIB,302,TIB,DOUSE ; ***** TIB 88 ; TERMINAL INPUT BUFFER. 89 002722 000012 .WORD 12 90 ; 91 002724 HEAD 205,WIDTH,310,WIDTH,DOUSE ; ***** WIDTH 92 ; MAXIMUM NAME LENGTH (DEFAULT, 31 CHARACTERS). 93 002736 000014 .WORD 14 94 ; 95 002740 HEAD 207,WARNING,307,WARN,DOUSE ; ***** WARNING 96 ; WARNING MODE (DEFAULT, GIVE MESSAGE NUMBER AT ERROR 97 ; OR WARNING CONDITION, DON'T GO TO DISK FOR MESSAGE). 98 002754 000016 .WORD 16 99 ; 100 002756 HEAD 205,FENCE,305,FENCE,DOUSE ; ***** FENCE 101 ; PREVENTS 'FORGET' BELOW THIS 'FENCE' SETTING. 102 002770 000020 .WORD 20 103 ; 104 002772 HEAD 202,DP,240,DP,DOUSE ; ***** DP 105 ; DICTIONARY POINTER TO NEXT AVAILABLE SPACE. 106 003002 000022 .WORD 22 107 ; 108 003004 HEAD 210,VOC-LINK,240,VOCL,DOUSE ; ***** VOC-LINK 109 ; VOCABULARY LINK (MAINLY FOR FUTURE USE). F.I.G. MACRO V04.00 00:03:00 PAGE 7-2 110 003022 000024 .WORD 24 111 ; 112 003024 HEAD 205,FIRST,324,FIRST,DOUSE ; ***** FIRST 113 ; ADDRESS OF BEGINNING OF DISK BUFFER. 114 003036 000026 .WORD 26 115 ; 116 003040 HEAD 205,LIMIT,324,LIMIT,DOUSE ; ***** LIMIT 117 ; ADDRESS JUST BEYOND END OF DISK BUFFERS. 118 003052 000030 .WORD 30 119 ; 120 ; POSITIONS 32 AND 34 ARE AVAILABLE FOR EXPANSION. 121 ; THEY ARE INITIALIZED FROM BOOT-UP TABLE, AT COLD START. 122 ; 123 003054 HEAD 203,BLK,313,BLK,DOUSE ; ***** BLK 124 ; CURRENT DISK BLOCK BEING LOADED (0=TERMINAL) 125 003064 000036 .WORD 36 126 ; 127 003066 HEAD 202,IN,240,IN,DOUSE ; ***** IN 128 ; OFFSET IN TERMINAL INPUT BUFFER. 129 003076 000040 .WORD 40 130 ; 131 003100 HEAD 203,OUT,324,OUT,DOUSE ; ***** OUT 132 ; OFFSET IN OUTPUT LINE. 133 003110 000042 .WORD 42 134 ; 135 003112 HEAD 203,SCR,322,SCR,DOUSE ; ***** SCR 136 ; CURRENT FORTH DISK SCREEN. 137 003122 000044 .WORD 44 138 ; 139 003124 HEAD 206,OFFSET,240,OFSET,DOUSE ; ***** OFFSET 140 ; OFFSET TO GET TO ANOTHER DISK DRIVE. 141 003140 000046 .WORD 46 142 ; 143 003142 HEAD 207,CONTEXT,324,CONT,DOUSE ; ***** CONTEXT 144 003156 000050 .WORD 50 145 ; 146 003160 HEAD 207,CURRENT,324,CURR,DOUSE ; ***** CURRENT 147 003174 000052 .WORD 52 148 ; 149 003176 HEAD 205,STATE,305,STATE,DOUSE ; ***** STATE 150 003210 000054 .WORD 54 151 ; 152 003212 HEAD 204,BASE,240,BASE,DOUSE ; ***** BASE 153 003224 000056 .WORD 56 154 ; 155 003226 HEAD 203,DPL,314,DPL,DOUSE ; ***** DPL 156 ; OFFSET OF DECIMAL POINT AFTER DOUBLE-INTEGER INPUT. 157 003236 000060 .WORD 60 158 ; 159 003240 HEAD 203,FLD,304,FLD,DOUSE ; ***** FLD 160 ; OUTPUT FIELD WIDTH. 161 003250 000062 .WORD 62 162 ; 163 003252 HEAD 203,CSP,320,CSP,DOUSE ; ***** CSP 164 ; USED BY COMPILER TO HOLD CURRENT STACK POSITION, 165 ; FOR ERROR CHECKING. 166 003262 000064 .WORD 64 F.I.G. MACRO V04.00 00:03:00 PAGE 7-3 167 ; 168 003264 HEAD 202,R#,240,RNUM,DOUSE ; ***** R# 169 ; CURSOR POSITION (FOR SOME EDITORS). 170 003274 000066 .WORD 66 171 ; 172 003276 HEAD 203,HLD,304,HLD,DOUSE ; ***** HLD 173 ; POINTS TO LAST CHARACTER HELD IN 'PAD' 174 003306 000070 .WORD 70 175 ; 176 003310 HEAD 203,USE,305,USE,DOUSE ; ***** USE 177 003320 000072 .WORD 72 178 ; 179 003322 HEAD 204,PREV,240,PREV,DOUSE ; ***** PREV 180 003334 000074 .WORD 74 181 ; 182 ; 183 ; END OF USER AREA 184 ; 185 ; 186 003336 HEAD 202,1+,240,ONEP ; ***** 1+ 187 003346 005215 INC (S) 188 003350 NEXT 189 ; 190 003354 HEAD 202,2+,240,TWOP ; ***** 2+ 191 003364 062715 000002 ADD #2,(S) 192 003370 NEXT 193 ; 194 003374 HEAD 202,1-,240,ONEM ; ***** 1- 195 003404 005315 DEC (S) 196 003406 NEXT 197 ; 198 003412 HEAD 202,2-,240,TWOM ; ***** 2- 199 003422 162715 000002 SUB #2,(S) 200 003426 NEXT 201 ; 202 003432 HEAD 204,HERE,240,HERE,DOCOL ; ***** HERE 203 003444 003000' 002220' 001440' .WORD DP,AT,SEMIS 204 ; 205 003452 HEAD 205,ALLOT,324,ALLOT,DOCOL ; ***** ALLOT 206 003464 003000' 002114' 001440' .WORD DP,PSTOR,SEMIS 207 ; 208 003472 HEAD 201,<,>,254,COMMA,DOCOL ; ***** , 209 003500 003442' 002264' 002552' .WORD HERE,STORE,TWO,ALLOT,SEMIS 003506 003462' 001440' 210 ; 211 ; THIS SYSTEM DOES NOT USE 'C,' 212 ; 213 003512 HEAD 201,-,255,SUB ; ***** - 214 003520 162515 SUB (S)+,(S) 215 003522 NEXT 216 ; 217 003526 HEAD 202,+-,240,PLMNS ; ***** +- 218 003536 005725 TST (S)+ 219 003540 002001 BGE 1$ 220 003542 005415 NEG (S) 221 003544 1$: NEXT 222 ; F.I.G. MACRO V04.00 00:03:00 PAGE 7-4 223 003550 HEAD 203,D+-,255,DPLMNS ; ***** D+- 224 003560 005725 TST (S)+ 225 003562 002004 BGE 1$ 226 ; CHANGE SIGN OF DOUBLE INTEGER WORD ON STACK. 227 003564 005415 NEG (S) 228 003566 005465 000002 NEG 2(S) 229 003572 005615 SBC (S) 230 003574 1$: NEXT 231 ; 232 003600 HEAD 201,=,275,EQUAL ; ***** = 233 003606 026525 000002 CMP 2(S),(S)+ 234 003612 001402 BEQ 1$ 235 003614 005015 CLR (S) 236 003616 000402 BR 2$ 237 003620 012715 000001 1$: MOV #1,(S) 238 003624 2$: NEXT 239 ; 240 003630 HEAD 201,^//,276,GREAT ; ***** > 249 003666 026525 000002 CMP 2(S),(S)+ 250 003672 003002 BGT 1$ 251 003674 005015 CLR (S) 252 003676 000402 BR 2$ 253 003700 012715 000001 1$: MOV #1,(S) 254 003704 2$: NEXT 255 ; 256 003710 HEAD 203,ROT,324,ROT ; ***** ROT 257 003720 011500 MOV (S),R0 258 003722 016515 000004 MOV 4(S),(S) 259 003726 016565 000002 000004 MOV 2(S),4(S) 260 003734 010065 000002 MOV R0,2(S) 261 003740 NEXT 262 ; 263 003744 HEAD 205,SPACE,305,SPACE,DOCOL ; ***** SPACE 264 003756 000060' 000040 001020' .WORD LIT,40,EMIT,SEMIS 003764 001440' 265 ; 266 003766 HEAD 204,-DUP,240,DDUP ; ***** -DUP 267 004000 005715 TST (S) 268 004002 001401 BEQ 1$ 269 004004 011545 MOV (S),-(S) 270 004006 1$: NEXT 271 ; 272 004012 HEAD 210,TRAVERSE,240,TRAV,DOCOL ; ***** TRAVERSE 273 ; MOVE (FORWARDS OR BACKWARDS) ACROSS A (VARIABLE LENGTH) 274 ; DICTIONARY NAME FIELD. 275 004030 002050' .WORD SWAP 276 004032 002004' 001656' 000060' XXN1: .WORD OVER,PLUS,LIT,177,OVER,CAT,LESS,ZBRAN,XXN1-. 004040 000177 002004' 002240' 004046 003634' 000144' 177760 F.I.G. MACRO V04.00 00:03:00 PAGE 7-5 277 004054 002050' 002026' 001440' .WORD SWAP,DROP,SEMIS 278 ; 279 004062 HEAD 206,LATEST,240,LATES,DOCOL ; ***** LATEST 280 004076 003172' 002220' 002220' .WORD CURR,AT,AT,SEMIS 004104 001440' 281 ; 282 ; THE NEXT 4 OPERATORS CAN DEPEND ON COMPUTER WORD SIZE. 283 ; THEY CONVERT ADDRESSES WITHIN THE NAME FIELDS OF FORTH 284 ; DICTIONARY ENTRIES. 285 ; 286 004106 HEAD 203,LFA,301,LFA,DOCOL ; ***** LFA 287 004116 000060' 000004 003516' .WORD LIT,4,SUB,SEMIS 004124 001440' 288 ; 289 004126 HEAD 203,CFA,301,CFA,DOCOL ; ***** CFA 290 004136 002552' 003516' 001440' .WORD TWO,SUB,SEMIS 291 ; 292 004144 HEAD 203,NFA,301,NFA,DOCOL ; ***** NFA 293 004154 000060' 000005 003516' .WORD LIT,5,SUB,LIT,-1,TRAV,SEMIS 004162 000060' 177777 004026' 004170 001440' 294 ; 295 004172 HEAD 203,PFA,301,PFA,DOCOL ; ***** PFA 296 004202 002542' 004026' 000060' .WORD ONE,TRAV,LIT,5,PLUS,SEMIS 004210 000005 001656' 001440' 297 ; 298 ; THE NEXT 7 OPERATIONS ARE USED BY THE COMPILER, FOR 299 ; COMPILE-TIME SYNTAX-ERROR CHECKS. 300 ; 301 004216 HEAD 204,!CSP,240,SCSP,DOCOL ; ***** !CSP 302 004230 001360' 003260' 002264' .WORD SPAT,CSP,STORE,SEMIS 004236 001440' 303 ; 304 004240 HEAD 206,?ERROR,240,QERR,DOCOL ; ***** ?ERROR 305 004254 002050' 000144' 000010 .WORD SWAP,ZBRAN,XXN2-.,ERROR,BRAN,XXN3-. 004262 006662' 000122' 000004 306 004270 002026' XXN2: .WORD DROP 307 004272 001440' XXN3: .WORD SEMIS 308 ; 309 004274 HEAD 205,?COMP,320,QCOMP,DOCOL ; ***** ?COMP 310 004306 003206' 002220' 001550' .WORD STATE,AT,ZEQU,LIT,21,QERR,SEMIS 004314 000060' 000021 004252' 004322 001440' 311 ; 312 004324 HEAD 205,?EXEC,303,QEXEC,DOCOL ; ***** ?EXEC 313 004336 003206' 002220' 000060' .WORD STATE,AT,LIT,22,QERR,SEMIS 004344 000022 004252' 001440' 314 ; 315 004352 HEAD 206,?PAIRS,240,QPAIR,DOCOL ; ***** ?PAIRS 316 004366 003516' 000060' 000023 .WORD SUB,LIT,23,QERR,SEMIS 004374 004252' 001440' 317 ; 318 004400 HEAD 204,?CSP,240,QCSP,DOCOL ; ***** ?CSP 319 004412 001360' 003260' 002220' .WORD SPAT,CSP,AT,SUB,LIT,24,QERR,SEMIS 004420 003516' 000060' 000024 004426 004252' 001440' 320 ; F.I.G. MACRO V04.00 00:03:00 PAGE 7-6 321 004432 HEAD 210,?LOADING,240,QLOAD,DOCOL ; ***** ?LOADING 322 004450 003062' 002220' 001550' .WORD BLK,AT,ZEQU,LIT,26,QERR,SEMIS 004456 000060' 000026 004252' 004464 001440' 323 ; 324 004466 HEAD 207,COMPILE,305,COMP,DOCOL ; ***** COMPILE 325 ; COMPILE THE EXECUTION ADDRESS FOLLOWING. 326 004502 004304' 001516' 002076' .WORD QCOMP,FROMR,DUP,TWOP,TOR,AT,COMMA,SEMIS 004510 003362' 001500' 002220' 004516 003476' 001440' 327 ; 328 004522 HEAD 301,[,333,LBRAC,DOCOL ; ***** [ 329 ; STOP COMPILATION, ENTER EXECUTION STATE. 330 004530 002532' 003206' 002264' .WORD ZERO,STATE,STORE,SEMIS 004536 001440' 331 ; 332 004540 HEAD 201,],335,RBRAC,DOCOL ; ***** ] 333 ; ENTER COMPILATION STATE. 334 004546 000060' 000300 003206' .WORD LIT,300,STATE,STORE,SEMIS 004554 002264' 001440' 335 ; 336 004560 HEAD 206,SMUDGE,240,SMUDG,DOCOL ; ***** SMUDGE 337 ; ALTER LATEST WORD NAME (SO THAT DICTIONARY SEARCH 338 ; WON'T FIND A PARTIALLY-COMPLETE ENTRY. 339 004574 004074' 000060' 000040 .WORD LATES,LIT,40,TOGGL,SEMIS 004602 002146' 001440' 340 ; 341 004606 HEAD 203,HEX,330,HEX,DOCOL ; ***** HEX 342 004616 000060' 000020 003222' .WORD LIT,20,BASE,STORE,SEMIS 004624 002264' 001440' 343 ; 344 004630 HEAD 207,DECIMAL,314,DEC,DOCOL ; ***** DECIMAL 345 004644 000060' 000012 003222' .WORD LIT,12,BASE,STORE,SEMIS 004652 002264' 001440' 346 ; 347 004656 HEAD 205,OCTAL,314,OCTAL,DOCOL ; ***** OCTAL 348 004670 000060' 000010 003222' .WORD LIT,10,BASE,STORE,SEMIS 004676 002264' 001440' 349 ; 350 004702 HEAD 207,<(;CODE)>,251,PSCOD,DOCOL ; ***** (;CODE) 351 ; USED ONLY BY COMPILER; COMPILED BY ';CODE'. 352 004716 001516' 004074' 004200' .WORD FROMR,LATES,PFA,CFA,STORE,SEMIS 004724 004134' 002264' 001440' 353 ; 354 ; 355 ; ***** THE DEFINITION OF ';CODE' WAS MOVED TO THE END OF 356 ; THE DICTIONARY, BECAUSE IT IS NOT PURE CODE (IT IS PATCHED 357 ; WHEN A FORTH ASSEMBLER IS LOADED). 358 359 ; 360 004732 HEAD 207,^/,276,DOES,DOCOL ; ***** DOES> 365 004766 001516' 004074' 004200' .WORD FROMR,LATES,PFA,STORE,PSCOD 004774 002264' 004714' F.I.G. MACRO V04.00 00:03:00 PAGE 7-7 366 005000 010446 DODOE: MOV IP,-(RP) 367 005002 012204 MOV (W)+,IP 368 005004 010245 MOV W,-(S) 369 005006 NEXT 370 ; 371 005012 HEAD 205,COUNT,324,COUNT,DOCOL ; ***** COUNT 372 ; CONVERT STRING TO THE FORMAT USED BY 'TYPE'. 373 005024 002076' 003344' 002050' .WORD DUP,ONEP,SWAP,CAT,SEMIS 005032 002240' 001440' 374 ; 375 005036 HEAD 204,TYPE,240,TYPE,DOCOL ; ***** TYPE 376 005050 003776' 000144' 000030 .WORD DDUP,ZBRAN,XXL2-.,OVER,PLUS,SWAP,XDO 005056 002004' 001656' 002050' 005064 000334' 377 005066 000360' 002240' 001020' XXL1: .WORD I,CAT,EMIT,XLOOP,XXL1-.,BRAN,XXL3-. 005074 000202' 177770 000122' 005102 000004 378 005104 002026' XXL2: .WORD DROP 379 005106 001440' XXL3: .WORD SEMIS 380 ; 381 005110 HEAD 206,=CELLS,240,ECELL,DOCOL ; ***** =CELLS 382 ; NOTE - I NEED THIS, TO FORCE EVEN ADDRESS. 383 005124 002076' 002542' 001302' .WORD DUP,ONE,AND,PLUS,SEMIS 005132 001656' 001440' 384 ; 385 005136 HEAD 211,-TRAILING,307,DTRAI,DOCOL ; ***** -TRAILING 386 005154 002076' 002532' 000334' .WORD DUP,ZERO,XDO 387 005162 002004' 002004' 001656' XXW6: .WORD OVER,OVER,PLUS,ONE,SUB,CAT 005170 002542' 003516' 002240' 388 005176 002574' 003516' 000144' .WORD BL,SUB,ZBRAN,XXW7-.,LEAVE,BRAN,XXWA-. 005204 000010 001460' 000122' 005212 000006 389 005214 002542' 003516' XXW7: .WORD ONE,SUB 390 005220 000202' 177740 001440' XXWA: .WORD XLOOP,XXW6-.,SEMIS 391 ; 392 005226 HEAD 204,(."),240,PDOTQ,DOCOL ; ***** (.") 393 ; USED ONLY BY COMPILER. COMPILED BY '."' 394 005240 001532' 005022' 002076' .WORD R,COUNT,DUP,ONEP,ECELL 005246 003344' 005122' 395 005252 001516' 001656' 001500' .WORD FROMR,PLUS,TOR,TYPE,SEMIS 005260 005046' 001440' 396 ; 397 005264 HEAD 302,.",240,DOTQ,DOCOL ; ***** ." 398 ; TYPE ASCII MESSAGE. 399 005274 000060' 000042 003206' .WORD LIT,34.,STATE,AT,ZBRAN,XXL6-. 005302 002220' 000144' 000026 400 005310 004500' 005236' 006102' .WORD COMP,PDOTQ,WORD,HERE,CAT,ONEP,ECELL 005316 003442' 002240' 003344' 005324 005122' 401 005326 003462' 000122' 000012 .WORD ALLOT,BRAN,XXL7-. 402 005334 006102' 003442' 005022' XXL6: .WORD WORD,HERE,COUNT,TYPE 005342 005046' 403 005344 001440' XXL7: .WORD SEMIS 404 ; 405 005346 HEAD 206,?ALIGN,240,QALIG,DOCOL ; ***** ?ALIGN 406 005362 003442' 002542' 001302' .WORD HERE,ONE,AND,ALLOT,SEMIS 005370 003462' 001440' F.I.G. MACRO V04.00 00:03:00 PAGE 7-8 407 ; 408 005374 HEAD 206,EXPECT,240,EXPEC,DOCOL ; ***** EXPECT 409 ; READ N CHARACTERS TO MEMORY (AND TERMINATE WITH NULLS). 410 ; ( ADDRESS N ==>). 411 005410 002004' 001656' 002004' .WORD OVER,PLUS,OVER,XDO 005416 000334' 412 005420 001030' 002076' 000060' XXK1: .WORD KEY,DUP,LIT,16,PORIG,AT,EQUAL,ZBRAN,XXK2-. 005426 000016 002654' 002220' 005434 003604' 000144' 000040 413 005442 002026' 000060' 000010 .WORD DROP,LIT,10,OVER,I,EQUAL,DUP,FROMR 005450 002004' 000360' 003604' 005456 002076' 001516' 414 005462 002552' 003516' 001656' .WORD TWO,SUB,PLUS,TOR,SUB,BRAN,XXK3-. 005470 001500' 003516' 000122' 005476 000060 415 005500 002076' 000060' 000015 XXK2: .WORD DUP,LIT,15,EQUAL,ZBRAN,XXK4-. 005506 003604' 000144' 000016 416 005514 001460' 002026' 002574' .WORD LEAVE,DROP,BL,ZERO,BRAN,XXK5-. 005522 002532' 000122' 000004 417 005530 002076' XXK4: .WORD DUP 418 005532 000360' 002312' 002532' XXK5: .WORD I,CSTOR,ZERO,I,ONEP,CSTOR,ZERO,I,TWOP,CSTOR 005540 000360' 003344' 002312' 005546 002532' 000360' 003362' 005554 002312' 419 ; NOTE DIFFERENCE FOR STAND-ALONE, BELOW 420 .IFDF ALONE 421 005556 001020' 000202' 177636 XXK3: .WORD EMIT,XLOOP,XXK1-.,DROP,SEMIS 005564 002026' 001440' 422 .IFF 423 XXK3: .WORD DROP,XLOOP,XXK1-.,DROP,SEMIS 424 .ENDC 425 ; 426 005570 HEAD 205,QUERY,331,QUERY,DOCOL ; ***** QUERY 427 005602 002720' 002220' 000060' .WORD TIB,AT,LIT,120,EXPEC,ZERO,IN,STORE,SEMIS 005610 000120 005406' 002532' 005616 003074' 002264' 001440' 428 ; 429 005624 HEAD 301,X,200,NULL,DOCOL ; ***** THE NULL 430 ; THE NULL OPERATION (ASCII 0) STOPS INTERPRETATION/COMPILATION 431 ; AT END OF A TERMINAL INPUT LINE, OR A DISK SCREEN. ALL DISK 432 ; BUFFERS MUST TERMINATE WITH NULLS, AND 'EXPECT' PLACES NULLS 433 ; AFTER EACH TERMINAL INPUT LINE. 434 ; NOTE THAT THE 'X' IN THE HEADER ABOVE WILL BE CHANGED TO A NULL. 435 005632 003062' 002220' .WORD BLK,AT 436 005636 000144' 000046 002542' .WORD ZBRAN,XXJ2-.,ONE,BLK,PSTOR,ZERO,IN,STORE 005644 003062' 002114' 002532' 005652 003074' 002264' 437 005656 003062' 002220' 002636' .WORD BLK,AT,BSCR,MOD,ZEQU,ZBRAN,XXJ1-.,QEXEC,FROMR,DROP 005664 010626' 001550' 000144' 005672 000010 004334' 001516' 005700 002026' 438 005702 000122' 000006 XXJ1: .WORD BRAN,XXJ4-. 439 005706 001516' 002026' XXJ2: .WORD FROMR,DROP 440 005712 001440' XXJ4: .WORD SEMIS 441 ; 442 005714 HEAD 204,FILL,240,FILL,DOCOL ; ***** FILL 443 005726 002050' 001500' 002004' .WORD SWAP,TOR,OVER,CSTOR,DUP,ONEP,FROMR F.I.G. MACRO V04.00 00:03:00 PAGE 7-9 005734 002312' 002076' 003344' 005742 001516' 444 005744 002542' 003516' 001070' .WORD ONE,SUB,CMOVE,SEMIS 005752 001440' 445 ; 446 005754 HEAD 205,ERASE,305,ERASE,DOCOL ; ***** ERASE 447 005766 002532' 005724' 001440' .WORD ZERO,FILL,SEMIS 448 ; 449 005774 HEAD 206,BLANKS,240,BLANK,DOCOL ; ***** BLANKS 450 006010 002574' 005724' 001440' .WORD BL,FILL,SEMIS 451 ; 452 006016 HEAD 204,HOLD,240,HOLD,DOCOL ; ***** HOLD 453 006030 000060' 177777 003304' .WORD LIT,-1,HLD,PSTOR,HLD,AT,CSTOR,SEMIS 006036 002114' 003304' 002220' 006044 002312' 001440' 454 ; 455 006050 HEAD 203,PAD,304,PAD,DOCOL ; ***** PAD 456 006060 003442' 000060' 000104 .WORD HERE,LIT,104,PLUS,SEMIS 006066 001656' 001440' 457 ; 458 006072 HEAD 204,WORD,240,WORD,DOCOL ; ***** WORD 459 006104 003062' 002220' 000144' .WORD BLK,AT,ZBRAN,XXI1-.,BLK,AT,BLOCK,BRAN,XXI2-. 006112 000014 003062' 002220' 006120 011406' 000122' 000006 460 006126 002720' 002220' XXI1: .WORD TIB,AT 461 006132 003074' 002220' 001656' XXI2: .WORD IN,AT,PLUS,SWAP,ENCL,HERE,LIT,42,BLANK,IN 006140 002050' 000676' 003442' 006146 000060' 000042 006006' 006154 003074' 462 006156 002114' 002004' 003516' .WORD PSTOR,OVER,SUB,TOR,R,HERE,CSTOR,PLUS 006164 001500' 001532' 003442' 006172 002312' 001656' 463 006176 003442' 003344' 001516' .WORD HERE,ONEP,FROMR,CMOVE,SEMIS 006204 001070' 001440' 464 ; 465 ; 466 006210 HEAD 210,(NUMBER),240,PNUMB,DOCOL ; ***** (NUMBER) 467 006226 003344' 002076' 001500' XXF3: .WORD ONEP,DUP,TOR,CAT,BASE,AT,DIGIT 006234 002240' 003222' 002220' 006242 000400' 468 006244 000144' 000054 002050' .WORD ZBRAN,XXG4-.,SWAP,BASE,AT,USTAR,DROP 006252 003222' 002220' 001132' 006260 002026' 469 006262 003716' 003222' 002220' .WORD ROT,BASE,AT,USTAR,DPLUS 006270 001132' 001674' 470 006274 003234' 002220' 003344' .WORD DPL,AT,ONEP,ZBRAN,XXG5-.,ONE,DPL,PSTOR 006302 000144' 000010 002542' 006310 003234' 002114' 471 006314 001516' 000122' 177706 XXG5: .WORD FROMR,BRAN,XXF3-. 472 006322 001516' 001440' XXG4: .WORD FROMR,SEMIS 473 ; 474 006326 HEAD 206,NUMBER,240,NUMB,DOCOL ; ***** NUMBER 475 006342 002532' 002532' 003716' .WORD ZERO,ZERO,ROT,DUP,ONEP,CAT,LIT,55,EQUAL 006350 002076' 003344' 002240' 006356 000060' 000055 003604' 476 006364 002076' 001500' 001656' .WORD DUP,TOR,PLUS,LIT,-1 006372 000060' 177777 F.I.G. MACRO V04.00 00:03:00 PAGE 7-10 477 006376 003234' 002264' 006224' XXF6: .WORD DPL,STORE,PNUMB,DUP,CAT,BL,SUB 006404 002076' 002240' 002574' 006412 003516' 478 006414 000144' 000026 002076' .WORD ZBRAN,XXF7-.,DUP,CAT,LIT,56,SUB 006422 002240' 000060' 000056 006430 003516' 479 006432 002532' 004252' 002532' .WORD ZERO,QERR,ZERO,BRAN,XXF6-. 006440 000122' 177734 480 006444 002026' 001516' 000144' XXF7: .WORD DROP,FROMR,ZBRAN,XXFA-.,DMINU 006452 000004 001756' 481 006456 001440' XXFA: .WORD SEMIS 482 ; 483 006460 HEAD 205,-FIND,304,DFIND,DOCOL ; ***** -FIND 484 006472 002574' 006102' 003442' .WORD BL,WORD,HERE,COUNT,UPPER,HERE,CONT,AT,AT,PFIND 006500 005022' 006550' 003442' 006506 003154' 002220' 002220' 006514 000506' 485 006516 002076' 001550' 000144' .WORD DUP,ZEQU,ZBRAN,XXE3-.,DROP,HERE,LATES,PFIND 006524 000012 002026' 003442' 006532 004074' 000506' 486 006536 001440' XXE3: .WORD SEMIS 487 ; 488 006540 HEAD 205,UPPER,322,UPPER,DOCOL ; ***** UPPER 489 ; SETS STRINGS TO UPPER CASE - TO ALLOW 490 ; LOWER AS WELL AS UPPER CASE FROM TERMINAL. 491 006552 002004' 001656' 002050' .WORD OVER,PLUS,SWAP,XDO 006560 000334' 492 006562 000360' 002240' 000060' XXE2: .WORD I,CAT,LIT,140,GREAT,I,CAT,LIT,173,LESS 006570 000140 003664' 000360' 006576 002240' 000060' 000173 006604 003634' 493 006606 001302' 000144' 000012 .WORD AND,ZBRAN,XXE1-.,I,LIT,40,TOGGL 006614 000360' 000060' 000040 006622 002146' 494 006624 000202' 177734 001440' XXE1: .WORD XLOOP,XXE2-.,SEMIS 495 ; 496 006632 HEAD 207,(ABORT),251,PABOR,DOCOL ; ***** (ABORT) 497 006646 010030' 001440' .WORD ABORT,SEMIS 498 ; 499 006652 HEAD 205,ERROR,322,ERROR,DOCOL ; ***** ERROR 500 006664 002752' 002220' 001600' .WORD WARN,AT,ZLESS,ZBRAN,XXN4-.,PABOR 006672 000144' 000004 006644' 501 006700 003442' 005022' 005046' XXN4: .WORD HERE,COUNT,TYPE,PDOTQ 006706 005236' 502 006710 003 .BYTE 3 503 006711 040 077 040 .ASCII / ? / 504 .EVEN 505 006714 011642' 001400' 003074' .WORD MESS,SPSTO,IN,AT,BLK,AT,QUIT,SEMIS 006722 002220' 003062' 002220' 006730 007752' 001440' 506 ; 507 006734 HEAD 203,ID.,256,IDDOT,DOCOL ; ***** ID. 508 006744 006056' 000060' 000040 .WORD PAD,LIT,40,LIT,137,FILL,DUP 006752 000060' 000137 005724' 006760 002076' 509 006762 004200' 004114' 002004' .WORD PFA,LFA,OVER,SUB,PAD,SWAP,CMOVE 006770 003516' 006056' 002050' F.I.G. MACRO V04.00 00:03:00 PAGE 7-11 006776 001070' 510 007000 006056' 005022' 000060' .WORD PAD,COUNT,LIT,37,AND,TYPE,SPACE,SEMIS 007006 000037 001302' 005046' 007014 003754' 001440' 511 ; 512 007020 HEAD 206,CREATE,240,CREAT,DOCOL ; ***** CREATE 513 007034 006470' 000144' 000020 .WORD DFIND,ZBRAN,XXD2-.,DROP,NFA,IDDOT 007042 002026' 004152' 006742' 514 007050 000060' 000004 011642' .WORD LIT,4,MESS,SPACE 007056 003754' 515 007060 003442' 002076' 002240' XXD2: .WORD HERE,DUP,CAT,WIDTH,AT,MIN,ONEP,ALLOT 007066 002734' 002220' 010410' 007074 003344' 003462' 516 007100 005360' 002076' 000060' .WORD QALIG,DUP,LIT,240,TOGGL,HERE,ONE,SUB 007106 000240 002146' 003442' 007114 002542' 003516' 517 007120 000060' 000200 002146' .WORD LIT,200,TOGGL,LATES,COMMA,CURR,AT,STORE 007126 004074' 003476' 003172' 007134 002220' 002264' 518 007140 003442' 003362' 003476' .WORD HERE,TWOP,COMMA,SEMIS 007146 001440' 519 ; 520 007150 HEAD 311,[COMPILE],335,BCOMP,DOCOL ; ***** [COMPILE] 521 007166 006470' 001550' 002532' .WORD DFIND,ZEQU,ZERO,QERR,DROP,CFA,COMMA,SEMIS 007174 004252' 002026' 004134' 007202 003476' 001440' 522 ; 523 007206 HEAD 307,LITERAL,314,LITER,DOCOL ; ***** LITERAL 524 007222 003206' 002220' 000144' .WORD STATE,AT,ZBRAN,XXD6-.,COMP,LIT,COMMA 007230 000010 004500' 000060' 007236 003476' 525 007240 001440' XXD6: .WORD SEMIS 526 ; 527 007242 HEAD 310,DLITERAL,240,DLITE,DOCOL ; ***** DLITERAL 528 007260 003206' 002220' 000144' .WORD STATE,AT,ZBRAN,XXN5-.,SWAP,LITER,LITER 007266 000010 002050' 007220' 007274 007220' 529 007276 001440' XXN5: .WORD SEMIS 530 ; 531 007300 HEAD 202,U<,240,ULESS,DOCOL ; ***** U< 532 ; UNSIGNED LESS-THAN, NEEDED FOR '?STACK' 533 ; : U< >R 0 R> 0 DMINUS D+ SWAP DROP 0< ; 534 007310 001500' 002532' 001516' .WORD TOR,ZERO,FROMR,ZERO,DMINU,DPLUS 007316 002532' 001756' 001674' 535 007324 002050' 002026' 001600' .WORD SWAP,DROP,ZLESS,SEMIS 007332 001440' 536 ; 537 007334 HEAD 202,D<,240,DLESS,DOCOL ; ***** D< 538 ; DOUBLE PRECISION LESS-THAN 539 ; : D< DMINUS D+ SWAP DROP 0< ; 540 007344 001756' 001674' 002050' .WORD DMINU,DPLUS,SWAP,DROP,ZLESS,SEMIS 007352 002026' 001600' 001440' 541 ; 542 007360 HEAD 206,?STACK,240,QSTAC,DOCOL ; ***** ?STACK 543 ; ERROR CHECK. 544 007374 002674' 002220' 002552' .WORD SZERO,AT,TWO,SUB,SPAT,ULESS,ONE,QERR 007402 003516' 001360' 007306' F.I.G. MACRO V04.00 00:03:00 PAGE 7-12 007410 002542' 004252' 545 007414 001360' 003442' 000060' .WORD SPAT,HERE,LIT,200,PLUS,ULESS,TWO,QERR 007422 000200 001656' 007306' 007430 002552' 004252' 546 007434 001440' .WORD SEMIS 547 ; 548 007436 HEAD 211,INTERPRET,324,INTER,DOCOL ; ***** INTERPRET 549 007454 006470' XXE4: .WORD DFIND 550 007456 000144' 000036 003206' .WORD ZBRAN,XXEA-.,STATE,AT,LESS 007464 002220' 003634' 551 007470 000144' 000012 004134' .WORD ZBRAN,XXE5-.,CFA,COMMA,BRAN,XXE6-. 007476 003476' 000122' 000006 552 007504 004134' 000102' XXE5: .WORD CFA,EXEC 553 007510 007372' 000122' 000034 XXE6: .WORD QSTAC,BRAN,XXE7-. 554 007516 003442' 006340' 003234' XXEA: .WORD HERE,NUMB,DPL,AT,ONEP,ZBRAN,XXF4-.,DLITE,BRAN,XXF5-. 007524 002220' 003344' 000144' 007532 000010 007256' 000122' 007540 000006 555 007542 002026' 007220' XXF4: .WORD DROP,LITER 556 007546 007372' XXF5: .WORD QSTAC 557 007550 000122' 177702 XXE7: .WORD BRAN,XXE4-. 558 ; 559 007554 HEAD 211,IMMEDIATE,305,IMMED,DOCOL ; ***** IMMEDIATE 560 007572 004074' 000060' 000100 .WORD LATES,LIT,100,TOGGL,SEMIS 007600 002146' 001440' 561 ; 562 007604 HEAD 212,VOCABULARY,240,VOCAB,DOCOL ; ***** VOCABULARY 563 007624 004744' 000060' 120201 .WORD BUILD,LIT,120201,COMMA,CURR,AT,CFA,COMMA 007632 003476' 003172' 002220' 007640 004134' 003476' 564 007644 003442' 003020' 002220' .WORD HERE,VOCL,AT,COMMA,VOCL,STORE,DOES 007652 003476' 003020' 002264' 007660 004764' 565 007662 003362' 003154' 002264' DOVOC: .WORD TWOP,CONT,STORE,SEMIS 007670 001440' 566 ; 567 ; 568 ; ***** THE DEFINITION OF 'FORTH' WAS MOVED TO NEAR THE END OF THE 569 ; DICTIONARY, BECAUSE IT IS NOT PURE CODE. 570 ; 571 ; 572 007672 HEAD 213,DEFINITIONS,323,DEFIN,DOCOL ; ***** DEFINITIONS 573 007712 003154' 002220' 003172' .WORD CONT,AT,CURR,STORE,SEMIS 007720 002264' 001440' 574 ; 575 007724 HEAD 301,(,250,PAREN,DOCOL ; ***** ( 576 007732 000060' 000051 006102' .WORD LIT,51,WORD,SEMIS 007740 001440' 577 ; 578 007742 HEAD 204,QUIT,240,QUIT,DOCOL ; ***** QUIT 579 007754 002532' 003062' 002264' .WORD ZERO,BLK,STORE,LBRAC 007762 004526' 580 007764 001420' 001056' 005600' XXB1: .WORD RPSTO,CR,QUERY,INTER,STATE,AT 007772 007452' 003206' 002220' 581 010000 001550' 000144' 000010 .WORD ZEQU,ZBRAN,XXB2-.,PDOTQ 010006 005236' 582 010010 003 .BYTE 3 F.I.G. MACRO V04.00 00:03:00 PAGE 7-13 583 010011 040 117 113 .ASCII / OK/ 584 .EVEN 585 010014 000122' 177746 XXB2: .WORD BRAN,XXB1-. 586 ; 587 010020 HEAD 205,ABORT,324,ABORT,DOCOL ; ***** ABORT 588 010032 001400' 004642' 003754' .WORD SPSTO,DEC,SPACE 589 010040 001056' 005236' .WORD CR,PDOTQ 590 010044 023 .BYTE 23 591 010045 106 111 107 .ASCII /FIG-FORTH V 1.3.3 / 010050 055 106 117 010053 122 124 110 010056 040 040 126 010061 040 061 056 010064 063 056 063 010067 040 592 .EVEN 593 010070 015312' 007710' 007752' .WORD FORTH,DEFIN,QUIT 594 ; 595 010076 HEAD 203,NOT,324,NOT,DOCOL ; ***** NOT 596 010106 001550' 001440' .WORD ZEQU,SEMIS 597 ; 598 ; COLD AND WARM STARTS 599 ; 600 010112 HEAD 204,COLD,240,COLD ; ***** COLD 601 010124 CENT: ; COLD START ENTRY POINT 602 010124 016767 167664 005166 MOV ORIGIN+14,FORTH+6 ; SET 'FORTH' VOCABULARY FROM STARTUP TABLE 603 010132 016703 167662 MOV ORIGIN+20,U ; INITIALIZE USER POINTER 604 ; NOTE - FOR SMALLER STAND-ALONE BOOT, INITIALIZE AREAS IN 605 ; HIGH MEMORY WHICH MUST BE INITIALIZED. 606 ; CLEAR DISK BUFFERS ON FIRST TIME THROUGH 607 010136 016700 167700 MOV ORIGIN+42,R0 ; 'FIRST' - BEGINNING OF DISK BUFFERS 608 010142 016701 167676 MOV ORIGIN+44,R1 ; 'LIMIT' - JUST BEYOND DISK BUFFERS 609 010146 005020 1$: CLR (R0)+ 610 010150 020001 CMP R0,R1 611 010152 002775 BLT 1$ 612 ; NOW INITIALIZE 'OUT', 'OFFSET', 'USE' AND 'PREV' 613 010154 005063 000042 CLR 42(U) ; CLEAR 'OUT' 614 010160 005063 000046 CLR 46(U) ; CLEAR 'OFFSET' 615 010164 016763 167652 000072 MOV ORIGIN+42,72(U) ; TO 'USE' 616 010172 016763 167644 000074 MOV ORIGIN+42,74(U) ; TO 'PREV' 617 ; INITIALIZE VIDEO TERMINAL CURSOR POSITION 618 010200 012767 000000 053042 MOV #0,OUTPOS 619 ; END OF SPECIAL HIGH-MEMORY INITIALIZE 620 010206 012701 000030 MOV #30,R1 ; ON COLD START, MOVE 24. BYTES 621 010212 000402 BR W2 622 010214 WENT: ; WARM START ENTRY POINT 623 010214 012701 000012 MOV #12,R1 ; ON WARM START, MOVE TEN BYTES 624 010220 012705 000022' W2: MOV #ORIGIN+22,R5 ; START MOVING FROM HERE 625 010224 016700 167570 MOV ORIGIN+20,R0 ; MOVE TO THE USER AREA 626 010230 062700 000006 ADD #6,R0 ; PLUS 6 627 010234 060501 ADD R5,R1 ; COMPUTE LOOP STOP ADDRESS 628 010236 012520 1$: MOV (R5)+,(R0)+ 629 010240 020501 CMP R5,R1 630 010242 002775 BLT 1$ 631 010244 016706 167554 MOV ORIGIN+24,RP ; INITIALIZE THE RETURN-STACK POINTER 632 ; NOW SET FORTH'S INSTRUCTION COUNTER, AND GO 633 010250 012704 010260' MOV #GO,IP ; START EXECUTION WITH 'ABORT' F.I.G. MACRO V04.00 00:03:00 PAGE 7-14 634 010254 NEXT 635 ; NOTE - NORMALLY THE ABOVE INSTRUCTION WOULD BE 'MOV #ABORT+2,IP'. 636 ; IT HAS BEEN CHANGED HERE TO ALLOW USER TO PATCH A DIFFERENT 637 ; START-UP. BUT THE SYSTEM WON'T WORK UNTIL SOME OF THE WORK 638 ; OF 'ABORT' HAS BEEN DONE, SO THAT WORK IS REPEATED. THE USER 639 ; CAN PATCH OVER THE 'ABORT' AND THE ZEROS. 640 ; 641 010260 001400' 004642' 015312' GO: .WORD SPSTO,DEC,FORTH,DEFIN,ABORT,0,0,0 010266 007710' 010030' 000000 010274 000000 000000 642 ; 643 ; 644 ; 645 ; 646 ; 647 010300 HEAD 204,S->D,240,STOD ; ***** S->D 648 010312 005045 CLR -(S) ; SIGN EXTEND WITH ZEROS 649 010314 005765 000002 TST 2(S) ; BUT IF NEGATIVE, 650 010320 100001 BPL 1$ 651 010322 005315 DEC (S) ; CHANGE THE ZEROS TO ONES 652 010324 1$: NEXT 653 ; 654 ; NOTE - THIS SYSTEM DOESN'T NEED THE OPERATIONS '+-' AND 'D+-', 655 ; BECAUSE 'M*' AND 'M/' ARE DEFINED IN CODE. 656 ; 657 010330 HEAD 203,ABS,323,ABS,DOCOL ; ***** ABS 658 010340 002076' 001600' 000144' .WORD DUP,ZLESS,ZBRAN,XXR5-.,MINUS 010346 000004 001734' 659 010352 001440' XXR5: .WORD SEMIS 660 ; 661 010354 HEAD 204,DABS,240,DABS,DOCOL ; ***** DABS 662 010366 002076' 001600' 000144' .WORD DUP,ZLESS,ZBRAN,XXRB-.,DMINU 010374 000004 001756' 663 010400 001440' XXRB: .WORD SEMIS 664 ; 665 010402 HEAD 203,MIN,316,MIN,DOCOL ; ***** MIN 666 010412 002004' 002004' 003664' .WORD OVER,OVER,GREAT,ZBRAN,XXR7-.,SWAP 010420 000144' 000004 002050' 667 010426 002026' 001440' XXR7: .WORD DROP,SEMIS 668 ; 669 010432 HEAD 203,MAX,330,MAX,DOCOL ; ***** MAX 670 010442 002004' 002004' 003634' .WORD OVER,OVER,LESS,ZBRAN,XXR6-.,SWAP 010450 000144' 000004 002050' 671 010456 002026' 001440' XXR6: .WORD DROP,SEMIS 672 ; 673 010462 HEAD 202,M*,240,MSTAR ; ***** M* 674 .IFDF EIS ; HARDWARE MULTIPLY/DIVIDE? 675 010472 012500 MOV (S)+,R0 676 010474 070015 MUL (S),R0 677 010476 010115 MOV R1,(S) 678 010500 010045 MOV R0,-(S) 679 010502 NEXT 680 .IFF 681 MOV 2(S),-(RP) ; USE RETURN STACK FOR SAVING SIGN 682 BPL 1$ 683 NEG 2(S) ; GET ABSOLUTE VALUE 684 1$: TST (S) F.I.G. MACRO V04.00 00:03:00 PAGE 7-15 685 BPL 2$ 686 NEG (RP) ; ADJUST SIGN WHICH WAS SAVED 687 NEG (S) ; GET ABSOLUTE VALUE 688 2$: JSR PC,UMULT 689 TST (RP)+ ; NEGATIVE RESULT? 690 BPL 3$ ; NO 691 ; IF GET HERE, NEGATE THE DOUBLE-INTEGER NUMBER ON THE STACK 692 COM (S) 693 COM 2(S) 694 ADD #1,2(S) 695 ADC (S) 696 3$: NEXT 697 .ENDC 698 ; 699 010506 HEAD 202,M/,240,MSLAS ; ***** M/ 700 .IFDF EIS ; HARDWARD MULTIPLY/DIVIDE? 701 010516 016500 000002 MOV 2(S),R0 702 010522 016501 000004 MOV 4(S),R1 703 010526 071025 DIV (S)+,R0 704 010530 010165 000002 MOV R1,2(S) 705 010534 010015 MOV R0,(S) 706 010536 NEXT 707 .IFF 708 MOV 2(S),-(RP) ; SAVE DIVIDEND SIGN 709 BNE 5$ ; ZERO WOULDN'T INDICATE 710 INC (RP) ; A SIGN CHANGE. 711 5$: MOV (RP),-(RP) ; DUPLICATE IT 712 BPL 1$ 713 ; IF GET HERE, TAKE ABSOLUTE VALUE OF DOUBLE-INTEGER DIVIDEND. 714 COM 2(S) 715 COM 4(S) 716 ADD #1,4(S) 717 ADC 2(S) 718 1$: TST (S) ; IS DIVISOR NEGATIVE? 719 BPL 2$ 720 NEG (RP) ; IF YES, NEGATE QUOTIENT SIGN 721 NEG (S) ; AND TAKE ABS. VALUE OF DIVISOR 722 2$: JSR PC,UDIV 723 TST (RP)+ ; NEGATIVE QUOTIENT? 724 BPL 3$ ; NO 725 NEG (S) ; NEGATE THE QUOTIENT 726 3$: TST (RP)+ ; NEGATIVE DIVIDEND? 727 BPL 4$ ; NEGATE THE REMAINDER 728 NEG 2(S) 729 4$: NEXT 730 .ENDC 731 ; 732 010542 HEAD 201,*,252,STAR,DOCOL ; ***** * 733 010550 010470' 002026' 001440' .WORD MSTAR,DROP,SEMIS 734 ; 735 010556 HEAD 204,/MOD,240,SLMOD,DOCOL ; ***** /MOD 736 010570 001500' 010310' 001516' .WORD TOR,STOD,FROMR,MSLAS,SEMIS 010576 010514' 001440' 737 ; 738 010602 HEAD 201,/,257,SLASH,DOCOL ; ***** / 739 010610 010566' 002050' 002026' .WORD SLMOD,SWAP,DROP,SEMIS 010616 001440' F.I.G. MACRO V04.00 00:03:00 PAGE 7-16 740 ; 741 010620 HEAD 203,MOD,304,MOD,DOCOL ; ***** MOD 742 010630 010566' 002026' 001440' .WORD SLMOD,DROP,SEMIS 743 ; 744 010636 HEAD 205,*/MOD,304,SSMOD,DOCOL ; ***** */MOD 745 010650 001500' 010470' 001516' .WORD TOR,MSTAR,FROMR,MSLAS,SEMIS 010656 010514' 001440' 746 ; 747 010662 HEAD 202,*/,240,SSLA,DOCOL ; ***** */ 748 010672 010646' 002050' 002026' .WORD SSMOD,SWAP,DROP,SEMIS 010700 001440' 749 ; 750 010702 HEAD 205,M/MOD,304,MSMOD,DOCOL ; ***** M/MOD 751 010714 001500' 002532' 001532' .WORD TOR,ZERO,R,USLAS,FROMR 010722 001214' 001516' 752 010726 002050' 001500' 001214' .WORD SWAP,TOR,USLAS,FROMR,SEMIS 010734 001516' 001440' 753 ; 754 ; 755 ; 756 ; 757 ; F.I.G. MACRO V04.00 00:03:00 PAGE 8 1 ; **************************************************************** 2 ; 3 ; DISK I/O (SECTION COMMON TO ALL OPERATING SYSTEMS) 4 ; NOTE THAT EACH OPERATING SYSTEM DEFINED 'R/W' - READ 5 ; OR WRITE A 1024-BYTE RANDOM-ACCESS BLOCK. 6 ; 7 ; **************************************************************** 8 ; 9 ; 10 ; 'USE' AND 'PREV' MOVED TO USER AREA 11 ; 12 010740 HEAD 204,+BUF,240,PBUF,DOCOL ; ***** +BUF 13 010752 002622' 000060' 000004 .WORD BBUF,LIT,4,PLUS,PLUS,DUP,LIMIT,AT,EQUAL 010760 001656' 001656' 002076' 010766 003050' 002220' 003604' 14 010774 000144' 000010 002026' .WORD ZBRAN,XXT1-.,DROP,FIRST,AT 011002 003034' 002220' 15 011006 002076' 003332' 002220' XXT1: .WORD DUP,PREV,AT,SUB,SEMIS 011014 003516' 001440' 16 ; 17 011020 HEAD 206,UPDATE,240,UPDAT,DOCOL ; ***** UPDATE 18 011034 003332' 002220' 002220' .WORD PREV,AT,AT,LIT,100000,OR,PREV 011042 000060' 100000 001322' 011050 003332' 19 011052 002220' 002264' 001440' .WORD AT,STORE,SEMIS 20 ; 21 011060 HEAD 215,EMPTY-BUFFERS,323,MTBUF,DOCOL ; ***** EMPTY-BUFFERS 22 011102 003034' 002220' 003050' .WORD FIRST,AT,LIMIT,AT,OVER,SUB,ERASE,SEMIS 011110 002220' 002004' 003516' 011116 005764' 001440' 23 ; 24 011122 HEAD 205,FLUSH,310,FLUSH,DOCOL ; ***** FLUSH 25 ; SOME SYSTEMS DEFINE THIS IN THE EDITOR, NOT HERE. 26 011134 003050' 002220' 003034' .WORD LIMIT,AT,FIRST,AT,XDO 011142 002220' 000334' 27 011146 000360' 002220' 001600' XXTA: .WORD I,AT,ZLESS,ZBRAN,XXT7-.,I,TWOP,I,AT 011154 000144' 000024 000360' 011162 003362' 000360' 002220' 28 011170 000060' 077777 001302' .WORD LIT,77777,AND,ZERO,RW 011176 002532' 015234' 29 011202 002622' 000060' 000004 XXT7: .WORD BBUF,LIT,4,PLUS,XPLOO,XXTA-.,MTBUF,SEMIS 011210 001656' 000250' 177732 011216 011100' 001440' 30 ; 31 011222 HEAD 203,DR0,260,DRZER,DOCOL ; ***** DR0 32 ; SELECT DRIVE #0 - NOT USED WITH RT11 OR RSX11 33 011232 002532' 003136' 002264' .WORD ZERO,OFSET,STORE,SEMIS 011240 001440' 34 ; 35 011242 HEAD 203,DR1,261,DRONE,DOCOL ; ***** DR1 36 ; SELECT DRIVE #1 - NOT USED IN RSX11 OR RT11 37 011252 000060' 000360 003136' .WORD LIT,240.,OFSET,STORE,SEMIS 011260 002264' 001440' 38 ; 39 011264 HEAD 206,BUFFER,240,BUFFE,DOCOL ; ***** BUFFER 40 011300 003316' 002220' 002076' .WORD USE,AT,DUP,TOR 011306 001500' F.I.G. MACRO V04.00 00:03:00 PAGE 8-1 41 011310 010750' 000144' 177774 XXT2: .WORD PBUF,ZBRAN,XXT2-.,USE,STORE 011316 003316' 002264' 42 011322 001532' 002220' 001600' .WORD R,AT,ZLESS,ZBRAN,XXT3-. 011330 000144' 000024 43 011334 001532' 003362' 001532' .WORD R,TWOP,R,AT,LIT,77777,AND 011342 002220' 000060' 077777 011350 001302' 44 011352 002532' 015234' .WORD ZERO,RW 45 011356 001532' 002264' 001532' XXT3: .WORD R,STORE,R,PREV,STORE,FROMR,TWOP,SEMIS 011364 003332' 002264' 001516' 011372 003362' 001440' 46 ; 47 011376 HEAD 205,BLOCK,313,BLOCK,DOCOL ; ***** BLOCK 48 ; CHANGED TO MASK OFF THE UPDATE BIT WHEN COMPARING 49 011410 003136' 002220' 001656' .WORD OFSET,AT,PLUS,TOR 011416 001500' 50 011420 003332' 002220' 002076' .WORD PREV,AT,DUP,AT,LIT,077777,AND,R,SUB,ZBRAN,XXT4-. 011426 002220' 000060' 077777 011434 001302' 001532' 003516' 011442 000144' 000066 51 011446 010750' 001550' 000144' XXT5: .WORD PBUF,ZEQU,ZBRAN,XXT6-. 011454 000024 52 011456 002026' 001532' 011276' .WORD DROP,R,BUFFE 53 011464 002076' 001532' 002542' .WORD DUP,R,ONE,RW,TWO,SUB 011472 015234' 002552' 003516' 54 011500 002076' 002220' 000060' XXT6: .WORD DUP,AT,LIT,077777,AND,R,SUB,ZEQU 011506 077777 001302' 001532' 011514 003516' 001550' 55 011520 000144' 177724 .WORD ZBRAN,XXT5-. 56 011524 002076' 003332' 002264' .WORD DUP,PREV,STORE 57 011532 001516' 002026' 003362' XXT4: .WORD FROMR,DROP,TWOP,SEMIS 011540 001440' 58 ; 59 ; 60 ; 61 ; 62 ; 63 ; 64 011542 HEAD 206,(LINE),240,PLINE,DOCOL ; ***** (LINE) 65 011556 001500' 002606' 002622' .WORD TOR,CL,BBUF,SSMOD,FROMR,BSCR 011564 010646' 001516' 002636' 66 011572 010546' 001656' 011406' .WORD STAR,PLUS,BLOCK,PLUS,CL,SEMIS 011600 001656' 002606' 001440' 67 ; 68 011606 HEAD 205,.LINE,305,DLINE,DOCOL ; ***** .LINE 69 011620 011554' 005152' 005046' .WORD PLINE,DTRAI,TYPE,SEMIS 011626 001440' 70 ; 71 011630 HEAD 207,MESSAGE,305,MESS,DOCOL ; ***** MESSAGE 72 011644 002752' 002220' 000144' .WORD WARN,AT,ZBRAN,XXW5-.,DDUP,ZBRAN,XXW3-.,LIT,4 011652 000034 003776' 000144' 011660 000022 000060' 000004 73 011666 003136' 002220' 002636' .WORD OFSET,AT,BSCR,SLASH,SUB,DLINE 011674 010606' 003516' 011616' 74 011702 000122' 000016 XXW3: .WORD BRAN,XXW4-. 75 011706 005236' XXW5: .WORD PDOTQ 76 011710 006 .BYTE 6 F.I.G. MACRO V04.00 00:03:00 PAGE 8-2 77 011711 115 123 107 .ASCII /MSG # / 011714 040 043 040 78 .EVEN 79 011720 013236' .WORD DOT 80 011722 001440' XXW4: .WORD SEMIS 81 ; 82 011724 HEAD 204,LOAD,240,LOAD,DOCOL ; ***** LOAD 83 011736 003062' 002220' 001500' .WORD BLK,AT,TOR,IN,AT,TOR,ZERO,IN,STORE 011744 003074' 002220' 001500' 011752 002532' 003074' 002264' 84 011760 002636' 010546' 003062' .WORD BSCR,STAR,BLK,STORE,INTER,FROMR,IN,STORE 011766 002264' 007452' 001516' 011774 003074' 002264' 85 012000 001516' 003062' 002264' .WORD FROMR,BLK,STORE,SEMIS 012006 001440' 86 ; 87 012010 HEAD 303,-->,276,ARROW,DOCOL ; ***** --> 88 012020 004446' 002532' 003074' .WORD QLOAD,ZERO,IN,STORE,BSCR,BLK,AT,OVER 012026 002264' 002636' 003062' 012034 002220' 002004' 89 012040 010626' 003516' 003062' .WORD MOD,SUB,BLK,PSTOR,SEMIS 012046 002114' 001440' 90 ; 91 ; 92 ; 93 ; 94 ; NOTE - THE INSTALLATION-DEPENDENT I/O IS AT THE END 95 ; OF THE DICTIONARY - JUST BELOW 'TASK'. 'XI/O' IS THE 96 ; PRIMITIVE READ OR WRITE OF A 512-BYTE BLOCK. 97 ; 98 ; 99 ; 100 ; 101 ; 102 ; F.I.G. MACRO V04.00 00:03:00 PAGE 9 1 ; **************************************************************** 2 ; 3 ; MISCELLANEOUS HIGHER LEVEL 4 ; 5 ; **************************************************************** 6 ; 7 ; 8 012052 HEAD 301,',247,TICK,DOCOL ; ***** ' 9 012060 006470' 001550' 002532' .WORD DFIND,ZEQU,ZERO,QERR,DROP,LITER,SEMIS 012066 004252' 002026' 007220' 012074 001440' 10 ; 11 012076 HEAD 206,FORGET,240,FORGE,DOCOL ; ***** FORGET 12 012112 003172' 002220' 003154' .WORD CURR,AT,CONT,AT,SUB,LIT,30,QERR,TICK,DUP 012120 002220' 003516' 000060' 012126 000030 004252' 012056' 012134 002076' 13 012136 002766' 002220' 003634' .WORD FENCE,AT,LESS,LIT,25,QERR 012144 000060' 000025 004252' 14 012152 002076' 004152' 003000' .WORD DUP,NFA,DP,STORE,LFA,AT,CONT,AT 012160 002264' 004114' 002220' 012166 003154' 002220' 15 012172 002264' 001440' .WORD STORE,SEMIS 16 ; 17 ; 18 ; 19 ; 20 012176 HEAD 204,BACK,240,BACK,DOCOL ; ***** BACK 21 012210 003442' 003516' 003476' .WORD HERE,SUB,COMMA,SEMIS 012216 001440' 22 ; 23 012220 HEAD 305,BEGIN,316,BEGIN,DOCOL ; ***** BEGIN 24 012232 004304' 003442' 002542' .WORD QCOMP,HERE,ONE,SEMIS 012240 001440' 25 ; 26 012242 HEAD 305,ENDIF,306,ENDIF,DOCOL ; ***** ENDIF 27 012254 004304' 002552' 004364' .WORD QCOMP,TWO,QPAIR,HERE,OVER,SUB,SWAP,STORE,SEMIS 012262 003442' 002004' 003516' 012270 002050' 002264' 001440' 28 ; 29 012276 HEAD 304,THEN,240,THEN,DOCOL ; ***** THEN 30 012310 012252' 001440' .WORD ENDIF,SEMIS 31 ; 32 012314 HEAD 302,DO,240,DO,DOCOL ; ***** DO 33 012324 004500' 000334' 003442' .WORD COMP,XDO,HERE,LIT,3,SEMIS 012332 000060' 000003 001440' 34 ; 35 012340 HEAD 304,LOOP,240,LOOP,DOCOL ; ***** LOOP 36 012352 000060' 000003 004364' .WORD LIT,3,QPAIR,COMP,XLOOP,BACK,SEMIS 012360 004500' 000202' 012206' 012366 001440' 37 ; 38 012370 HEAD 305,+LOOP,320,PLOOP,DOCOL ; ***** +LOOP 39 012402 000060' 000003 004364' .WORD LIT,3,QPAIR,COMP,XPLOO,BACK,SEMIS 012410 004500' 000250' 012206' 012416 001440' 40 ; F.I.G. MACRO V04.00 00:03:00 PAGE 9-1 41 012420 HEAD 305,UNTIL,314,UNTIL,DOCOL ; ***** UNTIL 42 012432 002542' 004364' 004500' .WORD ONE,QPAIR,COMP,ZBRAN,BACK,SEMIS 012440 000144' 012206' 001440' 43 ; 44 012446 HEAD 303,END,304,END,DOCOL ; ***** END 45 012456 012430' 001440' .WORD UNTIL,SEMIS 46 ; 47 012462 HEAD 305,AGAIN,316,AGAIN,DOCOL ; ***** AGAIN 48 012474 002542' 004364' 004500' .WORD ONE,QPAIR,COMP,BRAN,BACK,SEMIS 012502 000122' 012206' 001440' 49 ; 50 012510 HEAD 306,REPEAT,240,REPEAT,DOCOL ; ***** REPEAT 51 012524 001500' 001500' 012472' .WORD TOR,TOR,AGAIN,FROMR,FROMR,TWO,SUB,ENDIF,SEMIS 012532 001516' 001516' 002552' 012540 003516' 012252' 001440' 52 ; 53 012546 HEAD 302,IF,240,IF,DOCOL ; ***** IF 54 012556 004500' 000144' 003442' .WORD COMP,ZBRAN,HERE,ZERO,COMMA,TWO,SEMIS 012564 002532' 003476' 002552' 012572 001440' 55 ; 56 012574 HEAD 304,ELSE,240,ELSE,DOCOL ; ***** ELSE 57 012606 002552' 004364' 004500' .WORD TWO,QPAIR,COMP,BRAN,HERE,ZERO,COMMA 012614 000122' 003442' 002532' 012622 003476' 58 012624 002050' 002552' 012252' .WORD SWAP,TWO,ENDIF,TWO,SEMIS 012632 002552' 001440' 59 ; 60 012636 HEAD 305,WHILE,305,WHILE,DOCOL ; ***** WHILE 61 012650 012554' 003362' 001440' .WORD IF,TWOP,SEMIS 62 ; 63 ; 64 ; 65 ; 66 012656 HEAD 206,SPACES,240,SPACS,DOCOL ; ***** SPACES 67 012672 002532' 010440' 003776' .WORD ZERO,MAX,DDUP,ZBRAN,XXR4-.,ZERO,XDO 012700 000144' 000014 002532' 012706 000334' 68 012710 003754' 000202' 177774 XXRA: .WORD SPACE,XLOOP,XXRA-. 69 012716 001440' XXR4: .WORD SEMIS 70 ; 71 012720 HEAD 202,^/<#/,240,BDIGS,DOCOL ; ***** <# 72 012730 006056' 003304' 002264' .WORD PAD,HLD,STORE,SEMIS 012736 001440' 73 ; 74 012740 HEAD 202,#>,240,EDIGS,DOCOL ; ***** #> 75 012750 002026' 002026' 003304' .WORD DROP,DROP,HLD,AT,PAD,OVER,SUB,SEMIS 012756 002220' 006056' 002004' 012764 003516' 001440' 76 ; 77 012770 HEAD 204,SIGN,240,SIGN,DOCOL ; ***** SIGN 78 013002 003716' 001600' 000144' .WORD ROT,ZLESS,ZBRAN,XXR1-.,LIT,55,HOLD 013010 000010 000060' 000055 013016 006026' 79 013020 001440' XXR1: .WORD SEMIS 80 ; 81 013022 HEAD 201,#,243,DIG,DOCOL ; ***** # F.I.G. MACRO V04.00 00:03:00 PAGE 9-2 82 013030 003222' 002220' 010712' .WORD BASE,AT,MSMOD,ROT,LIT,11,OVER,LESS 013036 003716' 000060' 000011 013044 002004' 003634' 83 013050 000144' 000010 000060' .WORD ZBRAN,XXR2-.,LIT,7,PLUS 013056 000007 001656' 84 013062 000060' 000060 001656' XXR2: .WORD LIT,60,PLUS,HOLD,SEMIS 013070 006026' 001440' 85 ; 86 013074 HEAD 202,#S,240,DIGS,DOCOL ; ***** #S 87 013104 013026' 002004' 002004' XXR3: .WORD DIG,OVER,OVER,OR,ZEQU,ZBRAN,XXR3-.,SEMIS 013112 001322' 001550' 000144' 013120 177764 001440' 88 ; 89 013124 HEAD 203,D.R,322,DDOTR,DOCOL ; ***** D.R 90 013134 001500' 002050' 002004' .WORD TOR,SWAP,OVER,DABS,BDIGS,DIGS,SIGN,EDIGS 013142 010364' 012726' 013102' 013150 013000' 012746' 91 013154 001516' 002004' 003516' .WORD FROMR,OVER,SUB,SPACS,TYPE,SEMIS 013162 012670' 005046' 001440' 92 ; 93 013170 HEAD 202,.R,240,DOTR,DOCOL ; ***** .R 94 013200 001500' 010310' 001516' .WORD TOR,STOD,FROMR,DDOTR,SEMIS 013206 013132' 001440' 95 ; 96 013212 HEAD 202,D.,240,DDOT,DOCOL ; ***** D. 97 013222 002532' 013132' 003754' .WORD ZERO,DDOTR,SPACE,SEMIS 013230 001440' 98 ; 99 013232 HEAD 201,.,256,DOT,DOCOL ; ***** . 100 013240 010310' 013220' 001440' .WORD STOD,DDOT,SEMIS 101 ; 102 013246 HEAD 201,?,277,QUEST,DOCOL ; ***** ? 103 013254 002220' 013236' 001440' .WORD AT,DOT,SEMIS 104 ; 105 013262 HEAD 202,U.,240,UDOT,DOCOL ; ***** U. 106 013272 002532' 013220' 001440' .WORD ZERO,DDOT,SEMIS 107 ; 108 ; UTILITY SECTION. 109 ; 110 ; 111 013300 HEAD 204,LIST,240,LIST,DOCOL ; ***** LIST 112 ; ( N---. LIST GIVEN SCREEN.) 113 013312 004642' 001056' 002076' .WORD DEC,CR,DUP,SCR,STORE,PDOTQ 013320 003120' 002264' 005236' 114 013326 006 .BYTE 6 115 013327 123 103 122 .ASCII /SCR # / 013332 040 043 040 116 .EVEN 117 013336 013236' 000060' 000020 .WORD DOT,LIT,20,ZERO,XDO 013344 002532' 000334' 118 013350 001056' 000360' 002562' XXZ1: .WORD CR,I,THREE,DOTR,SPACE 013356 013176' 003754' 119 013362 000360' 003120' 002220' .WORD I,SCR,AT,DLINE,XLOOP,XXZ1-.,CR,SEMIS 013370 011616' 000202' 177754 013376 001056' 001440' 120 ; 121 013402 HEAD 205,INDEX,330,INDEX,DOCOL ; ***** INDEX F.I.G. MACRO V04.00 00:03:00 PAGE 9-3 122 ; LIST FIRST LINE OF A RANGE OF DISK SCREENS. 123 013414 001056' 003344' 002050' .WORD CR,ONEP,SWAP,XDO 013422 000334' 124 013424 001056' 000360' 002562' XXZ2: .WORD CR,I,THREE,DOTR,SPACE,ZERO,I,DLINE 013432 013176' 003754' 002532' 013440 000360' 011616' 125 013444 001046' 000144' 000004 .WORD QTERM,ZBRAN,XXZ3-.,LEAVE 013452 001460' 126 013454 000202' 177746 001440' XXZ3: .WORD XLOOP,XXZ2-.,SEMIS 127 ; 128 013462 HEAD 205,TRIAD,304,TRIAD,DOCOL ; ***** TRIAD 129 ; LIST DISK SCREENS THREE PER PAGE. 130 013474 000060' 000014 001020' .WORD LIT,14,EMIT ; FORM FEED 131 013502 002562' 010606' 002562' .WORD THREE,SLASH,THREE,STAR,THREE 013510 010546' 002562' 132 013514 002004' 001656' 002050' .WORD OVER,PLUS,SWAP,XDO 013522 000334' 133 013524 001056' 000360' 013310' XXZ4: .WORD CR,I,LIST,XLOOP,XXZ4-.,CR,LIT,17,MESS,CR,SEMIS 013532 000202' 177770 001056' 013540 000060' 000017 011642' 013546 001056' 001440' 134 ; 135 013552 HEAD 205,VLIST,324,VLIST,DOCOL ; ***** VLIST 136 013564 000060' 000200 003106' .WORD LIT,200,OUT,STORE,CONT,AT,AT 013572 002264' 003154' 002220' 013600 002220' 137 013602 003106' 002220' 000060' XXZ5: .WORD OUT,AT,LIT,100,GREAT,ZBRAN,XXZ6-. 013610 000100 003664' 000144' 013616 000012 138 013620 001056' 002532' 003106' .WORD CR,ZERO,OUT,STORE 013626 002264' 139 013630 002076' 006742' 003754' XXZ6: .WORD DUP,IDDOT,SPACE,SPACE,PFA,LFA,AT 013636 003754' 004200' 004114' 013644 002220' 140 013646 002076' 001550' 001046' .WORD DUP,ZEQU,QTERM,OR,ZBRAN,XXZ5-.,DROP,SEMIS 013654 001322' 000144' 177722 013662 002026' 001440' 141 ; 142 .IFDF LINKS 143 HEAD 205,VLINK,313,XVLINK,DOCON ; ***** VLINK 144 ; THIS IS ONLY USED FOR LINKAGE FROM FORTH TO SUBROUTINES 145 ; IN OTHER LANGUAGES. SEE USER'S GUIDE FOR DOCUMENTATION. 146 .WORD VLINK 147 .ENDC 148 ; 149 ; 150 ; 151 ; 152 ; 153 ; F.I.G. MACRO V04.00 00:03:00 PAGE 10 1 ; **************************************************************** 2 ; 3 ; INSTALLATION-DEPENDENT SECTION (TERMINAL AND DISK I/O, AND TRAPS) 4 ; 5 ; **************************************************************** 6 ; 7 ; 8 ; *************** 9 ; 10 ; RSX-11M TERMINAL I/O 11 ; 12 ; *************** 13 ; 14 .IFDF RSX11 15 ; 16 .EVEN 17 ; NOTE - FOR RSX-11 ON HEAVILY LOADED MACHINES, IT IS BETTER 18 ; FOR 'KEY' TO READ A WHOLE LINE AT A TIME, AND UNPACK IT. 19 ; ALSO, 'KEY' SHOULD EMIT A LINE FEED WHEN A CARRIAGE RETURN 20 ; HAS BEEN READ. 21 22 PEMIT: JSR R1,ITERM ; INITIALIZE RSX? 23 ; INCREMENT 'OUT', UNLESS A CONTROL CHARACTER BEING OUTPUT. 24 CMP (S),#40 ; TEST FOR CONTROL CHARACTER 25 BLT 1$ 26 INC 42(U) ; INCREMENT 'OUT' 27 1$: 28 JSR R1,XCOUT ; OUTPUT A CHARACTER 29 NEXT 30 ; 31 PKEY: JSR R1,ITERM ; INITIALIZE RSX? 32 TST INTERM ; ZERO MEANS READ NEW LINE 33 BNE XCHAR 34 XLINE: MOV #XBUFF,INTERM ; READ NEW LINE 35 QIOW$C IO.RVB,4,4,,IOSTAT,, 36 ADD #XBUFF,IOSTAT+2 ; TERMINATE LINE WITH CR 37 MOVB #15,@IOSTAT+2 38 XCHAR: TST -(S) ; DECREMENT STACK POINTER 39 MOVB @INTERM,(S) ; FOR THIS BYTE INSTRUCTION 40 INC INTERM 41 BIC #177600,(S) 42 CMP (S),#15 ; IF CR IS BEING SENT, 43 BNE XRETRN 44 CLR INTERM ; THEN READ NEW LINE NEXT TIME. 45 MOV #12,-(S) ; AND ALSO EMIT A LINE FEED 46 JSR R1,XCOUT 47 XRETRN: NEXT 48 ; 49 PQTER: JSR R1,ITERM ; INITIALIZE RSX? 50 MOV QFLAG,-(S) 51 CLR QFLAG 52 NEXT 53 ; PUT THE AST ROUTINE HERE 54 AST1: MOV (RP)+,QFLAG ; SET UP FOR NEXT '?TERMINAL'; 55 ; NOTE THAT 'RP' IS SYSTEM STACK. 56 CMP QFLAG,#3 ; TEST FOR ^C 57 BNE 1$ F.I.G. MACRO V04.00 00:03:00 PAGE 10-1 58 MOV #GO,IP 59 1$: ASTX$S 60 ; 61 ; 62 PCR: JSR R1,ITERM ; INITIALIZE RSX? 63 MOV #15,-(S) 64 JSR R1,XCOUT 65 MOV #12,-(S) 66 JSR R1,XCOUT 67 NEXT 68 ; 69 XCOUT: MOV (S)+,IOCHR 70 QIOW$C IO.WVB!TF.WAL,4,4,,IOSTAT,, 71 RTS R1 72 ; 73 ITERM: ; INITIALIZE RSX IF FIRST TIME THROUGH 74 CMP INTERM,#-1 ; FIRST TIME TERMINAL I/O? 75 BNE RSXRTS 76 CLR INTERM ; YES 77 ALUN$C 4,TI,0 ; ASSIGN LUN 78 QIOW$C IO.ATA,4,,,,, ; ATTACH - UNSOLICITED I/O 79 SVTK$S #TRAPV,#6 ; SET UP FOR TRAPS 80 RSXRTS:RTS R1 81 INTERM: .WORD -1 ; FLAG FOR FIRST TIME TERMINAL I/O. 82 ; DO NOT REINITIALIZE 'INTERM' AT COLD START, LEST ASSIGNMENT DONE TWICE. 83 IOCHR: .WORD 0 ; TEMPORARY AREA FOR 'KEY' AND 'EMIT' 84 QFLAG: .WORD 0 ; FOR '?TERMINAL' 85 XBUFF: .BLKB 82. ; TERMINAL BUFFER FOR RSX LINE I/O 86 ; 87 ; 88 ; 89 HEAD 203,BYE,305,BYE ; ***** BYE (LOG OFF) 90 CLOSE$ #FDBIO ; CLOSE DISK I/O 91 EXIT$S 92 ; 93 ; 94 ; *************** 95 ; 96 ; RSX11-M DISK I/O 97 ; 98 ; *************** 99 ; 100 HEAD 204,XI/O,240,XIO ; ***** XI/O (RSX) 101 ; PHYSICAL READ-WRITE 102 ; ADDRESS BLOCK# FLAG ==> REPORT. READS OR WRITES A 512-BYTE BLOCK. 103 ; FLAG 1=READ, 0=WRITE. REPORT '0'=GOOD I/O, '1'=I/O ERROR. 104 ; IF REPORT IS '1', THEN NEXT ON STACK IS '1'=OPEN ERROR, 105 ; '2'=READ ERROR, '3'=WRITE ERROR, '4'=WAIT ERROR, '5'=ARGUMENT 106 ; ERROR (FLAG NOT '0' OR '1'). 107 CLR DSKERR ; FOR I/O ERROR REPORT 108 TST OPENF ; DISK FILE ALREADY OPENED? 109 BNE 2$ 110 OPEN$M #FDBIO 111 BCC 2$ 112 MOV #1,DSKERR ; ERROR IN OPEN 113 BR ERRR 114 2$: MOV #1,OPENF ; INDICATE FILE IS OPEN F.I.G. MACRO V04.00 00:03:00 PAGE 10-2 115 CLR VIRBLK 116 MOV 2(S),VIRBLK+2 ; SET UP VIRTUAL BLOCK NUMBER 117 MOV 4(S),IOADDR ; SET UP I/O ADDRESS 118 TST (S) ; WAS TOP OF STACK - READ OR WRITE? 119 BEQ WRITE 120 CMP (S),#1 121 BEQ READ 122 MOV #5,DSKERR ; ERROR, FLAG NOT EITHER '0' OR '1' 123 BR ERRR 124 READ: READ$ #FDBIO,IOADDR,,#VIRBLK,#2 125 BCC WAIT 126 MOV #2,DSKERR ; ERROR IN READ 127 BR ERRR 128 WRITE: WRITE$ #FDBIO,IOADDR,,#VIRBLK,#2 129 BCC WAIT 130 MOV #3,DSKERR ; ERROR IN WRITE 131 BR ERRR 132 WAIT: WAIT$ 133 BCC DONE 134 MOV #4,DSKERR ; ERROR IN WAIT 135 BR ERRR 136 DONE: ADD #6,S 137 CLR -(S) ; INDICATE GOOD I/O 138 BR DONE2 139 ERRR: ADD #6,S 140 MOV DSKERR,-(S) ; RETURN THE ERROR INDICATOR 141 MOV #1,-(S) ; INDICATE ERROR IN I/O 142 DONE2: NEXT 143 FSRSZ$ 0 144 FDBIO: FDBDF$ 145 FDRC$A FD.RWM 146 FDBK$A ,512.,,2,IOSTAT 147 FDOP$A 3,DESCR,,FO.MFY 148 DESCR: .WORD 0,0 ; USE DEFAULT DEVICE 149 .WORD 0,0 ; AND DIRECTORY. 150 .WORD FILSZ,FIL 151 FIL: .ASCII /FORTH.DAT/ 152 FILSZ=.-FIL 153 .EVEN 154 ; 155 OPENF: .WORD 0 ; FLAG FOR FIRST TIME DISK I/O 156 ; DO NOT INITIALIZE 'OPENF' AT COLD START 157 DSKERR: .WORD 0 ; SPACE FOR DISK ERROR MESSAGE 158 IOADDR: .WORD 0 ; ADDRESS FOR DISK READ/WRITE 159 IOSTAT: .BLKW 2 ; I/O STATUS REPORT 160 VIRBLK: .BLKW 2 ; VIRTUAL BLOCK NUMBER 161 ; 162 HEAD 212,BLOCK-READ,240,BREAD,DOCOL ; ***** BLOCK-READ 163 ; ( ADDRESS BLOCK# ==> REPORT). REPORT: 0=GOOD READ, ELSE ERROR 164 .WORD ONE,XIO,SEMIS 165 ; 166 HEAD 213,BLOCK-WRITE,305,BWRIT,DOCOL ; ***** BLOCK-WRITE 167 ; ( ADDRESS BLOCK# ==> REPORT). REPORT: 0=GOOD WRITE, ELSE ERROR 168 .WORD ZERO,XIO,SEMIS 169 ; 170 HEAD 203,I/O,317,IO,DOCOL ; ***** I/O 171 ; READ OR WRITE 512-BYTE BLOCK, HANDLE ERRORS. F.I.G. MACRO V04.00 00:03:00 PAGE 10-3 172 ; ( ADDRESS BLOCK# FLAG(1=READ,0=WRITE) ==> ) 173 .WORD DUP,ONE,EQUAL,ZBRAN,XXS1-.,DROP,BREAD 174 .WORD ZBRAN,XXS2-.,CR,PDOTQ 175 .BYTE 22 176 .ASCII /DISK READ ERROR # / 177 .EVEN 178 .WORD DOT,ABORT 179 XXS2: .WORD BRAN,XXS3-. 180 XXS1: .WORD ZEQU,ZBRAN,XXS4-.,BWRIT,ZBRAN,XXS5-. 181 .WORD CR,PDOTQ 182 .BYTE 23 183 .ASCII /DISK WRITE ERROR # / 184 .EVEN 185 .WORD DOT,ABORT 186 XXS5: 187 XXS4: 188 XXS3: .WORD SEMIS 189 ; 190 HEAD 203,R/W,327,RW,DOCOL ; ***** R/W 191 ; READ OR WRITE 1024-BYTE SCREEN. ( ADDRESS SCREEN# FLAG ==> ) 192 ; NOTE THAT SCREEN N IS BLOCKS 2N-1 AND 2N. 193 .WORD TOR,TWO,STAR,OVER,OVER,ONE,SUB,R,IO 194 .WORD SWAP,LIT,512.,PLUS 195 .WORD SWAP,FROMR,IO,SEMIS 196 ; 197 .ENDC 198 ; 199 ; *************** 200 ; 201 ; RT-11 TERMINAL I/O 202 ; 203 ; *************** 204 ; 205 .IFDF RT11 206 ITERM: CMP INTERM,#-1 207 BNE RTRTS 208 CLR INTERM 209 .RCTRLO ; RESET CNTL-O 210 .TRPSET #TRAPBL,#TRAPZ 211 RTRTS: RTS R1 212 ; 213 PEMIT: 214 JSR R1,ITERM 215 ; INCREMENT 'OUT', UNLESS A CONTROL CHARACTER BEING OUTPUT. 216 CMP (S),#40 ; TEST FOR CONTROL CHARACTER 217 BLT 1$ 218 INC 42(U) ; INCREMENT 'OUT' 219 1$: 220 JSR R1,XCOUT 221 NEXT 222 ; 223 PKEY: JSR R1,ITERM 224 .TTYIN 225 BIC #177600,R0 226 CMP R0,#12 ; IGNORE LINEFEED 227 BEQ PKEY 228 MOV R0,-(S) F.I.G. MACRO V04.00 00:03:00 PAGE 10-4 229 NEXT 230 ; 231 PQTER: JSR R1,ITERM 232 MOV 44,-(RP) ; SAVE JSW 233 BIS #10100,44 ; SET BITS 6 AND 12 OF JSW 234 .TTINR 235 BCC 1$ 236 ; IF CARRY SET, NO CHARACTER - SUPPLY ZERO 237 CLR R0 238 1$: BIC #177600,R0 239 CMP R0,#12 ; IGNORE LINEFEED 240 BNE 2$ 241 CLR R0 242 2$: MOV R0,-(S) 243 MOV (RP)+,44 ; RESTORE JSW 244 NEXT 245 ; 246 PCR: JSR R1,ITERM 247 MOV #15,-(S) 248 JSR R1,XCOUT 249 MOV #12,-(S) 250 JSR R1,XCOUT 251 NEXT 252 ; 253 XCOUT: MOV (S)+,R0 254 .TTYOUT 255 RTS R1 256 ; 257 INTERM: .WORD -1 ; FLAG FOR FIRST TIME TERMINAL I/O 258 ; DO NOT INITIALIZE 'INTERM' AT COLD START 259 IOCHR: .WORD 0 ; TEMPORARY AREA FOR 'KEY', 'EMIT' 260 ; 261 HEAD 203,BYE,305,BYE ; ***** BYE (RT) 262 .EXIT 263 ; 264 ; 265 ; *************** 266 ; 267 ; RT-11 DISK I/O 268 ; 269 ; *************** 270 ; 271 HEAD 204,XI/O,240,XIO ; ***** XI/O (RT) 272 CLR DSKERR 273 TST OPENF 274 BNE RTOPEN 275 MOV #1,OPENF ; INDICATE FILE IS OPEN 276 ; NOW OPEN THE FILE 277 .SETTOP #-2 278 MOV #RTSTAT,R1 279 .DSTATUS R1,#RTFILE 280 BCC 1$ 281 MOV #1,DSKERR 282 BR RTRET 283 1$: TST 4(R1) ; HANDLER IN? 284 BNE 2$ 285 .FETCH HANDLR,#RTFILE F.I.G. MACRO V04.00 00:03:00 PAGE 10-5 286 BCC 2$ 287 MOV #2,DSKERR 288 BR RTRET 289 2$: .LOOKUP #LOOK1,#0,#RTFILE 290 BCC RTOPEN 291 MOV #3,DSKERR 292 BR RTRET 293 RTOPEN: ; FILE IS OPEN - NOW READ IT 294 MOV 2(S),R1 ; BLOCK # 295 DEC R1 ; BEGINS AT 1 IN FORTH 296 MOV 4(S),IOADDR ; BUFFER ADDRESS 297 TST (S) 298 BEQ WRITE 299 CMP (S),#1 300 BEQ READ 301 MOV #5,DSKERR 302 BR RTRET 303 READ: .READW #RTBLK,#0,IOADDR,,R1 304 BCC 1$ 305 MOV #6,DSKERR 306 1$: BR RTRET 307 WRITE: .WRITW #RTBLK,#0,IOADDR,,R1 308 BCC 2$ 309 MOV #7,DSKERR 310 2$: BR RTRET 311 RTRET: ADD #6,S 312 MOV DSKERR,-(S) 313 TST DSKERR 314 BEQ 1$ 315 MOV #1,-(S) ; INDICATE ERROR OCCURRED 316 1$: NEXT 317 RTFILE: .RAD50 /DK FORTH DAT/ 318 RTBLK: .BYTE 0,10 319 .WORD 0,0,256.,0 320 ; 321 OPENF: .WORD 0 ; FLAG FOR FIRST TIME DISK I/O 322 DSKERR: .WORD 0 ; SPACE FOR DISK ERROR MESSAGE 323 IOADDR: .WORD 0 ; ADDRESS FOR DISK READ/WRITE 324 RTSTAT: .BLKW 4 ; DISK I/O STATUS 325 LOOK1: .BLKW 3 ; EMT ARGUMENT BLOCK 326 TRAPBL: .BLKW 2 ; EMT ARGUMENT BLOCK 327 ; 328 HEAD 212,BLOCK-READ,240,BREAD,DOCOL ; ***** BLOCK-READ 329 ; ( ADDRESS BLOCK# ==> REPORT). REPORT: 0=GOOD READ, ELSE ERROR 330 .WORD ONE,XIO,SEMIS 331 ; 332 HEAD 213,BLOCK-WRITE,305,BWRIT,DOCOL ; ***** BLOCK-WRITE 333 ; ( ADDRESS BLOCK# ==> REPORT). REPORT: 0=GOOD WRITE, ELSE ERROR 334 .WORD ZERO,XIO,SEMIS 335 ; 336 HEAD 203,I/O,317,IO,DOCOL ; ***** I/O 337 ; READ OR WRITE 512-BYTE BLOCK, HANDLE ERRORS. 338 ; ( ADDRESS BLOCK# FLAG(1=READ,0=WRITE) ==> ) 339 .WORD DUP,ONE,EQUAL,ZBRAN,XXS1-.,DROP,BREAD 340 .WORD ZBRAN,XXS2-.,CR,PDOTQ 341 .BYTE 22 342 .ASCII /DISK READ ERROR # / F.I.G. MACRO V04.00 00:03:00 PAGE 10-6 343 .EVEN 344 .WORD DOT,ABORT 345 XXS2: .WORD BRAN,XXS3-. 346 XXS1: .WORD ZEQU,ZBRAN,XXS4-.,BWRIT,ZBRAN,XXS5-. 347 .WORD CR,PDOTQ 348 .BYTE 23 349 .ASCII /DISK WRITE ERROR # / 350 .EVEN 351 .WORD DOT,ABORT 352 XXS5: 353 XXS4: 354 XXS3: .WORD SEMIS 355 ; 356 HEAD 203,R/W,327,RW,DOCOL ; ***** R/W 357 ; READ OR WRITE 1024-BYTE SCREEN. ( ADDRESS SCREEN# FLAG ==> ) 358 ; NOTE THAT SCREEN N IS BLOCKS 2N-1 AND 2N. 359 .WORD TOR,TWO,STAR,OVER,OVER,ONE,SUB,R,IO 360 .WORD SWAP,LIT,512.,PLUS 361 .WORD SWAP,FROMR,IO,SEMIS 362 ; 363 ; 364 .ENDC 365 ; 366 ; *************** 367 ; 368 ; STAND-ALONE TERMINAL I/O 369 ; 370 ; **************** 371 ; 372 .IFDF ALONE 373 ; 374 ; TERMINAL CONTROLLER REGISTER DEFINITIONS 375 ; 376 177560 RCSR=177560 ; TERMINAL RECEIVE CONTROL & STATUS 377 177562 RBUF=177562 ; TERMINAL RECEIVE BUFFER 378 177564 XCSR=177564 ; TERMINAL TRANSMIT CONTROL & STATUS 379 177566 XBUF=177566 ; TERMINAL TRANSMIT BUFFER 380 ; 381 013666 PEMIT: 382 ; INCREMENT 'OUT', UNLESS A CONTROL CHARACTER BEING OUTPUT. 383 013666 021527 000040 CMP (S),#40 ; TEST FOR CONTROL CHARACTER 384 013672 002402 BLT 1$ 385 013674 005263 000042 INC 42(U) ; INCREMENT 'OUT' 386 013700 005737 177564 1$: TST @#XCSR 387 013704 001775 BEQ 1$ 388 013706 042715 177600 BIC #177600,(S) ; CLEAR UPPER BITS FOR ASCII 389 013712 012537 177566 MOV (S)+,@#XBUF ; ONLY OUTPUTS LOW 8 BITS 390 013716 NEXT 391 ; 392 013722 105737 177560 PKEY: TSTB @#RCSR 393 013726 001775 BEQ PKEY 394 013730 005037 177560 CLR @#RCSR 395 013734 113701 177562 MOVB @#RBUF,R1 396 013740 042701 177600 BIC #177600,R1 397 013744 010145 MOV R1,-(S) 398 013746 022701 000177 CMP #177,R1 399 013752 001005 BNE PK001 F.I.G. MACRO V04.00 00:03:00 PAGE 10-7 400 013754 004767 000032 CALL PBKSP ; OUTPUT , 401 013760 012715 000010 MOV #10,(S) ; CHANGE RUBOUT TO BACKSPACE CHARACTER 402 013764 000410 BR PK003 403 013766 021527 000015 PK001: CMP (S),#15 ; CARRIAGE RETURN 404 013772 001403 BEQ PK002 405 013774 005267 047250 INC OUTPOS ; PRINTABLE--INCREMENT OUTPUT POSITION 406 014000 000402 BR PK003 407 014002 005067 047242 PK002: CLR OUTPOS 408 014006 PK003: NEXT 409 ; 410 ; PRINT , COMBINATION TO ERASE CHARACTER 411 ; 412 014012 005767 047232 PBKSP: TST OUTPOS 413 014016 003416 BLE PBKRET ; EMPTY OUTPUT BUFFER--RETURN 414 014020 005367 047224 DEC OUTPOS ; OUTPUT POSITION MOVES LEFT 415 014024 005737 177564 PBKOUT: TST @#XCSR 416 014030 001775 BEQ PBKOUT ; WAIT UNTIL READY TO TRANSMIT 417 014032 012737 000010 177566 MOV #10,@#XBUF ; OUTPUT BACKSPACE CHARACTER 418 014040 005737 177564 PSPOUT: TST @#XCSR 419 014044 001775 BEQ PSPOUT ; WAIT UNTIL READY TO TRANSMIT 420 014046 012737 000040 177566 MOV #40,@#XBUF ; OUTPUT SPACE CHARACTER 421 014054 000207 PBKRET: RETURN 422 ; 423 014056 105737 177560 PQTER: TSTB @#RCSR 424 014062 001403 BEQ 1$ 425 014064 013745 177562 MOV @#RBUF,-(S) 426 014070 000401 BR 2$ 427 014072 005045 1$: CLR -(S) 428 014074 005037 177560 2$: CLR @#RCSR 429 014100 NEXT 430 ; 431 014104 005737 177564 PCR: TST @#XCSR 432 014110 001775 BEQ PCR 433 014112 012737 000015 177566 MOV #15,@#XBUF 434 014120 005737 177564 1$: TST @#XCSR 435 014124 001775 BEQ 1$ 436 014126 012737 000012 177566 MOV #12,@#XBUF 437 014134 NEXT 438 ; 439 014140 HEAD 203,BYE,305,BYE ; ***** BYE (ALONE) 440 441 014150 000000 HALT 442 ; 443 ; *************** 444 ; 445 ; STAND-ALONE DISK I/O 446 ; 447 ; *************** 448 ; 449 .IFDF RL02 450 ; 451 ; STANDALONE MODE IS USING RL02, NOT RX01 FLOPPY DISK. 452 ; 453 174400 RLCS=174400 454 174402 RLBA=174402 455 174404 RLDA=174404 456 174406 RLMP=174406 F.I.G. MACRO V04.00 00:03:00 PAGE 10-8 457 ; 458 ; RL02 DISK LOCATION WORD: 459 ; 460 ; 15 7 6 5 0 461 ; +----------+------+--------+ 462 ; | CYLINDER | HEAD | SECTOR | 463 ; +----------+------+--------+ 464 ; 465 ; ( EXTRACT THE CYLINDER, HEAD, OR SECTOR FROM DISK LOCATION ) 466 ; : RLCYL 0 200 U/ SWAP DROP ; ( GET DISK CYLINDER ) 467 ; : RLHEAD 100 AND 100 / ; ( GET DISK HEAD ) 468 ; : RLSEC 77 AND ; ( GET DISK SECTOR ) 469 ; 470 014152 HEAD 205,RLCYL,314,RLCYL,DOCOL ; ***** RLCYL 471 ; CYL|HD|SEC -> CYLINDER 472 ; CONVERT CYL|HD|SEC TO DOUBLE, THEN DIVIDE BY 200 473 014164 002532' 000060' 000200 .WORD ZERO,LIT,200,USLAS 014172 001214' 474 014174 002050' 002026' .WORD SWAP,DROP ; DISCARD REMAINDER 475 014200 001440' .WORD SEMIS 476 ; 477 014202 HEAD 206,RLHEAD,240,RLHEAD,DOCOL ; ***** RLHEAD 478 ; CYL|HD|SEC -> HEAD 479 014216 000060' 000100 001302' .WORD LIT,100,AND,LIT,100,SLASH 014224 000060' 000100 010606' 480 014232 001440' .WORD SEMIS 481 ; 482 014234 HEAD 205,RLSEC,303,RLSEC,DOCOL ; ***** RLSEC 483 ; CYL|HD|SEC -> SECTOR 484 014246 000060' 000077 001302' .WORD LIT,77,AND 485 014254 001440' .WORD SEMIS 486 ; 487 014256 HEAD 205,RLCHS,323,RLCHS,DOCOL ; ***** RLCHS 488 ; CONVERT ABSOLUTE DISK BLOCK NUMBER TO RL02 CYLINDER|HEAD|SECTOR WORD. 489 ; 12 (OCTAL) SECTORS PER TRACK. 490 ; BLOCK# -> CYL|HD|SEC 491 014270 000060' 000012 010566' .WORD LIT,12,SLMOD ; STACK: SECTOR/4 CYL|HD 492 014276 000060' 000100 001132' .WORD LIT,100,USTAR,DROP ; STACK: SECTOR/4 CYL|HD*100 014304 002026' 493 014306 002050' 000060' 000004 .WORD SWAP,LIT,4,STAR,OR ; STACK: CYL|HD|SECTOR 014314 010546' 001322' 494 014320 001440' .WORD SEMIS 495 ; 496 ; 497 ; RLCS REGISTER: 498 ; 499 ; 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 500 ; +---+ +--+---+--+ +--+--+---+ +---+----+--+ +----+----+--+ +--+--+----+ 501 ; |ERR| |DE|NXM|E2| |E1|E0|DS1| |DS0|CRDY|IE| |BA17|BA16|F2| |F1|F0|DRDY| 502 ; +---+ +--+---+--+ +--+--+---+ +---+----+--+ +----+----+--+ +--+--+----+ 503 ; \-----------V---------/ \-------------------V------------------/ \-V-/ 504 ; READ ONLY READ/WRITE READ 505 ; 506 ; ERR = ERROR; DETAILS IN E2|E1|E0 507 ; DE = DRIVE ERROR 508 ; NXM = NON-EXISTENT MEMORY 509 ; E2 = DATA LATE; E1 = DATA CRC ERROR; E0 = OPERATION INCOMPLETE F.I.G. MACRO V04.00 00:03:00 PAGE 10-9 510 ; ERROR CODES: 511 ; 001 = OPI (OPERATION INCOMPLETE) 512 ; 010 = READ DATA CRC 513 ; 010 = WRITE CHECK 514 ; 011 = HEADER CRC 515 ; 100 = DATA LATE 516 ; 101 = HEADER NOT FOUND 517 ; CRDY = CONTROLLER READY (1 = READY FOR NEW COMMAND) 518 ; IE = INTERRUPT ENABLE 519 ; DS1|DS0 = DRIVE SELECT (DRIVE NUMBER 0 TO 3) 520 ; 521 ; F2|F1|F0 = FUNCTION: 522 ; 0 = NOP (RL11)/MAINT (RLV11) 4 = READ HEADER 523 ; 1 = WRITE CHECK 5 = WRITE DATA 524 ; 2 = GET STATUS 6 = READ DATA 525 ; 3 = SEEK 7 = READ WITHOUT HEADER CHECK 526 ; 527 ; 528 ; RLMP REGISTER AFTER GET STATUS COMMAND (RETURNED BY RLSTAT): 529 ; 530 ; 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 531 ; +---+ +---+--+----+ +---+---+--+ +---+--+--+ +--+--+--+ +---+---+---+ 532 ; |WDE| |CHE|WL|SKTO| |SPE|WGE|VC| |DSE|DT|HS| |CO|HO|BH| |STC|STB|STA| 533 ; +---+ +---+--+----+ +---+---+--+ +---+--+--+ +--+--+--+ +---+---+---+ 534 ; 535 ; WDE = WRITE DATA ERROR 536 ; CHE = CURRENT HEADER ERROR 537 ; WL = WRITE LOCK (DRIVE IS WRITE PROTECTED) 538 ; SKTO = SEEK TIMEOUT 539 ; SPE = SPIN ERROR (SPINDLE SPEED NOT REACHED WITHIN TIME LIMIT) 540 ; WGE = WRITE GATE ERROR (DRIVE NOT READY OR WRITE PROTECTED, ETC.) 541 ; VC = VOLUME CHECK (CARTRIDGE IS MOUNTED AND SPUN UP (CLEARED BY 542 ; EXECUTION OF A GET STATUS COMMAND WITH BIT 3 SET) 543 ; DSE = DRIVE SELECT ERROR (MULTIPLE DRIVE SELECTION ERROR) 544 ; DT = DRIVE TYPE (0 = RL01; 1 = RL02) 545 ; HS = CURRENTLY SELECTED HEAD (0 = UPPER; 1 = LOWER) 546 ; CO = COVER OPEN 547 ; HO = HEADS OUT (HEADS ARE OVER THE DISK) 548 ; BH = BRUSH HOME (DISK BRUSHES ARE HOME) 549 ; 550 ; STC|STB|STA = STATE OF DRIVE: 551 ; 0 0 0 = LOAD CARTRIDGE 552 ; 0 0 1 = SPIN UP 553 ; 0 1 0 = BRUSH CYCLE 554 ; 0 1 1 = LOAD HEADS 555 ; 1 0 0 = SEEK 556 ; 1 0 1 = LOCK ON 557 ; 1 1 0 = UNLOAD HEADS 558 ; 1 1 1 = SPIN DOWN 559 ; 560 ; 561 014322 HEAD 206,RLSTAT,240,RLSTAT ; ***** RLSTAT 562 ; GET RL02 DISK STATUS; SEE RLMP REGISTER GET STATUS WORD ABOVE 563 ; -> RLSTATUS 564 014336 012700 174400 MOV #RLCS,R0 565 014342 012737 000013 174404 MOV #13,@#RLDA ; RLDA SETUP FOR GET STATUS: 566 ; CLEAR ERROR REGISTER & GET STATUS F.I.G. MACRO V04.00 00:03:00 PAGE 10-10 567 014350 012710 000004 MOV #4,(R0) ; RLCS GET STATUS FUNCTION CODE 568 014354 105710 TSTB (R0) ; RLCS TEST FOR READY STATE 569 014356 100376 BPL .-2 ; NOT READY YET--KEEP CHECKING 570 014360 013745 174406 MOV @#RLMP,-(S) ; PUSH RLMP STATUS RESULT ONTO STACK 571 014364 NEXT 572 ; 573 014370 HEAD 205,RLHDR,322,RLHDR ; ***** RLHDR 574 ; GET CURRENT CYLINDER|HEAD|SECTOR HEADER (POSITION) ON DISK 575 ; -> CYLINDER|HEAD|SECTOR 576 014402 012700 174400 MOV #RLCS,R0 577 014406 012710 000010 MOV #10,(R0) ; RLCS READ HEADER FUNCTION CODE 578 014412 105710 TSTB (R0) ; RLCS TEST FOR READY STATE 579 014414 100376 BPL .-2 ; NOT READY YET--KEEP CHECKING 580 014416 013745 174406 MOV @#RLMP,-(S) ; PUSH CYLINDER|HEAD|SECTOR WORD ONTO STACK 581 014422 013701 174406 MOV @#RLMP,R1 ; READ ZEROES WORD FROM SILO (DISCARDED) 582 014426 013701 174406 MOV @#RLMP,R1 ; READ CRC WORD FROM SILO (DISCARDED) 583 014432 NEXT 584 ; 585 ; 586 ; RL02 SEEK OFFSET WORD: 587 ; 588 ; 15 7 6 5 4 3 2 1 0 589 ; +---------------------+---+---+------+---+-----------+---+---+ 590 ; | CYLINDER DIFFERENCE | 0 | 0 | HEAD | 0 | DIRECTION | 0 | 1 | 591 ; +---------------------+---+---+------+---+-----------+---+---+ 592 ; 593 ; 594 014436 HEAD 205,RLDIR,322,RLDIR,DOCOL ; ***** RLDIR 595 ; GET DIRECTION BIT FOR SEEK WORD FROM CYLDIFF SIGN BIT. 596 ; CYLDIFF -> ABS(CYLDIF) DIRECTION|1 597 ; DIRECTION BIT IS 4 OR 0 598 014450 002076' .WORD DUP ; STACK: CYLDIFF CYLDIFF 599 014452 001600' 000144' 000012 .WORD ZLESS,ZBRAN,RLN1-. ; STACK: CYLDIFF 600 014460 001734' 002542' 000122' .WORD MINUS,ONE,BRAN,RLN2-. ; STACK: -CYLDIFF DIR|1 014466 000006 601 014470 000060' 000005 RLN1: .WORD LIT,5 ; STACK: CYLDIFF DIR|1 602 014474 001440' RLN2: .WORD SEMIS ; STACK: ABS(CYLDIFF) DIR|1 603 ; 604 014476 HEAD 206,RLDIFF,240,RLDIFF,DOCOL ; ***** RLDIFF 605 ; CALCULATE DIFFERENCE BETWEEN TWO CYL|HD|SEC WORDS, 606 ; SOURCE (CHS0) TO DESTINATION (CHS1), FOR SEEKING. 607 ; CHS0 CHS1 -> RLDIFFWORD 608 014512 002076' 003716' .WORD DUP,ROT ; STACK: CHS1 CHS1 CHS0 609 014516 014162' 001500' 014162' .WORD RLCYL,TOR,RLCYL,FROMR ; STACK: CHS1 CYL1 CYL0 014524 001516' 610 014526 003516' .WORD SUB ; STACK: CHS1 CYL1-CYL0=CYLDIFF 611 014530 014446' .WORD RLDIR ; STACK: CHS1 ABS(CYLDIFF) DIR|1 612 014532 002050' 000060' 000200 .WORD SWAP,LIT,200,USTAR,DROP,OR ; STACK: CHS1 ABS(CYLDIFF)|DIR|1 014540 001132' 002026' 001322' 613 014546 002050' 014214' 000060' .WORD SWAP,RLHEAD,LIT,20,STAR,OR ; STACK: ABS(CYLDIFF)|HD|DIR|1 014554 000020 010546' 001322' 614 014562 001440' .WORD SEMIS 615 ; 616 014564 HEAD 206,RLSEEK,240,RLSEEK 617 ; SEEK CYLINDER, HEAD, SECTOR BY RELATIVE OFFSET 618 ; RLDIFFWORD -> RLCS 619 014600 012700 174400 MOV #RLCS,R0 F.I.G. MACRO V04.00 00:03:00 PAGE 10-11 620 014604 012537 174404 MOV (S)+,@#RLDA ; LOAD DIFFERENCE IN RLDA REGISTER 621 014610 012710 000006 MOV #000006,(R0) ; SEEK COMMAND 622 014614 105710 TSTB (R0) ; RLCS TEST FOR READY STATE 623 014616 100376 BPL .-2 ; LOOP BACK UNTIL READY 624 014620 011045 MOV (R0),-(S) ; PUSH SEEK RETURN STATUS ON STACK 625 014622 NEXT 626 ; 627 ; RL02 SETUP OPERATION (STEPS FROM RL02 MANUAL): 628 ; 629 ; RLHDR: 630 ; 1. ISSUE READ HEADER COMMAND AND WAIT FOR CRDY. 631 ; 2. CHECK ERROR FLAG. 632 ; 3. READ HEADER WORD FROM RLMP REGISTER. 633 ; 634 ; RLDIFF: 635 ; 4. CALCULATE DIFFERENCE AND DIRECTION FOR SEEK. 636 ; 637 ; RLSEEK: 638 ; 5. MOVE DIFFERENCE WORD TO RLDA REGISTER. 639 ; 6. ISSUE SEEK FUNCTION AND WATI FOR COMPLETION (DRIVE READY BIT). 640 ; 7. CHECK ERROR FLAG. 641 ; 642 014626 HEAD 205,RLSET,324,RLSET,DOCOL ; ***** RLSET 643 ; SETUP TO POSITION RL02 READ/WRITE HEAD BEFORE READING OR WRITING 644 ; BLOCK# -> CYLINDER|HEAD|SECTOR ERROR-FLAG 645 014640 014266' .WORD RLCHS ; STACK: CYL|HD|SEC (I.E., CHSDEST) 646 014642 002076' .WORD DUP ; STACK: CHSDEST CHSDEST 647 014644 014400' 002050' .WORD RLHDR,SWAP ; STACK: CHSDEST CHSORIGIN CHSDEST 648 014650 014510' .WORD RLDIFF ; STACK: CHSDEST RLDIFFWORD 649 014652 014576' .WORD RLSEEK ; STACK: CHSDEST RLCSVALUE 650 014654 000060' 176000 001302' .WORD LIT,176000,AND ; STACK: CHSDEST ERROR-FLAG(NON-ZERO=ERROR) 651 ; ERROR BITS ARE IN UPPER BYTE 652 014662 001440' .WORD SEMIS 653 ; 654 014664 HEAD 204,RLRD,240,RLRD ; ***** RLRD 655 ; READ ONE FORTH BLOCK (4 SECTORS) FROM DISK 656 ; ADDR CYL|HD|SEC -> ERROR-FLAG 657 014676 012700 174400 MOV #RLCS,R0 658 ; READ HEADER 659 ; MOV #10,(R0) ; RLCS READ HEADER 660 ; TSTB (R0) ; RLCS TEST FOR READY STATE 661 ; BPL .-2 ; WAIT UNTIL CONTROLLER IS READY 662 ; MOV @#RLMP,R1 ; RLMP HEADER COPY TO R1 663 ; READ DATA 664 014702 012537 174404 MOV (S)+,@#RLDA ; RLDA <- CYL|HD|SEC 665 014706 012537 174402 MOV (S)+,@#RLBA ; RLBA <- LOAD START ADDRESS 666 014712 012737 177000 174406 MOV #-1000,@#RLMP ; RLMP GET 4 SECTORS (1 KBYTE) 667 014720 012710 000014 MOV #14,(R0) ; RLCS READ FROM DISK WITH HEADER CHECK 668 014724 105710 TSTB (R0) ; RLCS TEST FOR READY STATE 669 014726 100376 BPL .-2 ; WAIT UNTIL CONTROLLER IS READY 670 014730 011045 MOV (R0),-(S) ; PUSH RLCS (STATUS) ON STACK 671 014732 NEXT 672 ; 673 014736 HEAD 204,RLWR,240,RLWR ; ***** RLWR 674 ; WRITE ONE FORTH BLOCK (4 SECTORS) TO DISK 675 ; ADDR CYL|HD|SEC -> ERROR-FLAG 676 014750 012700 174400 MOV #RLCS,R0 F.I.G. MACRO V04.00 00:03:00 PAGE 10-12 677 ; WRITE DATA 678 014754 012537 174404 MOV (S)+,@#RLDA ; RLDA <- CYL|HD|SEC 679 014760 012537 174402 MOV (S)+,@#RLBA ; RLBA <- LOAD START ADDRESS` 680 014764 012737 177000 174406 MOV #-1000,@#RLMP ; RLMP GET 4 SECTORS (1 KBYTE) 681 014772 012710 000012 MOV #12,(R0) ; RLCS WRITE TO DISK 682 014776 105710 TSTB (R0) ; RLCS TEST FOR READY STATE 683 015000 100376 BPL .-2 ; WAIT UNTIL CONTROLLER IS READY 684 015002 011045 MOV (R0),-(S) ; PUSH RLCS (STATUS) ON STACK 685 015004 NEXT 686 ; 687 015010 HEAD 205,RLERR,322,RLERR,DOCOL ; ***** RLERR 688 ; PRINT RL02 ERROR INFORMATION 689 ; -> 690 015022 005236' .WORD PDOTQ 691 015024 034 .BYTE 34 692 015025 104 111 123 .ASCII /DISK ERROR --- OCTAL RLCS = / 015030 113 040 105 015033 122 122 117 015036 122 040 055 015041 055 055 040 015044 117 103 124 015047 101 114 040 015052 122 114 103 015055 123 040 075 015060 040 693 .EVEN 694 015062 003222' 002220' 001500' .WORD BASE,AT,TOR ; PRESERVE CURRENT BASE 695 015070 000060' 174400 002220' .WORD LIT,RLCS,AT 696 015076 004666' 013270' .WORD OCTAL,UDOT ; OUTPUT ERROR FLAG VALUE IN OCTAL 697 015102 005236' .WORD PDOTQ 698 015104 013 .BYTE 13 699 015105 054 040 123 .ASCII /, STATUS = / 015110 124 101 124 015113 125 123 040 015116 075 040 700 .EVEN 701 015120 014334' 004666' 013270' .WORD RLSTAT,OCTAL,UDOT 702 015126 001516' 003222' 002264' .WORD FROMR,BASE,STORE ; RESTORE PREVIOUS BASE 703 015134 001440' .WORD SEMIS 704 705 ; 706 ; ( READ OR WRITE A 1024-BYTE ABSOLUTE DISK BLOCK ) 707 ; : AR/W ( ADDR BLOCK# FLAG:0=WRITE,1=READ -> ) 708 ; SWAP ( STACK: ADDR FLAG BLOCK# ) 709 ; RLSET ( STACK: ADDR FLAG CYL/HD/SEC ERROR-FLAG) 710 ; 0= IF ; SWAP ( STACK: ADDR CYL/HD/SEC FLAG ) ; 0= IF 711 ; RLWR 712 ; ELSE 713 ; RLRD 714 ; ENDIF 715 ; ELSE 716 ; QUIT 717 ; ENDIF ; ( STACK: -- ) 718 ; 719 015136 HEAD 204,AR/W,240,ARW,DOCOL ; ***** AR/W 720 ; READ OR WRITE 1024-BYTE ABSOLUTE DISK BLOCK 721 ; ADDR BLOCK# FLAG(R=1,W=0) -> F.I.G. MACRO V04.00 00:03:00 PAGE 10-13 722 015150 002050' .WORD SWAP ; STACK: ADDR FLAG BLOCK# 723 015152 014636' .WORD RLSET ; STACK: ADDR FLAG CYL|HD|SEC ERROR-FLAG 724 015154 002026' .WORD DROP ; STACK: ADDR FLAG CYL|HD|SEC 725 015156 002050' .WORD SWAP ; STACK: ADDR CYL|HD|SEC FLAG 726 ; .WORD RLHDR,DROP ; VERIFY CONTROLLER IS READY 727 ; ; STACK: ADDR CYL|HD|SEC FLAG 728 ; NOW READ OR WRITE DEPENDING ON FLAG VALUE 729 ; IF FLAG=0, BRANCH TO WRITE 730 015160 000144' 000024 .WORD ZBRAN,1$-. 731 015164 014674' .WORD RLRD ; READ 1 KBYTE 732 015166 000060' 176000 001302' .WORD LIT,176000,AND ; PRESERVE ERROR BITS 733 015174 000144' 000004 .WORD ZBRAN,2$-. ; ERROR FLAG IS NON-ZERO 734 015200 007752' .WORD QUIT 735 015202 000122' 000020 2$: .WORD BRAN,3$-. ; GO TO END 736 ; WRITE 737 015206 014746' 1$: .WORD RLWR ; WRITE 1 KBYTE 738 015210 000060' 176000 001302' .WORD LIT,176000,AND ; PRESERVE ERROR BITS 739 015216 000144' 000004 .WORD ZBRAN,4$-. ; ERROR FLAG IS NON-ZERO 740 015222 007752' .WORD QUIT 741 015224 4$: 742 015224 001440' 3$: .WORD SEMIS 743 ; 744 015226 HEAD 203,R/W,327,RW,DOCOL ; ***** R/W 745 ; READ OR WRITE 1024-BYTE SCREEN. 746 ; ADDR SCREEN# FLAG(R=1,W=0) -> 747 ; ADD 6 TO SCREEN# TO CHANGE TO ABSOLUTE DISK BLOCK# 748 015236 002050' 000060' 000006 .WORD SWAP,LIT,6,PLUS,SWAP 015244 001656' 002050' 749 015250 015146' .WORD ARW ; PASS CONVERTED ABSOLUTE DISK BLOCK # 750 015252 001440' .WORD SEMIS 751 ; 752 ; END OF RL02 PORTION OF STANDALONE SECTION 753 ; 754 .IFF 755 ; 756 ; STANDALONE MODE IS USING RX01 FLOPPY DISK, NOT RL02. 757 ; 758 RXCS=177170 ; CONTROL AND STATUS REGISTER 759 RXDB=177172 ; DATA BUFFER REGISTER 760 ; 761 ; 762 HEAD 204,NRTS,240,NRTS ; ***** NRTS 763 ; ADDRN TRN SECN...ADDR1 TR1 SEC1 N -> FLAG 764 ; READ N SECTORS. USES R0, R1, R2 765 ; THIS OPERATION IS IN CODE TO KEEP UP WITH DISK TIMING FOR 766 ; STANDARD PDP-11 SECTOR SKEWING. 767 MOV (S)+,R1 ; # OF SECTORS TO READ 768 1$: MOV #10,R2 ; RETRY COUNT 769 21$: MOV #7,R0 ; 'READ' COMMAND 770 JSR PC,DRIV2 ; ADJUST R0 COMMAND 771 ; IF SECOND DRIVE 772 MOV R0,@#RXCS ; READ COMMAND 773 2$: BIT #200,@#RXCS ; WAIT FOR TRANSFER FLAG 774 BEQ 2$ 775 MOV (S),@#RXDB ; SECTOR # 776 3$: BIT #200,@#RXCS ; WAIT FOR TRANSFER FLAG 777 BEQ 3$ F.I.G. MACRO V04.00 00:03:00 PAGE 10-14 778 MOV 2(S),@#RXDB ; TRACK # 779 4$: BIT #40,@#RXCS ; WAIT FOR DONE FLAG 780 BEQ 4$ 781 ; CHECK FOR ERROR 782 TST @#RXCS 783 BLT 20$ ; ERROR 784 ; 785 MOV #3,@#RXCS ; 'EMPTY' COMMAND 786 ; EMPTY THE CONTROLLER'S BUFFER 787 MOV 4(S),R0 ; ADDRESS TO RECEIVE DATA 788 MOV #200,-(S) ; COUNT OF TIMES TO LOOP 789 6$: BIT #200,@#RXCS ; WAIT FOR TRANSFER FLAG 790 BEQ 6$ 791 MOVB @#RXDB,(R0)+ 792 DEC (S) ; DECREMENT THE COUNT 793 BNE 6$ 794 TST (S)+ ; POP THE COUNT 795 ; CHECK FOR ERROR 796 TST @#RXCS 797 BGE 7$ 798 20$: ; ERROR, SO RE-TRY 799 MOV #40000,@#RXCS ; CLEAR ERROR STATUS 800 22$: BIT #40,@#RXCS 801 BEQ 22$ 802 DEC R2 ; RE-TRY COUNT 803 BGT 21$ 804 MOV #-1,-(S) 805 NEXT ; ERROR EXIT 806 7$: ADD #6,S ; GOOD READ, SO POP THE 3 ARGS 807 DEC R1 808 BNE 1$ ; LOOP UNLESS ALL SECTORS READ 809 ; 810 CLR -(S) ; GOOD-READ INDICATOR 811 NEXT ; EXIT 812 ; 813 ; SUBROUTINE TO ADJUST COMMAND FOR SECOND DISK DRIVE 814 ; NOTE - 'NWTS' ALSO USES THIS SUBROUTINE. 815 ; NOTE USE OF R0, AND OF FORTH STACK. 816 DRIV2: CMP 2(S),#114 ; TRACK > 76 ? 817 BLE 10$ 818 SUB #115,2(S) ; SUBTRACT 77 819 BIS #20,R0 ; SET UNIT-SELECT BIT 820 10$: RTS PC 821 ; 822 HEAD 204,NWTS,240,NWTS ; ***** NWTS 823 ; ADDRN TRN SECN...ADDR1 TR1 SEC1 N -> FLAG 824 ; WRITE N SECTORS. USES R0, R1, R2. 825 MOV (S)+,R1 ; # OF SECTORS TO BE WRITTEN 826 1$: MOV #10,R2 ; RE-TRY COUNT 827 21$: MOV #1,@#RXCS ; 'FILL' COMMAND 828 2$: BIT #200,@#RXCS ; WAIT FOR TRANSFER FLAG 829 BEQ 2$ 830 ; NOW FILL THE BUFFER 831 MOV 4(S),R0 832 MOV #200,-(S) ; COUNT 833 3$: BIT #200,@#RXCS ; WAIT FOR TRANSFER FLAG 834 BEQ 3$ F.I.G. MACRO V04.00 00:03:00 PAGE 10-15 835 MOVB (R0)+,@#RXDB ; MOVE ONE BYTE 836 DEC (S) 837 BNE 3$ 838 TST (S)+ ; POP STACK 839 ; CHECK FOR ERROR 840 TST @#RXCS 841 BLT 20$ ; ERROR 842 ; 843 MOV #5,R0 ; 'WRITE' COMMAND 844 JSR PC,DRIV2 ; ADJUST IF SECOND DRIVE 845 MOV R0,@#RXCS ; 'WRITE' COMMAND 846 5$: BIT #200,@#RXCS ; WAIT FOR TRANSFER FLAG 847 BEQ 5$ 848 MOV (S),@#RXDB ; MOVE SECTOR # 849 6$: BIT #200,@#RXCS ; WAIT FOR TRANSFER FLAG 850 BEQ 6$ 851 MOV 2(S),@#RXDB ; MOVE TRACK # 852 7$: BIT #40,@#RXCS ; WAIT FOR DONE FLAG 853 BEQ 7$ 854 ; CHECK FOR ERROR 855 TST @#RXCS 856 BGE 10$ 857 20$: ; ERROR SO RE-TRY 858 MOV #40000,@#RXCS ; CLEAR ERROR STATUS 859 22$: BIT #40,@#RXCS 860 BEQ 22$ 861 DEC R2 ; RE-TRY COUNT 862 BGT 21$ 863 MOV #-1,-(S) ; ERROR INDICATOR 864 NEXT ; EXIT 865 10$: ADD #6,S ; GOOD WRITE, SO POP THE 3 ARGS 866 DEC R1 867 BNE 1$ ; LOOP UNLESS ALL SECTORS WRITTEN 868 ; 869 CLR -(S) ; GOOD-WRITE INDICATOR 870 NEXT 871 ; 872 HEAD 203,RTS,323,RTS,DOCOL ; ***** RTS 873 ; ADDR TR SEC -> 874 ; READ A SINGLE SECTOR. 875 .WORD ONE,NRTS,ZBRAN,1$-.,PDOTQ 876 .BYTE 26 877 .ASCII /DISK READ ERROR IN RTS/ 878 .EVEN 879 .WORD QUIT 880 1$: .WORD SEMIS 881 ; 882 HEAD 203,WTS,323,WTS,DOCOL ; ***** WTS 883 ; ADDR TR SEC -> 884 ; WRITE A SINGLE SECTOR. 885 .WORD ONE,NWTS,ZBRAN,1$-.,PDOTQ 886 .BYTE 30 887 .ASCII /DISK WRITE ERROR IN WTS / 888 .EVEN 889 .WORD QUIT 890 1$: .WORD SEMIS 891 ; F.I.G. MACRO V04.00 00:03:00 PAGE 10-16 892 ; 893 HEAD 205,SKEW1,261,SKEW1,DOCOL ; ***** SKEW1 894 ; SEQUENCE -> TRACK SECTOR 895 ; HANDLE THE SECTOR SKEWING. 896 ; NOTE - 'SEQUENCE #' IS ZERO-ORIGIN INDEX OF SECTOR (SKEWED). 897 ; NOTE - 'SKEW1' DOES SKEWING OF ONLY ONE DRIVE; 'SKEW' GENERALIZES 898 ; 'SKEW1' TO BOTH DRIVES. 899 .WORD DUP,LIT,32,SLASH,SWAP 900 .WORD OVER,LIT,6,STAR,OVER,DUP,PLUS,PLUS,SWAP 901 .WORD LIT,32,MOD,LIT,15,SLASH,PLUS 902 .WORD LIT,32,MOD,ONEP 903 .WORD SWAP,ONEP,SWAP,SEMIS 904 ; 905 HEAD 206,S-SKIP,240,SSKIP,DOVAR ; ***** S-SKIP 906 ; VARIABLE - NUMBER OF SECTORS SKIPPED AT BEGINNING OF DISK. 907 ; DEFAULT IS 56 DECIMAL (SKIP AN RT-11 DIRECTORY). ALSO, TRACK 908 ; ZERO IS SKIPPED, FOR COMPATIBILITY. 909 .WORD 56. 910 ; 911 HEAD 206,S-USED,240,SUSED,DOVAR ; ***** S-USED 912 ; VARIABLE - NUMBER OF SECTORS USED ON ON ONE DISK. 913 ; NORMALLY, S-USED + S-SKIP = 1976. (2002. - 26. OF TR 0). 914 .WORD 1920. 915 ; 916 HEAD 204,SKEW,240,SKEW,DOCOL ; ***** SKEW 917 ; SEQUENCE# -> TRACK SECTOR 918 .WORD DUP,ONEP,SUSED,AT,GREAT,ZBRAN,1$-. 919 .WORD SUSED,AT,SUB,SSKIP,AT,PLUS,SKEW1 920 .WORD SWAP,LIT,77.,PLUS,SWAP 921 .WORD BRAN,2$-. 922 1$: .WORD SSKIP,AT,PLUS,SKEW1 923 2$: .WORD SEMIS 924 ; 925 HEAD 206,NSETUP,240,NSET,DOCOL ; ***** NSETUP 926 ; ADDR SEQUENCE# N -> ADDRN TRN SECN...ADDR1 TR1 SEC1 927 ; THIS PREPARES A WHOLE SCREEN (IF N=8) FOR 'NRTS' OR 'NWTS'. 928 .WORD ROT,OVER,LIT,128.,STAR,PLUS,ROT,ROT 929 .WORD OVER,PLUS,ONE,SUB,SWAP,ONE,SUB,SWAP 930 .WORD XDO 931 2$: .WORD LIT,128.,SUB,DUP,I,SKEW,ROT 932 .WORD LIT,-1,XPLOO,2$-. 933 .WORD DROP,SEMIS 934 ; 935 HEAD 203,R/W,327,RW,DOCOL ; ***** R/W 936 ; READ OR WRITE 1024-BYTE SCREEN. 937 ; ADDR BLOCK# FLAG(R=1,W=0) -> 938 .WORD TOR,ONE,SUB,LIT,8.,STAR,FROMR 939 ; CHANGE THE SCREEN # TO FIRST SEQUENCE #. 940 ; IF READ, SETUP AND READ 8 SECTORS 941 .WORD ZBRAN,1$-.,LIT,8.,NSET,LIT,8.,NRTS 942 .WORD ZBRAN,2$-.,PDOTQ 943 .BYTE 20 944 .ASCII /DISK READ ERROR / 945 .EVEN 946 .WORD QUIT 947 2$: .WORD BRAN,3$-. 948 ; SETUP AND WRITE 8 SECTORS F.I.G. MACRO V04.00 00:03:00 PAGE 10-17 949 1$: .WORD LIT,8.,NSET,LIT,8.,NWTS 950 .WORD ZBRAN,4$-.,PDOTQ 951 .BYTE 20 952 .ASCII /DISK WRITE ERROR/ 953 .EVEN 954 .WORD QUIT 955 4$: 956 3$: .WORD SEMIS 957 ; 958 ; END STAND-ALONE RL02/RX01 DISK MODE 959 .ENDC 960 ; END STAND-ALONE SECTION 961 .ENDC 962 ; 963 ; *************** 964 ; 965 ; TRAP RECOVERY SECTION, RSX-11M 966 ; 967 ; *************** 968 ; 969 .IFNDF ALONE ; STAND-ALONE MUST HANDLE OWN INTERRUPTS. 970 HEAD 205,TRAPS,323,TRAPS,DOCOL ; ***** TRAPS 971 .WORD CR,PDOTQ 972 .BYTE 14 973 .ASCII /TRAP-ERROR, / 974 .EVEN 975 .WORD DOT,SWAP,UDOT,UDOT,QUIT 976 .ENDC 977 ; 978 .IFDF RSX11 979 TRAPV: .WORD TRAP0,TRAP1,TRAP2,TRAP3,TRAP4,TRAP5 980 TRAP0: CLR R1 ; TRAP # 0 981 BR TRAPZ 982 TRAP1: MOV #1,R1 ; TRAP # 1 983 ADD #6,SP ; DROP MMU INFO 984 BR TRAPZ 985 TRAP2: MOV #2,R1 986 BR TRAPZ 987 TRAP3: MOV #3,R1 988 BR TRAPZ 989 TRAP4: MOV #4,R1 990 BR TRAPZ 991 TRAP5: MOV #5,R1 992 BR TRAPZ 993 ; TO RETURN FROM TRAP HANDLER, SET UP STACK, ETC. FOR FORTH 'TRAPS' 994 ; DON'T USE RTT OR RTI. 995 TRAPZ: MOV (SP)+,-(S) ; PC 996 MOV (SP)+,-(S) ; PS 997 MOV R1,-(S) ; TRAP # 998 MOV #TRAPS+2,IP ; EXECUTE 'TRAPS' 999 NEXT 1000 ; 1001 .ENDC 1002 ; **************** 1003 ; 1004 ; TRAP RECOVERY SECTION, RT-11 1005 ; F.I.G. MACRO V04.00 00:03:00 PAGE 10-18 1006 ; **************** 1007 .IFDF RT11 1008 TRAPZ: BCS 1$ 1009 ; IF CARRY CLEAR, TRAP 4 1010 MOV #4,R1 1011 BR 2$ 1012 1$: MOV #10,R1 1013 2$: MOV (SP)+,-(S) ; PC 1014 MOV (SP),-(S) ; PS 1015 MOV R1,-(S) ; TRAP # 1016 MOV #3$,-(SP) ; SO RTI WILL RESTORE PC TO '3$' 1017 .TRPSET #TRAPBL,#TRAPZ ; RE-SET TRAPS 1018 RTI 1019 3$: MOV #TRAPS+2,IP ; EXECUTE 'TRAPS' 1020 NEXT 1021 .ENDC 1022 ; 1023 ; F.I.G. MACRO V04.00 00:03:00 PAGE 11 1 ; NOTE - '.W' ('DW') IS USED ONLY FOR TESTING - TO GET OCTAL OUTPUT 2 ; WHEN '.' IS NOT WORKING DURING SYSTEM DEVELOPMENT. 3 ; 4 ; 5 ; HEAD 202,.W,240,DW ; ***** .W 6 ; MOV (S),XOUT 7 ; ROL XOUT 8 ; ROL XOUT 9 ; MOV XOUT,IOCHR 10 ; ROR XOUT 11 ; BIC #177776,IOCHR 12 ; ADD #60,IOCHR 13 ; MOV IOCHR,-(S) 14 ; JSR R1,XCOUT 15 ; MOV #5,XCOUNT 16 ;XLP: ROL XOUT 17 ; ROL XOUT 18 ; ROL XOUT 19 ; ROL XOUT 20 ; MOV XOUT,IOCHR 21 ; ROR XOUT 22 ; BIC #177770,IOCHR 23 ; ADD #60,IOCHR 24 ; MOV IOCHR,-(S) 25 ; JSR R1,XCOUT 26 ; DEC XCOUNT 27 ; BNE XLP 28 ; MOV #40,IOCHR 29 ; MOV IOCHR,-(S) 30 ; JSR R1,XCOUT 31 ; NEXT 32 ;XOUT: .WORD 0 33 ;XCOUT: .WORD 0 34 ; 35 ; 36 ; 37 ; 38 ; 39 ; **************************************************************** 40 ; 41 ; THE FOLLOWING TWO DEFINITIONS ARE NOT PURE CODE, SO THEY WERE 42 ; MOVED HERE, NEAR THE END OF THE DICTIONARY. 43 ; 44 ; **************************************************************** 45 ; 46 015254 HEAD 305,<;CODE>,305,SEMIC,DOCOL ; ***** ;CODE 47 ; CREATE NEW DATA TYPE WITH CODE ROUTINE WRITTEN IN ASSEMBLY. 48 015266 004410' 004500' 004714' .WORD QCSP,COMP,PSCOD,LBRAC,SMUDG,SEMIS 015274 004526' 004572' 001440' 49 ; NOTE: LATER, THE ASSEMBLER WILL PATCH THIS DEFINITION. 50 ; 51 015302 HEAD 305,FORTH,310,FORTH,DODOE ; ***** FORTH 52 015314 007662' .WORD DOVOC 53 015316 120201 .WORD 120201 ; DUMMY HEADER AT INTERSECTION 54 015320 015324' .WORD TASK-10 55 015322 000000 XXVOC: .WORD 0 ; THE VOCABULARY LINK (FOR FUTURE USE) 56 015324 HEAD 204,TASK,240,TASK,DOCOL ; ***** TASK F.I.G. MACRO V04.00 00:03:00 PAGE 11-1 57 015336 001440' .WORD SEMIS 58 ; 59 ; 60 ; 61 ; F.I.G. MACRO V04.00 00:03:00 PAGE 12 1 ; **************************************************************** 2 ; 3 ; STACKS AND BUFFERS 4 ; 5 ; **************************************************************** 6 ; 7 ; NOTE - 'UP', 'OPENF', 'INTERM', AND DISK BUFFERS ARE 8 ; INITIALIZED AT COLD START, OR AT FIRST TIME THROUGH. 9 .EVEN 10 015340 XDP: ; DICTIONARY STARTS HERE 11 015340 .BLKB 16000. ; FOR DICTIONARY AND COMP. STACK 12 ; INCREASE THIS NUMBER TO USE A LARGER MEMORY SIZE. 13 054540 XS0: ; START OF COMPUTATION STACK 14 054540 .BLKW 2 ; IN CASE OF EMPTY STACK 15 ; 16 ; 17 ; 18 ; 19 ; 20 054544 DSKBUF: ; ROOM FOR 3 1K DISK BUFFERS 21 ; INITIALIZE BUFFERS' UPDATE BITS, AND TERMINATING NULLS, TO ZERO. 22 ; NOTE - THESE BUFFERS ARE CLEARED AT COLD START, ANYWAY, 23 ; BECAUSE A STAND-ALONE BOOT MAY NOT INITIALIZE HIGH MEMORY; 24 ; AND ALSO SO THAT THE NUMBER OR LOCATION OF BUFFERS CAN BE 25 ; CHANGED AT RUN TIME. 26 054544 .BLKW 1 27 054546 .BLKB 1024. 28 056546 .BLKW 1 29 056550 .BLKW 1 30 056552 .BLKB 1024. 31 060552 .BLKW 1 32 060554 .BLKW 1 33 060556 .BLKB 1024. 34 062556 .BLKW 1 35 062560 ENDBUF: ; CAUTION - 'ENDBUF' - 'DSKBUF' MUST BE EXACT MULTIPLE 36 ; OF THE BUFFER LENGTH PLUS 4. 37 ; 38 ; 39 ; 40 ; 41 ; 42 ; 'XTIB', 'XR0', AND 'XUP' ARE ONLY USED IN BOOT-UP TABLE; 43 ; THEREFORE THE AREAS DEFINED HERE CAN BE MOVED AT RUN TIME. 44 062560 XTIB: .BLKW 42. ; TERMINAL INPUT BUFFER 45 062704 .BLKW 50. ; FOR RETURN STACK 46 063050' XR0=. 47 063050 XUP: .BLKW 100 ; ROOM FOR 100 USER VARIABLES 48 ; 49 ; 50 .IFDF RT11 51 ; DISK HANDLER GOES HERE 52 HANDLR: .WORD .+2 53 .ENDC 54 ; 55 ; TERMINAL OUTPUT COLUMN COUNTER 56 ; 57 063250 OUTPOS: .BLKW 1 F.I.G. MACRO V04.00 00:03:00 PAGE 12-1 58 ; 59 ; 60 ; NOTE - CHANGE THE FOLLOWING LINE TO '.END' IF LINKING TO OTHER LANGUAGES. 61 000000' .END ORIGIN F.I.G. MACRO V04.00 00:03:00 PAGE 12-2 SYMBOL TABLE ABORT 010030R DOCON 002442R IF 012554R PFIND 000506R RW 015234R ABS 010336R DODOE 005000R IMMED 007570R PKEY 013722R RZERO 002706R AGAIN 012472R DOES 004764R IN 003074R PK001 013766R S =%000005 ALLOT 003462R DOT 013236R INDEX 013412R PK002 014002R SCR 003120R ALONE = 000001 DOTQ 005272R INTER 007452R PK003 014006R SCSP 004226R AND 001302R DOTR 013176R IP =%000004 PLINE 011554R SEMI 002376R ARROW 012016R DOUSE 002516R KEY 001030R PLMNS 003534R SEMIC 015264R ARW 015146R DOVAR 002472R LATES 004074R PLOOP 012400R SEMIS 001440R AT 002220R DOVOC 007662R LBRAC 004526R PLUS 001656R SIGN 013000R BACK 012206R DP 003000R LEAVE 001460R PNUMB 006224R SLASH 010606R BASE 003222R DPL 003234R LESS 003634R PORIG 002654R SLMOD 010566R BBUF 002622R DPLMNS 003556R LFA 004114R PQTER 014056R SMUDG 004572R BCOMP 007164R DPLUS 001674R LIMIT 003050R PREV 003332R SPACE 003754R BDIGS 012726R DRONE 011250R LINK = 015324R PSCOD 004714R SPACS 012670R BEGIN 012230R DROP 002026R LINK2 = 015324R PSPOUT 014040R SPAT 001360R BL 002574R DRZER 011230R LIST 013310R PSTOR 002114R SPSTO 001400R BLANK 006006R DSKBUF 054544R LIT 000060R QALIG 005360R SSLA 010670R BLK 003062R DTRAI 005152R LITER 007220R QCOMP 004304R SSMOD 010646R BLOCK 011406R DUP 002076R LOAD 011734R QCSP 004410R STAR 010546R BRAN 000122R ECELL 005122R LOOP 012350R QERR 004252R STATE 003206R BSCR 002636R EDIGS 012746R MAX 010440R QEXEC 004334R STOD 010310R BUFFE 011276R EIS = 000001 MESS 011642R QLOAD 004446R STORE 002264R BUILD 004744R ELSE 012604R MIN 010410R QPAIR 004364R SUB 003516R BYE 014146R EMIT 001020R MINUS 001734R QSTAC 007372R SWAP 002050R CAT 002240R ENCL 000676R MLOOP 000566R QTERM 001046R SZERO 002674R CENT 010124R ENC1 000712R MOD 010626R QUERY 005600R TASK 015334R CFA 004134R ENC2 000726R MSLAS 010514R QUEST 013252R THEN 012306R CL 002606R ENC3 000744R MSMOD 010712R QUIT 007752R THREE 002562R CMOVE 001070R ENC4 000772R MSTAR 010470R R 001532R TIB 002720R COLD 010122R END 012454R MTBUF 011100R RBRAC 004544R TICK 012056R COLON 002336R ENDBUF 062560R NFA 004152R RBUF = 177562 TOGGL 002146R COMMA 003476R ENDIF 012252R NOFAST 000560R RCSR = 177560 TOR 001500R COMP 004500R EQUAL 003604R NOFST1 000604R REPEAT 012522R TRAV 004026R CON 002430R ERASE 005764R NOT 010104R RLBA = 174402 TRIAD 013472R CONT 003154R ERROR 006662R NULL 005630R RLCHS 014266R TWO 002552R COUNT 005022R EXEC 000102R NUMB 006340R RLCS = 174400 TWOM 003420R CR 001056R EXPEC 005406R OCTAL 004666R RLCYL 014162R TWOP 003362R CREAT 007032R FAILED 000646R OFSET 003136R RLDA = 174404 TYPE 005046R CSP 003260R FAST 000532R ONE 002542R RLDIFF 014510R U =%000003 CSTOR 002312R FCOMP 000532R ONEM 003402R RLDIR 014446R UDIV 001226R CURR 003172R FENCE 002766R ONEP 003344R RLERR 015020R UDOT 013270R DABS 010364R FILL 005724R OR 001322R RLHDR 014400R ULESS 007306R DDOT 013220R FIRST 003034R ORIGIN 000000R RLHEAD 014214R UMULT 001144R DDOTR 013132R FLD 003246R OUT 003106R RLMP = 174406 UNTIL 012430R DDUP 003776R FLUSH 011132R OUTPOS 063250R RLN1 014470R UPDAT 011032R DEC 004642R FORGE 012110R OVER 002004R RLN2 014474R UPPER 006550R DEFIN 007710R FORTH 015312R PABOR 006644R RLRD 014674R USE 003316R DFIND 006470R FROMR 001516R PAD 006056R RLSEC 014244R USER 002510R DIG 013026R GFORTH 000000RG PAREN 007730R RLSEEK 014576R USLAS 001214R DIGIT 000400R GO 010260R PBKOUT 014024R RLSET 014636R USTAR 001132R DIGS 013102R GREAT 003664R PBKRET 014054R RLSTAT 014334R VAR 002464R DLESS 007342R HERE 003442R PBKSP 014012R RLWR 014746R VLIST 013562R DLINE 011616R HEX 004614R PBUF 010750R RL02 = 000001 VOCAB 007622R DLITE 007256R HLD 003304R PCR 014104R RNUM 003272R VOCL 003020R DMINU 001756R HOLD 006026R PDOTQ 005236R ROT 003716R W =%000002 DO 012322R I 000360R PEMIT 013666R RP =%000006 WARN 002752R DOCOL 002362R IDDOT 006742R PFA 004200R RPSTO 001420R WENT 010214R F.I.G. MACRO V04.00 00:03:00 PAGE 12-3 SYMBOL TABLE WHILE 012646R XXD6 007240R XXI2 006132R XXN5 007276R XXVOC 015322R WIDTH 002734R XXEA 007516R XXJ1 005702R XXRA 012710R XXWA 005220R WORD 006102R XXE1 006624R XXJ2 005706R XXRB 010400R XXW3 011702R W2 010220R XXE2 006562R XXJ4 005712R XXR1 013020R XXW4 011722R XBUF = 177566 XXE3 006536R XXK1 005420R XXR2 013062R XXW5 011706R XCSR = 177564 XXE4 007454R XXK2 005500R XXR3 013104R XXW6 005162R XDO 000334R XXE5 007504R XXK3 005556R XXR4 012716R XXW7 005214R XDP 015340R XXE6 007510R XXK4 005530R XXR5 010352R XXZ1 013350R XLOOP 000202R XXE7 007550R XXK5 005532R XXR6 010456R XXZ2 013424R XMATCH 000544R XXFA 006456R XXL1 005066R XXR7 010426R XXZ3 013454R XOR 001340R XXF3 006226R XXL2 005104R XXTA 011146R XXZ4 013524R XPLOO 000250R XXF4 007542R XXL3 005106R XXT1 011006R XXZ5 013602R XR0 = 063050R XXF5 007546R XXL6 005334R XXT2 011310R XXZ6 013630R XS0 054540R XXF6 006376R XXL7 005344R XXT3 011356R ZBRAN 000144R XTIB 062560R XXF7 006444R XXN1 004032R XXT4 011532R ZEQU 001550R XUP 063050R XXG4 006322R XXN2 004270R XXT5 011446R ZERO 002532R XXB1 007764R XXG5 006314R XXN3 004272R XXT6 011500R ZGT 001630R XXB2 010014R XXI1 006126R XXN4 006700R XXT7 011202R ZLESS 001600R XXD2 007060R . ABS. 000000 000 063252 001 ERRORS DETECTED: 0 VIRTUAL MEMORY USED: 8448 WORDS ( 33 PAGES) DYNAMIC MEMORY AVAILABLE FOR 67 PAGES DK:FORTH,DK:FORTH.LST[400]=DK:FORTH.MAC GT 001636R XXD2 007066R XXI1 006134R XXN4 006706R XXT7 011320R ZLESS 001606R . ABS. 000000 000 063370 001 ERRORS DETECTED: 0 VIRTUAL MEMORY USED: 8448 WORDS ( 33 PAGES) DYNAMIC MEMORY AVAILABLE FOR 67 PAGES DK:FORTH,DK:FORTH.LST[400]=DK:FORTH.MAC 6140R XXN5 007304R XXVOC 015540R ZLESS 001606R XXEA 007524R XXJ1 005710R XXRA 013026R . ABS. 000000 000 063470 001 ERRORS DETECTED: 0 VIRTUAL MEMORY USED: 8448 WORDS ( 33 PAGES) DYNAMIC MEMORY AVAILABLE FOR 67 PAGES DK:FORTH,DK:FORTH.LST[400]=DK:FORTH.MAC ; 2. TYPE '38 LOAD', AND CARRIAGE RETURN. THE SYSTEM SHOULD 20 ; RESPOND 'OK'. THEN TYPE 'COPY' AND RETURN. EACH OF 21 ; THE 77 TRACKS WILL BE READ FROM DX0 AND WRITTEN ON DX1. 22 ; - NOTE THE LAYOUT OF THE DISKETTE. IT IS SET UP TO BOOT AND 23 ; RUN STAND-ALONE, BUT IT ALSO CONTAINS AN RT-11 DIRECTORY, 24 ; AND A MACRO-11 SOURCE PROGRAM 'FORTH.MAC' (WHICH PRODUCED 25 ; THIS LISTING). THIS ALLOWS THE SAME DISK TO BE BOOTED 26 ; AND RUN, OR TO PROVIDE SOURCE FOR MODIFICATION AND RE-ASSEMBLY. 27 ; AS PROVIDED, THE FILE 'FORTH.DAT' CONTAINS FORTH SCREENS 28 ; 1-70. YOU CAN USE LOCATIONS BEYOND 70, BUT THESE WILL 29 ; OVERWRITE THE 'FORTH.MAC' SOURCE PROGRAM. STAND-ALONE USERS 30 ; MAY NEVER NEED TO USE THIS SOURCE, AND MAY WANT TO REMOVE IT 31 ; AND USE THE SPACE FOR SOMETHING ELSE. MAKE A COPY FIRST. 32 ; - STAND-ALONE USERS CAN ADD THEIR OWN OPERATIONS AND THEN 33 ; SAVE A BOOTABLE IMAGE OF THE NEW SYSTEM. THE NEW OPERATIONS 34 ; WILL BE AVAILABLE WHEN THE DISK IS BOOTED IN THE FUTURE. 35 ; THE LOADER WHICH IS USED WILL ONLY LOAD IMAGES UP TO 7.9K; 36 ; THIS LEAVES SEVERAL HUNDRED BYTES FOR NEW OPERATIONS, WHICH 37 ; CAN INCLUDE EXTENDING THE SYSTEM BY BRINGING IN SOURCE OR 38 ; OBJECT CODE. TO SAVE THE CURRENT SYSTEM, EXECUTE 'FORTH DEFINITIONS' 39 ; IF NECESSARY TO GET INTO THE FORTH VOCABULARY, THEN 'DECIMAL 34 LOAD'. 40 ; SOME WARNING MESSAGES WILL BE PRINTED (MSG #4); THEY CAN BE 41 ; IGNORED. 42 ; - IF YOU DO WANT TO RE-ASSEMBLE THE SYSTEM FOR STAND-ALONE 43 ; USE (WHICH MOST USERS SHOULD NEVER FIND NECESSARY), 44 ; YOU MUST USE RT-11 TO EDIT AND ASSEMBLE 'FORTH.MAC'. NOTE 45 ; THAT ALTHOUGH THIS LISTING IS ASSEMBLED FOR STAND-ALONE, 46 ; THE SOURCE PROGRAM SUPPLIED IS SET FOR RT-11 ASSEMBLY; 47 ; COMMENT OUT THE 'RT11' DEFINITION, AND REMOVE THE COMMENTING 48 ; ON 'ALONE'. ASSEMBLE, LINK, AND RUN, AND THE SYSTEM SHOULD 49 ; COME UP STAND-ALONE. IMMEDIATELY REMOVE THE RT-11 SYSTEM DISK 50 ; AND PLACE THE FORTH DISK IN DRIVE ZERO. TO REVISE 51 ; THE BOOTABLE IMAGE ON THE FORTH DISK SO THAT YOUR NEW SYSTEM 52 ; BOOTS STAND-ALONE, LIST SCREEN 34 (DECIMAL), AND FOLLOW THE 53 ; INSTRUCTIONS THERE. THE RUN TAKES ABOUT ONE MINUTE. 54 ; - THE BOOTABLE SYSTEM DOES NOT USE HARDWARE MULTIPLY AND DIVIDE. 55 ; IF YOU DON'T HAVE RT-11 TO EDIT AND RECOMPILE WITH 'EIS' 56 ; CONDITIONAL ASSEMBLY, THE MULTIPLY/DIVIDE ROUTINES CAN BE 57 ; PATCHED. IF YOU PATCH FROM THE KEYBOARD MONITOR, THE F.I.G. MACRO V04.00 00:00:13 PAGE 3-1 58 ; RESTART ADDRESS IS 1000 OCTAL ( COLD START) OR 1004 (WARM 59 ; START). SAVE THE NEW VERSION AS A BOOTABLE SYSTEM, AS 60 ; DESCRIBED ABOVE. 61 ; - THE SKEWED DISK I/O OPERATIONS SKIP TRACK ZERO, FOR COMPATIBILITY 62 ; WITH STANDARD PDP-11 SECTOR SKEWING. THE PHYSICAL READ 63 ; OPERATIONS ('RTS', 'WTS', 'NRTS', 'NWTS') CAN READ ANY SECTOR, 64 ; HOWEVER. 65 ; - ALSO THE SYSTEM AS DISTRIBUTED SKIPS THE FIRST 56 SECTORS 66 ; (7 SCREENS) IN ORDER TO SKIP THE BOOT BLOCK AND AN 67 ; RT-11 DIRECTORY. THIS CAUSES THE SCREEN POSITIONS TO BE THE 68 ; SAME FOR STAND-ALONE AND FOR RT-11 (WHICH ACCESSES THE FILE 69 ; 'FORTH.DAT'). YOU CAN CHANGE THIS BY CHANGING THE VALUE OF 70 ; THE VARIABLES 'S-SKIP' (NUMBER OF SCREENS SKIPPED) AND 71 ; 'S-USE' (NUMBER OF SCREENS USED BEFORE ACCESSING THE 72 ; SECOND DISK). THESE VARIABLES CAN BE CHANGED AT ANY TIME, 73 ; SO DISK SCREENS CAN BE READ INTO BUFFERS AND THEN FLUSHED 74 ; TO DIFFERENT LOCATIONS ON THE DISK. 75 ; - ADVANCED USERS MAY NOTE THAT THIS SYSTEM IS DESIGNED TO 76 ; ALLOW THE MEMORY LAYOUT - NUMBER AND LOCATION OF DISK 77 ; BUFFERS, LOCATION OF THE STACK, ETC. - TO BE CHANGED 78 ; DYNAMICALLY, WITHOUT REASSEMBLY. 79 ; 80 ; 81 ; TO BRING UP THIS SYSTEM UNDER RT-11: 82 ; - BE SURE THAT RT-11 IS SELECTED BELOW. THE LINES DEFINING 83 ; 'RSX11M' AND 'ALONE' SHOULD BE COMMENTED OUT; 'RT11' SHOULD 84 ; NOT BE. NOTE THAT THIS DISK IS DISTRIBUTED READY FOR RT-11 85 ; ASSEMBLY (EVEN THOUGH THIS LISTING IS FOR STAND-ALONE). 86 ; - IF YOU HAVE HARDWARE MULTIPLY/DIVIDE, ALSO REMOVE THE 87 ; SEMICOLON FROM THE LINE DEFINING 'EIS'. 88 ; - IF YOU ARE USING AN OLDER VERSION OF RT-11 (VERSION 2), 89 ; YOU MAY NEED TO USE THE MACROS '..V2..' AND '.REGDEF'. 90 ; - ASSEMBLE, LINK, AND RUN. THE SYSTEM SHOULD COME UP AND 91 ; TYPE 'FIG-FORTH' AND THE VERSION NUMBER. 92 ; - TEST THAT IT IS UP BY TRYING SOME ARITHMETIC OR DEFINITIONS, E.G. 93 ; 88 88 * . (NOTE THAT THE '.' MEANS PRINT) 94 ; : SQUARE DUP * ; 95 ; 25 SQUARE . 96 ; OR TYPE 'VLIST' FOR A LIST OF ALL THE FORTH OPERATIONS IN THE 97 ; DICTIONARY. 98 ; - THE DISK SHOULD WORK IF THE DISKETTE IS IN DRIVE 'DK'. 99 ; MAKE SURE THAT 'DK' IS ASSIGNED TO WHATEVER PHYSICAL 100 ; DRIVE YOU ARE USING - OR CHANGE LINE 'RTFILE:' IN 101 ; 'FORTH.MAC'. TEST THE DISK BY TYPING 102 ; 1 LIST 103 ; WHICH SHOULD LIST THE SCREEN WHICH LOADS THE EDITOR, 104 ; ASSEMBLER, AND STRING ROUTINES. 105 ; - IN CASE YOU NEED TO GET A LISTING FROM THE ASSEMBLY OF 106 ; 'FORTH.MAC' (NOT USUALLY NECESSARY), AND YOUR SYSTEM HAS 107 ; ONLY DISKETTES (NO LARGER DISKS), THE 'ALLOCATE' OPTION 108 ; IS NECESSARY BECAUSE OF THE SIZE OF THE '.LST' FILE 109 ; (AROUND 230 BLOCKS). FIRST COPY 'FORTH.MAC' ONTO A 110 ; SEPARATE DISKETTE BY ITSELF. THEN EXECUTE 111 ; .MACRO /LIST:FORTH.LST /ALLOCATE:300. /NOOBJECT 112 ; AND REPLY 'FORTH.MAC' WHEN ASKED FOR 'FILES?'. 113 ; 114 ; F.I.G. MACRO V04.00 00:00:13 PAGE 3-2 115 ; 116 ; TO BRING UP THE SYSTEM UNDER RSX-11M: 117 ; - THE DISKETTE PROVIDED IS IN RT-11 FILE FORMAT. THE TWO FILES 118 ; MUST BE COPIED OFF THE DISKETTE INTO AN RSX DIRECTORY. THE 119 ; 'FORTH.DAT' FILE MUST BE COPIED IN IMAGE MODE. ANY RSX 120 ; DIRECTORY MAY BE USED. ASSUMING THE DISKETTE IS IN DRIVE 0, 121 ; USE THE RSX COMMANDS: 122 ; >FLX =DX:FORTH.MAC/RT 123 ; >FLX =DX:FORTH.DAT/RT/IM 124 ; INCIDENTALLY, 'FORTH.DAT' IS THE SYSTEM'S 'VIRTUAL MEMORY' 125 ; FILE, USED FOR DISK I/O. THE REST OF THE SYSTEM (THIS 126 ; PROGRAM ALONE) CAN RUN INDEPENDENTLY, EVEN IF 'FORTH.DAT' 127 ; IS NOT AVAILABLE. 128 ; - EDIT 'FORTH.MAC' TO SELECT RSX ASSEMBLY. CHANGE THE SEMICOLON 129 ; TO COMMENT OUT 'RT11' NOT 'RSX11'. LET 'EIS' BE DEFINED IF 130 ; YOU HAVE HARDWARE MULTIPLY/DIVIDE. 131 ; - ASSEMBLE, TASK BUILD, AND RUN. TEST AS WITH RT11 ABOVE. 132 ; - THE DISK I/O SHOULD WORK IF 'FORTH.DAT' IS IN THE DEFAULT 133 ; DEVICE AND DIRECTORY. TEST AS ABOVE. 134 ; 135 ; 136 ; 137 ; THE SYSTEM AS SUPPLIED RESERVES 8000. BYTES FOR YOUR FORTH 138 ; PROGRAMMING AND STACK. THIS IS ENOUGH FOR SUBSTANTIAL PROJECTS. 139 ; (NOTE THAT THE EDITOR, ASSEMBLER, AND STRING PACKAGE, IF LOADED, 140 ; USE MORE THAN 5K OF THIS.) TO CHANGE THIS MEMORY SIZE, CHANGE 141 ; THE '8000.' WHICH IS IN THE LINES FOLLOWING THE LABEL 'DP:', 142 ; NEAR THE END OF THIS PROGRAM. INCIDENTALLY, VERY FEW JOBS 143 ; (E.G. RECURSION) WILL EVER USE MORE THAN 100 WORDS OF THIS SPACE 144 ; FOR THE STACK; THE REST OF THE SPACE IS AVAILABLE FOR A STRING 145 ; STACK (IF USED) OR FOR YOUR PROGRAMS - AND FORTH OBJECT CODE IS 146 ; CONSIDERABLY MORE COMPACT THAN ASSEMBLY. 147 ; 148 ; 149 ; 150 ; THE FORTH VIRTUAL FILE 'FORTH.DAT' IS USED FOR STORING SOURCE 151 ; PROGRAMS (OR DATA). THIS FILE HAS 70 1-K SCREENS (1-70), 152 ; I.E. 140 PDP-11 DISK BLOCKS. SCREENS 4 AND 5 ARE USED BY THE 153 ; SYSTEM FOR STORING ERROR AND WARNING MESSAGES. SCREENS 6-30 154 ; CONTAIN A TEXT EDITOR, ASSEMBLER, STRING PACKAGE, AND MISCELLANEOUS 155 ; EXAMPLES. SCREENS 40 THROUGH 47 CONTAIN A BINARY STAND-ALONE 156 ; SYSTEM (NOT USED UNDER RT-11 OR RSX-11M). USERS MAY WANT 157 ; TO SAVE THEIR SOURCE PROGRAMS AND DATA IN THE BLANK SCREENS. 158 ; THE SIZE OF THIS FORTH SCREENS FILE ('FORTH.DAT') CAN BE INCREASED 159 ; IF NEEDED. IF THE SYSTEM IS TO BE BOOTED STAND-ALONE, THE LOCATION 160 ; OF THE SYSTEM BINARY IMAGE ON THE DISK MUST NOT BE CHANGED; 161 ; THEREFORE, IF THE DISK IS TO BE USED TO RUN STAND-ALONE, DO NOT 162 ; USE RT-11 TO MOVE 'FORTH.DAT' TO ANOTHER PLACE ON THE DISK. 163 ; 164 ; 165 ; 166 ; 167 ; 168 ; NOTE THAT THE RT-11 AND RSX-11M SYSTEMS DO NOT ECHO CHARACTERS 169 ; WHICH ARE INPUT FROM THE TERMINAL. INSTEAD, THEY LET THE OPERATING 170 ; SYSTEM (RT-11 OR RSX-11M) ECHO THEM. THIS IS DONE SO THAT TYPING 171 ; CONVENTIONS WILL BE THE SAME AS THE USER IS FAMILIAR WITH. ALSO, F.I.G. MACRO V04.00 00:00:13 PAGE 3-3 172 ; TO AVOID SWAPPING DELAYS, THE RSX VERSION OF 'KEY' READS A LINE OF 173 ; CHARACTERS AT A TIME. 174 ; 175 ; 176 ; 177 ; 178 ; CHANGE THESE LINES TO CONTROL CONDITIONAL ASSEMBLY: 179 ; 180 ;RT11=1 ; COMMENTED OUT UNLESS RT-11 181 ;RSX11=1 ; COMMENTED OUT UNLESS RSX11M 182 000001 ALONE=1 ; COMMENTED OUT UNLESS STAND-ALONE 183 000001 RL02=1 ; COMMENTED OUT UNLESS STAND-ALONE RL02 IMAGE 184 ;EIS=1 ; COMMENTED OUT UNLESS HARDWARE MULTIPLY-DIVIDE 185 ;LINKS=1 ; COMMENTED OUT UNLESS SUBROUTINE LINKAGE FROM 186 ; FORTH TO OTHER LANGUAGES 187 ; 188 ;.PAGE 189 ; **************************************************************** 190 ; 191 ; VARIATIONS FROM F.I.G. MODEL 192 ; 193 ; **************************************************************** 194 ; 195 ; 196 ; 'FIRST' AND 'LIMIT' HAVE BEEN MADE USER VARIABLES, NOT CONSTANTS. 197 ; THEREFORE WHEN THEY ARE USED, 'FIRST @' AND 'LIMIT @' ARE 198 ; REQUIRED. 199 ; 200 ; ';CODE' AND 'FORTH' ARE NOT PURE CODE, SO THEY WERE MOVED TO THE 201 ; END OF THE DICTIONARY. THIS IS SO THE BULK OF THE DICTIONARY 202 ; COULD BE PUT IN PROM OR USED RE-ENTRANTLY. 203 ; 204 ; THE MACHINE-INDEPENDENT I/O SECTION WAS MOVED TO NEAR THE END OF 205 ; THE DICTIONARY, BECAUSE IT IS NOT ALWAYS PURE CODE, AND ALSO TO 206 ; ALLOW THE I/O TO BE REDEFINED WITHOUT REASSEMBLY. 207 ; 208 ; THIS SYSTEM MUST TEST FOR FIRST-TIME-THROUGH TERMINAL AND DISK 209 ; I/O, TO AVOID ERRONEOUS ATTEMPT TO OPEN FILES TWICE AT LATER COLD 210 ; STARTS. IT CLEARS DISK BUFFERS AT COLD START. 211 ; 212 ; CHANGES IN V 1.3.1 (PAUL HARDY): 213 ; - CHANGED VERSION NUMBER FROM "1.3" TO "1.3.1". 214 ; - CHANGED CPU FROM "11" (OCTAL) TO "11." (DECIMAL). 215 ; - ADDED "BIC #177600,(S)" TO CLEAR PARITY BIT & UPPER 216 ; BYTE FOR STANDALONE TERMINAL ASCII OUTPUT. 217 ; - CHANGED ".WORD" TO ".BLKW" IN DSKBUF AREA SO STANDALONE 218 ; BINARY IMAGE CAN BE VERIFIED TO FIT IN 017400 BYTES, 219 ; TO GUARANTEE ROOM FOR THE 2-SECTOR BOOT LOADER. 220 ; 221 ; CHANGES IN V 1.3.2 (PAUL HARDY): 222 ; - INCREASED USER AREA FROM 8000. BYTES TO 16000. BYTES; 223 ; ALL ADDRESSES ARE STILL BELOW 32768 FOR HANDLING AS SIGNED. 224 ; - ADDED ORIGINAL FIG-FORTH WORDS: +- D+- 225 ; - ADDED WORDS FOR FIG-FORTH 1986 REVISION BY C.H. TING: 226 ; NUCLEUS: 0> 1- 2- D< NOT ( ABSENT: EXIT -- IN SCREEN 83 ) 227 ; INTERPRETER: ( ABSENT: FIND ) 228 ; COMPILER: ( ABSENT: J -- IN SCREEN 81 ) F.I.G. MACRO V04.00 00:00:13 PAGE 3-4 229 ; - ON TERMINAL IN STAND-ALONE MODE, BACKSPACE NOW GENERATES 230 ; ,, TO ERASE LAST CHARACTER FROM SCREEN. 231 ; - ADDED 'OUTPOS' WORD TO STORE OUTPUT CHARACTER COUNT, 232 ; FOR BACKSPACE/DELETE (RUBOUT). DOES NOT HANDLE TABS. 233 ; 234 ; CHANGES IN V 1.3.3 (PAUL HARDY): 235 ; - ADD RL02 SUPPORT IN STAND-ALONE MODE. 236 ; 237 ; F.I.G. MACRO V04.00 00:00:13 PAGE 4 1 ; **************************************************************** 2 ; 3 ; SET UP REGISTERS AND MACROS. 4 ; 5 ; **************************************************************** 6 ; 7 ; 8 000002 W=%2 ; TEMPORARY USED BY 'NEXT' MACRO (THE INNER INTERPRETER) 9 000003 U=%3 ; POINTER TO THE USER AREA 10 000004 IP=%4 ; FORTH INSTRUCTION COUNTER 11 000005 S=%5 ; FORTH STACK POINTER 12 000006 RP=SP ; FORTH RETURN-STACK POINTER 13 ; 14 ; NOTE - CODE ROUTINES CAN USE REGISTERS 0, 1, 4, AND 5, WITHOUT 15 ; RESTORING THEM. 16 ; 17 ; 18 ; MACRO DEFINITIONS 19 ; 20 ; 21 ; 22 ; THE 'HEAD' MACRO CREATES A FORTH DICTIONARY HEADER. ITS ARGUMENTS ARE: 23 ; (1) LENGTH BYTE - THE LENGTH OF THE NAME BEING DEFINED. THE SIGN BIT 24 ; OF THE LENGTH BYTE MUST BE SET, SO THAT THE SYSTEM WILL RECOGNIZE 25 ; THE END OF A VARIABLE-LENGTH NAME FIELD; THEREFORE THE LENGTH BYTE 26 ; IS GIVEN AS 200 OCTAL PLUS THE LENGTH. IF THE OPERATION IS 27 ; IMMEDIATE, THE BIT NEXT TO THE SIGN BIT IS ALSO SET, SO THE LENGTH 28 ; BYTE IS GIVEN AS 300 OCTAL PLUS THE LENGTH. 29 ; (2) NAME - THE NAME OF THE OPERATION BEING DEFINED. 30 ; (3) LCHAR - THE ASCII VALUE OF THE LAST CHARACTER OF THE NAME, WITH THE 31 ; SIGN BIT SET. THE NAME FIELD MUST HAVE AN EVEN LENGTH (INCLUDING 32 ; THE LENGTH BYTE), SO IF THE NUMBER OF CHARACTERS IN THE NAME IS 33 ; EVEN, 'LCHAR' WILL BE GIVEN AS 240 (200 PLUS CODE FOR A SPACE). 34 ; (4) LABEL - THE ASSEMBLY-LANGUAGE LABEL ASSOCIATED WITH THE 'CODE FIELD' 35 ; OF THIS DICTIONARY HEADER. THESE LABELS ARE USED IN THE PRECOMPILED- 36 ; FORTH SECTION OF THE SYSTEM. WHEN POSSIBLE, THE FORTH OPERATION 37 ; NAME ITSELF IS USED AS THE ASSEMBLY LABEL; OTHERWISE AN ABBREVIATION 38 ; IS USED. BY CONVENTION, THESE NAMES ARE LIMITED TO FIVE CHARACTERS, 39 ; FOR CONSISTENCY AMONG VARIOUS ASSEMBLERS FOR DIFFERENT MICROPROCESSORS. 40 ; (THE FORTH IMPLEMENTATION TEAM USES THE SAME LABELS IN ALL OF ITS 41 ; VERSIONS.) 42 ; (5) CODE - POINTER TO THE MACHINE-LANGUAGE "CODE ROUTINE" ASSOCIATED 43 ; WITH THIS OPERATION TYPE OR DATA TYPE. E.G. FOR ANY COLON DEFINITION, 44 ; THIS ARGUMENT IS 'DOCOL', THE LABEL OF A FIVE-INSTRUCTION ASSEMBLY 45 ; ROUTINE WHICH USES THE RETURN STACK TO HANDLE THE NESTED EXECUTION 46 ; OF ANOTHER LEVEL OF FORTH OPERATIONS. FOR ANY CONSTANT, THIS CODE 47 ; ROUTINE IS 'DOCON', AND SIMILARLY FOR ALL OTHER DATA TYPES. 48 ; THE CODE ARGUMENT MAY BE OMITTED. IN THAT CASE, THE 'HEAD' 49 ; MACRO LEAVES THE CODE FIELD POINTING TWO BYTES BEYOND ITSELF, WHERE 50 ; MACHINE-LANGUAGE CODE MUST BEGIN - AND THE OPERATION SO DEFINED IS 51 ; CALLED A "PRIMITIVE". THE "NUCLEUS SECTION" OF THIS VERSION OF 52 ; FORTH CONTAINS ABOUT 45 PRIMITIVES, FROM WHICH THE WHOLE SYSTEM 53 ; IS BUILT; IN EFFECT, THESE PRIMITIVES DEFINE THE VIRTUAL FORTH 54 ; MACHINE. (A FEW OPERATIONS IN THE "PRECOMPILED FORTH" SECTION 55 ; OF THE SYSTEM HAVE BEEN REPLACED WITH PRIMITIVES, TO OPTIMIZE 56 ; EXECUTION SPEED. AND WHEN A FORTH ASSEMBLER IS ADDED TO THIS 57 ; SYSTEM, USERS WILL BE ABLE TO DEFINE THEIR OWN PRIMITIVES DIRECTLY F.I.G. MACRO V04.00 00:00:13 PAGE 4-1 58 ; IN FORTH, IMMEDIATELY READY FOR EXECUTION.) 59 ; 60 ; THE 'HEAD' MACRO CREATES A FORTH HEADER CONSISTING OF 61 ; LENGTH BYTE - SIGN BIT SET 62 ; NAME OF THE OPERATION - VARIABLE LENGTH - SIGN BIT SET ON LAST CHAR. 63 ; LINK FIELD, WHICH POINTS TO THE BEGINNING OF THE PREVIOUS DICTIONARY 64 ; HEADER (USED AT COMPILE TIME) 65 ; CODE POINTER. 66 ; 67 000000 LINK=0 ; LAST LINK FIELD IS 0, INDICATING END OF THE DICTIONARY. 68 69 ; 70 .MACRO HEAD,LENGTH,NAME,LCHAR,LABEL,CODE 71 LINK2=. 72 .BYTE LENGTH 73 .ASCII ^NAME^ 74 .EVEN 75 .=.-1 76 .BYTE LCHAR ; LAST CHARACTER OF NAME (OR BLANK FILL), 77 ; PASSED IN OCTAL, WITH HIGH BIT SET. 78 .WORD LINK 79 LINK=LINK2 80 LABEL: .IF NB CODE 81 .WORD CODE 82 .IFF 83 .WORD .+2 84 .ENDC 85 .ENDM 86 ; 87 ; 88 ; 89 ; THE 'NEXT' MACRO TRANSFERS CONTROL FROM ONE FORTH OPERATION TO THE 90 ; 'CODE ROUTINE' OF THE NEXT. NOTICE THAT ONLY TWO INSTRUCTION 91 ; EXECUTIONS ARE REQUIRED TO TRANSFER CONTROL FROM USEFUL OPERATIONS 92 ; OF ONE FORTH PRIMITIVE TO THOSE OF THE NEXT. 93 ; 94 .MACRO NEXT 95 MOV (IP)+,W 96 JMP @(W)+ 97 .ENDM 98 ; 99 ; 100 ; MACRO CALLS 101 ; 102 ; 103 .IFDF RT11 104 .MCALL .RCTRLO,.TTYIN,.TTINR,.TTYOUT,.EXIT,.TRPSET 105 .MCALL .SETTOP,.DSTATUS,.FETCH,.LOOKUP,.READW,.WRITW 106 .ENDC 107 ; 108 ; 109 .IFDF RSX11 110 .MCALL QIOW$C,EXIT$S,ALUN$C,ASTX$S,SVTK$S 111 .MCALL FDBDF$,FDRC$A,FDBK$A,FDOP$A,FSRSZ$ 112 .MCALL OPEN$M,READ$,WRITE$,WAIT$,CLOSE$ 113 .MCALL QIOW$ 114 .ENDC F.I.G. MACRO V04.00 00:00:13 PAGE 5 1 ; **************************************************************** 2 ; 3 ; START-UP TABLE 4 ; 5 ; **************************************************************** 6 ; 7 ; AT STARTUP, MOST OF THESE VALUES ARE MOVED INTO THE USER AREA 8 ; (STARTING AT 'XDP:'); THEY ARE NORMALLY ACCESSED THERE. THE VALUES 9 ; HERE ARE NOT USUALLY CHANGED, BUT THEY MAY BE CHANGED E.G. TO 10 ; CONTROL WHAT HAPPENS AT COLD START. THIS TABLE COULD BE MOVED OUT OF 11 ; LOW MEMORY IF NECESSARY FOR ROM SYSTEMS. 12 ; 13 ; 14 ; 15 000000 GFORTH:: ; GLOBAL LABEL - NORMALLY NOT USED 16 000000 000167 010126 ORIGIN: JMP CENT ; COLD START ENTRY POINT 17 000004 000167 010212 JMP WENT ; WARM START ENTRY ADDRESS 18 ; NOTE - COLD START WIPES OUT ANY NEW DICTIONARY DEFINITIONS, AND 19 ; THEN DOES A WARM START. WARM START CLEANS UP STACKS, TERMINAL 20 ; BUFFER, ETC. 21 000010 000013 .WORD 11. ; CPU 22 000012 000000 .WORD 0 ; REVISION 23 000014 015056' .WORD TASK-10 ; POINTER TO LATEST WORD DEFINED 24 000016 000010 .WORD 10 ; BACKSPACE CHARACTER 25 000020 062602' .WORD XUP ; POINTER TO USER AREA 26 ; NOTE - THE USER AREA IS A HOOK IN THIS SYSTEM TO ALLOW MULTITASKING 27 ; TO BE ADDED LATER. 28 000022 054272' .WORD XS0 ; POINTER TO BEGINNING OF THE STACK 29 000024 062602' .WORD XR0 ; POINTER TO BEGINNING OF RETURN STACK 30 000026 062312' .WORD XTIB ; POINTER TO TERMINAL INPUT BUFFER 31 000030 000037 .WORD 37 ; MAXIMUM NAME-FIELD WIDTH, NORMALLY 31 32 000032 000000 .WORD 0 ; WARNING MODE; 0=ERROR #, 1=DISK MESSAGE 33 ; NOTE - WARNING MODE INITIALIZED TO ZERO, IN CASE DISK ISN'T UP. 34 000034 015072' .WORD XDP ; FENCE TO PROTECT AGAINST ACCIDENTAL 35 ; 'FORGET' OF THE SYSTEM. 36 000036 015072' .WORD XDP ; POINTER TO NEXT AVAILABLE DICTIONARY 37 ; LOCATION (RETURNED BY 'HERE'). 38 000040 015054' .WORD XXVOC ; POINTER TO INITIAL VOCABULARY LINK 39 000042 054276' .WORD DSKBUF ; INITIALIZE 'FIRST' 40 000044 062312' .WORD ENDBUF ; INITIALIZE 'LIMIT' 41 000046 000000 .WORD 0 ; AVAILABLE 42 000050 000000 .WORD 0 ; AVAILABLE 43 ; F.I.G. MACRO V04.00 00:00:13 PAGE 6 1 ; **************************************************************** 2 ; 3 ; NUCLEUS 4 ; 5 ; **************************************************************** 6 ; 7 ; 8 ; 9 ; THE NUCLEUS CONTAINS THE PRIMITIVES FROM WHICH THE SYSTEM IS BUILT. 10 ; 11 ; 12 ; 13 ; 14 000052 HEAD 203,LIT,324,LIT ; ***** LIT 15 ; USED ONLY BY COMPILER. PUSH FOLLOWING LITERAL ONTO STACK. 16 000062 012445 MOV (IP)+,-(S) 17 000064 NEXT 18 ; 19 000070 HEAD 207,EXECUTE,305,EXEC ; ***** EXECUTE 20 ; EXECUTE FORTH WORD WHOSE CODE ADDRESS IS ON STACK 21 000104 012502 MOV (S)+,W 22 000106 000132 JMP @(W)+ 23 ; 24 ; 25 000110 HEAD 206,BRANCH,240,BRAN ; ***** BRANCH 26 ; USED ONLY BY COMPILER. FORTH BRANCH TO ADDRESS WHICH FOLLOWS. 27 000124 061404 ADD (IP),IP 28 000126 NEXT 29 ; 30 000132 HEAD 207,0BRANCH,310,ZBRAN ; ***** 0BRANCH 31 ; USED ONLY BY COMPILER. FORTH BRANCH IF TOP OF STACK 32 ; IS ZERO (FALSE). 33 000146 005725 TST (S)+ 34 000150 001003 BNE 3$ 35 000152 061404 ADD (IP),IP 36 000154 NEXT 37 000160 062704 000002 3$: ADD #2,IP 38 000164 NEXT 39 ; 40 000170 HEAD 206,(LOOP),240,XLOOP ; ***** (LOOP) 41 ; USED ONLY BY COMPILER. INCREMENT LOOP INDEX BY 1, BRANCH 42 ; IF BELOW LIMIT. 43 000204 005216 INC (RP) 44 000206 021666 000002 CMP (RP),2(RP) 45 000212 002003 BGE 1$ 46 000214 061404 ADD (IP),IP 47 000216 NEXT 48 000222 062706 000004 1$: ADD #4,RP 49 000226 062704 000002 ADD #2,IP 50 000232 NEXT 51 ; 52 000236 HEAD 207,(+LOOP),251,XPLOO ; ***** (+LOOP) 53 ; USED ONLY BY COMPILER. INCREMENT LOOP INDEX BY TOP OF STACK, 54 ; MAYBE BRANCH. 55 000252 061516 ADD (S),(RP) 56 000254 005725 TST (S)+ 57 000256 002414 BLT 2$ F.I.G. MACRO V04.00 00:00:13 PAGE 6-1 58 000260 026616 000002 CMP 2(RP),(RP) 59 000264 003403 BLE 1$ 60 000266 061404 ADD (IP),IP 61 000270 NEXT 62 000274 062706 000004 1$: ADD #4,RP 63 000300 062704 000002 ADD #2,IP 64 000304 NEXT 65 000310 021666 000002 2$: CMP (RP),2(RP) ; HANDLE NEGATIVE INCREMENT 66 000314 003767 BLE 1$ 67 000316 061404 ADD (IP),IP 68 000320 NEXT 69 ; 70 000324 HEAD 204,(DO),240,XDO ; ***** (DO) 71 ; USED ONLY BY COMPILER. SET UP 'DO' LIMIT AND INDEX. 72 000336 016546 000002 MOV 2(S),-(RP) 73 000342 011546 MOV (S),-(RP) 74 000344 062705 000004 ADD #4,S 75 000350 NEXT 76 ; 77 000354 HEAD 201,I,311,I ; ***** I 78 ; RETURN CURRENT LOOP INDEX TO STACK. 79 000362 011645 MOV (RP),-(S) 80 000364 NEXT 81 ; 82 000370 HEAD 205,DIGIT,324,DIGIT ; ***** DIGIT 83 ; USED BY COMPILER. 84 ; ( ASCII-DIGIT BASE ==> DIGIT-VALUE TRUE (OR FALSE)) 85 000402 162765 000060 000002 SUB #60,2(S) ; VALID DIGIT IS ASCII 60 - 86 000410 026527 000002 000011 CMP 2(S),#11 ; IF GREATER THAN 9, 87 000416 003407 BLE 1$ 88 000420 162765 000007 000002 SUB #7,2(S) ; SUBTRACT 7. 89 000426 026527 000002 000012 CMP 2(S),#12 ; AND THEN IF <10 (A) 90 000434 002412 BLT 2$ ; ERROR 91 000436 005765 000002 1$: TST 2(S) ; IF LESS THAN ZERO, ERROR 92 000442 002407 BLT 2$ 93 000444 026515 000002 CMP 2(S),(S) ; OR IF NOT LESS THAN BASE, ERR 94 000450 002004 BGE 2$ 95 000452 012715 000001 MOV #1,(S) ; VALID RETURN 96 000456 NEXT 97 000462 062705 000002 2$: ADD #2,S 98 000466 005015 CLR (S) ; ERROR - RETURN '0' FLAG 99 000470 NEXT 100 ; 101 ; 102 000474 HEAD 206,(FIND),240,PFIND ; ***** (FIND) 103 ; USED BY COMPILER. FIND A WORD IN THE DICTIONARY. 104 ; ( STRING-ADDRESS NFA ==> PFA LENGTH TRUE (OR FALSE)). 105 ; STRING-ADDRESS IS ADDRESS OF THE LENGTH BYTE OF THE 106 ; STRING BEING SOUGHT. NFA IS NAME-FIELD ADDRESS OF 107 ; WORD IN DICTIONARY WHERE SEARCH BEGINS. PFA IS 108 ; PARAMETER-FIELD ADDRESS OF THE DICTIONARY ENTRY 109 ; WHICH IS FOUND. IF WORD NOT FOUND, ONLY ONE RESULT 110 ; (0, FALSE) IS RETURNED. 111 ; SETUP - GET ARGS, PRESERVE NEEDED REGISTERS 112 000510 012500 MOV (S)+,R0 ; DICTIONARY ADDRESS 113 000512 012501 MOV (S)+,R1 ; STRING ADDRESS 114 000514 010546 MOV R5,-(RP) ; PRESERVE REGISTERS F.I.G. MACRO V04.00 00:00:13 PAGE 6-2 115 000516 010446 MOV R4,-(RP) 116 000520 010346 MOV R3,-(RP) 117 000522 005046 CLR -(RP) ; SPACE TO STORE LENGTH BYTE 118 ; PREPARE R2 FOR FAST COMPARE 119 000524 011102 MOV (R1),R2 120 000526 042702 100200 BIC #100200,R2 121 ; 122 000532 FCOMP: 123 ; FAST TEST TO ELIMINATE MOST WORDS 124 ; COMPARE FIRST WORD TO SPECIALLY PREPARED R2 125 ; THEN INCREMENT TO FIND END OF NAME. 126 000532 011003 FAST: MOV (R0),R3 127 000534 042703 100300 BIC #100300,R3 128 000540 020203 CMP R2,R3 129 000542 001406 BEQ NOFAST ; NO FAST ELIMINATION POSSIBLE 130 000544 005720 XMATCH: TST (R0)+ ; BRANCH HERE IF NO MATCH THIS TIME 131 000546 100376 BPL XMATCH 132 ; R0 NOW POINTS TO LINK 133 000550 005710 TST (R0) 134 000552 001435 BEQ FAILED 135 000554 011000 MOV (R0),R0 136 000556 000765 BR FCOMP 137 ; END OF FAST ELIMINATION TEST 138 ; 139 000560 011016 NOFAST: MOV (R0),(RP) ; SAVE LENGTH BYTE 140 000562 010105 MOV R1,R5 ; SET R5 141 000564 000407 BR NOFST1 142 ; NOW DO THE MAIN LOOP TO CHECK FOR MATCH 143 000566 005725 MLOOP: TST (R5)+ 144 000570 011504 MOV (R5),R4 145 000572 011003 MOV (R0),R3 146 000574 042703 100000 BIC #100000,R3 147 000600 020304 CMP R3,R4 148 000602 001360 BNE XMATCH 149 000604 032720 100000 NOFST1: BIT #100000,(R0)+ 150 000610 001766 BEQ MLOOP 151 ; IF GET HERE, FOUND IT. 152 000612 012602 MOV (RP)+,R2 ; POP AND SAVE LENGTH BYTE 153 000614 012603 MOV (RP)+,R3 ; RESTORE REGISTERS 154 000616 012604 MOV (RP)+,R4 155 000620 012605 MOV (RP)+,R5 156 000622 062700 000004 ADD #4,R0 ; GET PARAMETER FIELD ADDRESS 157 000626 010045 MOV R0,-(S) 158 000630 042702 177400 BIC #177400,R2 ; R2 CONTAINS LENGTH BYTE 159 000634 010245 MOV R2,-(S) 160 000636 012745 000001 MOV #1,-(S) 161 000642 NEXT 162 000646 005726 FAILED: TST (RP)+ ; POP LENGTH BYTE 163 000650 012603 MOV (RP)+,R3 ; RESTORE REGISTERS 164 000652 012604 MOV (RP)+,R4 165 000654 012605 MOV (RP)+,R5 166 000656 005045 CLR -(S) ; REPLACE LENGTH BYTE WITH 167 ; FAILURE FLAG. 168 000660 NEXT ; WE ARE DONE - FAILURE TO FIND 169 ; 170 000664 HEAD 207,ENCLOSE,305,ENCL ; ***** ENCLOSE 171 ; USED BY COMPILER. BREAK NEXT WORD OUT OF INPUT BUFFER. F.I.G. MACRO V04.00 00:00:13 PAGE 6-3 172 ; ( START-ADDRESS DELIMITER ==> ADDRESS OFFSET END NEXT-CHARACTER) 173 000700 011500 MOV (S),R0 ; DELIMITER 174 000702 016501 000002 MOV 2(S),R1 ; STARTING ADDRESS 175 000706 162705 000004 SUB #4,S ; MAKE SPACE FOR RESULTS 176 000712 122100 ENC1: CMPB (R1)+,R0 177 000714 001776 BEQ ENC1 ; SKIP OVER LEADING DELIMITERS 178 000716 162701 000001 SUB #1,R1 179 000722 010165 000004 MOV R1,4(S) 180 000726 105711 ENC2: TSTB (R1) ; TEST FOR NULL 181 000730 001420 BEQ ENC4 182 000732 122100 CMPB (R1)+,R0 ; NOT NULL, SO FIND END OF TOKEN 183 000734 001374 BNE ENC2 184 000736 010115 MOV R1,(S) 185 000740 162701 000001 SUB #1,R1 186 000744 010165 000002 ENC3: MOV R1,2(S) ; FINISH UP AND RETURN 187 000750 016501 000006 MOV 6(S),R1 188 000754 160115 SUB R1,(S) 189 000756 160165 000002 SUB R1,2(S) 190 000762 160165 000004 SUB R1,4(S) 191 000766 NEXT 192 000772 010115 ENC4: MOV R1,(S) ; HANDLE NULL CASE 193 000774 020165 000004 CMP R1,4(S) 194 001000 001361 BNE ENC3 195 001002 062701 000001 ADD #1,R1 196 001006 000756 BR ENC3 197 198 ; 199 ; 200 ; THE NEXT 4 HEADERS POINT TO INSTALLATION-DEPENDENT TERMINAL I/O 201 ; ROUTINES. 202 ; 203 ; 204 001010 HEAD 204,EMIT,240,EMIT,PEMIT ; ***** EMIT 205 ; 206 001022 HEAD 203,KEY,331,KEY,PKEY ; ***** KEY 207 ; 208 001032 HEAD 211,?TERMINAL,314,QTERM,PQTER ; ***** ?TERMINAL 209 ; 210 001050 HEAD 202,CR,240,CR,PCR ; ***** CR 211 ; 212 ; 213 ; 214 ; 215 ; 216 001060 HEAD 205,CMOVE,305,CMOVE ; ***** CMOVE 217 ; MOVE BYTES IN MEMORY. ( FROM TO N ==>) 218 001072 005715 TST (S) 219 001074 001407 BEQ 2$ ; NO MOVE 220 001076 016500 000002 MOV 2(S),R0 221 001102 016501 000004 MOV 4(S),R1 222 001106 112120 1$: MOVB (R1)+,(R0)+ 223 001110 005315 DEC (S) 224 001112 001375 BNE 1$ 225 001114 062705 000006 2$: ADD #6,S 226 001120 NEXT 227 ; 228 ; F.I.G. MACRO V04.00 00:00:13 PAGE 6-4 229 001124 HEAD 202,U*,240,USTAR ; ***** U* 230 ; ( N1 N2 ==> PRODUCT). PRODUCT IS 32-BIT DOUBLE INTEGER, 231 ; HIGH WORD TOP. 232 ; THIS MUST BE UNSIGNED MULTIPLICATION. 233 001134 004767 000004 JSR PC,UMULT 234 001140 NEXT 235 001144 UMULT: 236 ; THE VALUES TO MULTIPLY ARE ON THE STACK. 237 001144 012502 MOV (S)+,R2 238 001146 012746 000020 MOV #20,-(RP) ; SET LOOP COUNT 239 001152 005000 CLR R0 240 001154 005001 CLR R1 241 001156 006101 2$: ROL R1 242 001160 006100 ROL R0 243 001162 006102 ROL R2 244 001164 103002 BCC 1$ 245 001166 061501 ADD (S),R1 246 001170 005500 ADC R0 247 001172 005316 1$: DEC (RP) 248 001174 001370 BNE 2$ 249 001176 010115 MOV R1,(S) 250 001200 010045 MOV R0,-(S) 251 001202 005726 TST (RP)+ ; POP TEMPORARY 252 001204 000207 RTS PC 253 ; 254 001206 HEAD 202,U/,240,USLAS ; ***** U/ 255 ; THIS DIVISION MUST BE UNSIGNED. 256 001216 004767 000004 JSR PC,UDIV 257 001222 NEXT 258 001226 UDIV: 259 ; THE VALUES TO DIVIDE ARE ON THE STACK 260 001226 012502 MOV (S)+,R2 ; DIVISOR 261 001230 012500 MOV (S)+,R0 262 001232 012501 MOV (S)+,R1 263 001234 012745 000020 MOV #20,-(S) ; LOOP COUNT 264 001240 006301 1$: ASL R1 265 001242 006100 ROL R0 266 001244 001405 BEQ 2$ ; NO NEED TO SUBTRACT 267 001246 160200 SUB R2,R0 268 001250 005201 INC R1 269 001252 103002 BCC 2$ 270 001254 060200 ADD R2,R0 ; MUST RESTORE 271 001256 005301 DEC R1 272 001260 005315 2$: DEC (S) ; LOOP SIXTEEN TIMES 273 001262 001366 BNE 1$ 274 001264 005725 TST (S)+ ; POP TO DISCARD COUNT 275 001266 010045 MOV R0,-(S) ; REMAINDER 276 001270 010145 MOV R1,-(S) ; QUOTIENT 277 001272 000207 RTS PC 278 ; 279 001274 HEAD 203,AND,304,AND ; ***** AND 280 ; BITWISE AND. ( N1 N2 ==> N3). 281 001304 005115 COM (S) 282 001306 042515 BIC (S)+,(S) 283 001310 NEXT 284 ; 285 001314 HEAD 202,OR,240,OR ; ***** OR F.I.G. MACRO V04.00 00:00:13 PAGE 6-5 286 001324 052515 BIS (S)+,(S) 287 001326 NEXT 288 ; 289 001332 HEAD 203,XOR,322,XOR ; ***** XOR 290 .IFDF EIS 291 MOV (S)+,R0 292 XOR R0,(S) 293 .IFF 294 001342 011546 MOV (S),-(RP) 295 001344 046516 000002 BIC 2(S),(RP) 296 001350 042515 BIC (S)+,(S) 297 001352 052615 BIS (RP)+,(S) 298 .ENDC 299 001354 NEXT 300 ; 301 001360 HEAD 203,SP@,300,SPAT ; ***** SP@ 302 001370 010501 MOV S,R1 303 001372 010145 MOV R1,-(S) 304 001374 NEXT 305 ; 306 001400 HEAD 203,SP!,241,SPSTO ; ***** SP! 307 001410 016305 000006 MOV 6(U),S ; OFFSET 6 IN USER AREA 308 309 001414 NEXT 310 ; 311 001420 HEAD 203,RP!,241,RPSTO ; ***** RP! 312 001430 016706 176370 MOV ORIGIN+24,RP 313 001434 NEXT 314 ; 315 001440 HEAD 202,<;S>,240,SEMIS ; ***** ;S 316 001450 012604 MOV (RP)+,IP 317 001452 NEXT 318 ; 319 001456 HEAD 205,LEAVE,305,LEAVE ; ***** LEAVE 320 001470 011666 000002 MOV (RP),2(RP) 321 001474 NEXT 322 ; 323 001500 HEAD 202,^/>R/,240,TOR ; ***** >R 324 001510 012546 MOV (S)+,-(RP) 325 001512 NEXT 326 ; 327 001516 HEAD 202,R>,240,FROMR ; ***** R> 328 001526 012645 MOV (RP)+,-(S) 329 001530 NEXT 330 ; 331 001534 HEAD 201,R,322,R ; ***** R 332 001542 011645 MOV (RP),-(S) 333 001544 NEXT 334 ; 335 001550 HEAD 202,0=,240,ZEQU ; ***** 0= 336 001560 005715 TST (S) 337 001562 001402 BEQ 1$ 338 001564 005015 CLR (S) 339 001566 000402 BR 2$ 340 001570 012715 000001 1$: MOV #1,(S) 341 001574 2$: 342 001574 NEXT F.I.G. MACRO V04.00 00:00:13 PAGE 6-6 343 ; 344 001600 HEAD 202,0<,240,ZLESS ; ***** 0< 345 001610 005715 TST (S) 346 001612 100402 BMI 1$ 347 001614 005015 CLR (S) 348 001616 000402 BR 2$ 349 001620 012715 000001 1$: MOV #1,(S) 350 001624 2$: 351 001624 NEXT 352 ; 353 001630 HEAD 202,0>,240,ZGT ; ***** 0> 354 001640 005715 TST (S) 355 001642 003002 BGT 1$ 356 001644 005015 CLR (S) 357 001646 000402 BR 2$ 358 001650 012715 000001 1$: MOV #1,(S) 359 001654 2$: 360 001654 NEXT 361 ; 362 001660 HEAD 201,+,253,PLUS ; ***** + 363 001666 062515 ADD (S)+,(S) 364 001670 NEXT 365 ; 366 001674 HEAD 202,D+,240,DPLUS ; ***** D+ 367 001704 066565 000002 000006 ADD 2(S),6(S) ; ADD LOW 368 001712 005565 000004 ADC 4(S) 369 001716 061565 000004 ADD (S),4(S) ; ADD HIGH 370 001722 062705 000004 ADD #4,S 371 001726 NEXT 372 ; 373 001732 HEAD 205,MINUS,323,MINUS ; ***** MINUS 374 ; CHANGE SIGN. 375 001744 005415 NEG (S) 376 001746 NEXT 377 ; 378 001752 HEAD 206,DMINUS,240,DMINU ; ***** DMINUS 379 ; CHANGE SIGN OF DOUBLE INTEGER WORD ON STACK. 380 001766 005415 NEG (S) 381 001770 005465 000002 NEG 2(S) 382 001774 005615 SBC (S) 383 001776 NEXT 384 ; 385 002002 HEAD 204,OVER,240,OVER ; ***** OVER 386 ; ( N1 N2 ==> N1 N2 N1) 387 002014 016545 000002 MOV 2(S),-(S) 388 002020 NEXT 389 ; 390 002024 HEAD 204,DROP,240,DROP ; ***** DROP 391 002036 062705 000002 ADD #2,S 392 002042 NEXT 393 ; 394 002046 HEAD 204,SWAP,240,SWAP ; ***** SWAP 395 002060 016501 000002 MOV 2(S),R1 396 002064 011565 000002 MOV (S),2(S) 397 002070 010115 MOV R1,(S) 398 002072 NEXT 399 ; F.I.G. MACRO V04.00 00:00:13 PAGE 6-7 400 002076 HEAD 203,DUP,320,DUP ; ***** DUP 401 002106 011545 MOV (S),-(S) 402 002110 NEXT 403 ; 404 002114 HEAD 202,+!,240,PSTOR ; ***** +! 405 ; ADD NUMBER SECOND ON STACK TO ADDRESS ON TOP. 406 002124 066575 000002 000000 ADD 2(S),@(S) 407 002132 062705 000004 ADD #4,S 408 002136 NEXT 409 ; 410 002142 HEAD 206,TOGGLE,240,TOGGL ; ***** TOGGLE 411 ; ( BYTE-ADDRESS BIT-PATTERN ==> ) EXCLUSIVE-OR INTO MEMORY BYTE. 412 002156 016545 000002 MOV 2(S),-(S) ; PUSH THE BYTE 413 002162 117515 000000 MOVB @(S),(S) ; TO BE TOGGLED 414 ; AVOID USING 'XOR' INSTRUCTION - NOT AVAILABLE ON ALL PDP-11 415 002166 011546 MOV (S),-(RP) 416 002170 046516 000002 BIC 2(S),(RP) 417 002174 042515 BIC (S)+,(S) 418 002176 052615 BIS (RP)+,(S) 419 002200 016545 000002 MOV 2(S),-(S) ; SET UP RETURN ADDRESS 420 002204 116575 000002 000000 MOVB 2(S),@(S) ; PUT THE TOGGLED BYTE BACK TO MEM. 421 002212 062705 000006 ADD #6,S ; ADJUST STACK POINTER 422 002216 NEXT 423 ; 424 002222 HEAD 201,@,300,AT ; ***** @ 425 002230 017515 000000 MOV @(S),(S) 426 002234 NEXT 427 ; 428 002240 HEAD 202,C@,240,CAT ; ***** C@ 429 002250 117501 000000 MOVB @(S),R1 430 002254 042701 177400 BIC #177400,R1 431 002260 010115 MOV R1,(S) 432 002262 NEXT 433 ; 434 002266 HEAD 201,!,241,STORE ; ***** ! 435 002274 016575 000002 000000 MOV 2(S),@(S) 436 002302 062705 000004 ADD #4,S 437 002306 NEXT 438 ; 439 002312 HEAD 202,C!,240,CSTOR ; ***** C! 440 002322 116575 000002 000000 MOVB 2(S),@(S) 441 002330 062705 000004 ADD #4,S 442 002334 NEXT 443 ; 444 ; F.I.G. MACRO V04.00 00:00:13 PAGE 7 1 ; **************************************************************** 2 ; 3 ; PRE-COMPILED FORTH SECTION 4 ; 5 ; **************************************************************** 6 ; 7 ; 8 ; 9 ; NOTE - A FEW OF THE FOLLOWING OPERATIONS HAVE BEEN 10 ; CONVERTED TO CODE FOR SPEED. HOWEVER, THE WORD ORDER 11 ; IN THE DICTIONARY HAS NOT BEEN CHANGED. 12 ; 13 002340 HEAD 301,:,272,COLON,DOCOL ; ***** : 14 002346 004342' 004234' 003200' .WORD QEXEC,SCSP,CURR,AT,CONT,STORE,CREAT,RBRAC,PSCOD 002354 002226' 003162' 002272' 002362 007040' 004552' 004722' 15 002370 010446 DOCOL: MOV IP,-(RP) 16 002372 010204 MOV W,IP 17 002374 NEXT 18 ; 19 002400 HEAD 301,<;>,273,SEMI,DOCOL ; ***** ; 20 002406 004416' 004506' 001446' .WORD QCSP,COMP,SEMIS,SMUDG,LBRAC,SEMIS 002414 004600' 004534' 001446' 21 ; 22 002422 HEAD 210,CONSTANT,240,CON,DOCOL ; ***** CONSTANT 23 002440 007040' 004600' 003504' .WORD CREAT,SMUDG,COMMA,PSCOD 002446 004722' 24 002450 011245 DOCON: MOV (W),-(S) 25 002452 NEXT 26 ; 27 002456 HEAD 210,VARIABLE,240,VAR,DOCOL ; ***** VARIABLE 28 002474 002436' 004722' .WORD CON,PSCOD 29 002500 010245 DOVAR: MOV W,-(S) 30 002502 NEXT 31 ; 32 002506 HEAD 204,USER,240,USER,DOCOL ; ***** USER 33 ; CREATE A NEW USER VARIABLE. ( N ==> ). 34 002520 002436' 004722' .WORD CON,PSCOD 35 002524 011245 DOUSE: MOV (W),-(S) 36 002526 060315 ADD U,(S) 37 002530 NEXT 38 ; 39 ; 40 ; 41 ; CONSTANTS 42 ; 43 002534 HEAD 201,0,260,ZERO,DOCON ; ***** 0 44 002542 000000 .WORD 0 45 ; 46 002544 HEAD 201,1,261,ONE,DOCON ; ***** 1 47 002552 000001 .WORD 1 48 ; 49 002554 HEAD 201,2,262,TWO,DOCON ; ***** 2 50 002562 000002 .WORD 2 51 ; 52 002564 HEAD 201,3,263,THREE,DOCON ; ***** 3 53 002572 000003 .WORD 3 F.I.G. MACRO V04.00 00:00:13 PAGE 7-1 54 ; 55 002574 HEAD 202,BL,240,BL,DOCON ; ***** BL 56 ; BLANK. 57 002604 000040 .WORD 40 58 ; 59 002606 HEAD 203,C/L,314,CL,DOCON ; ***** C/L 60 ; # OF CHARACTERS PER LINE 61 002616 000100 .WORD 100 62 ; 63 ; 'FIRST' AND 'LIMIT' MOVED TO USER AREA 64 ; 65 002620 HEAD 205,B/BUF,306,BBUF,DOCON ; ***** B/BUF 66 ; BYTES PER DISK-BLOCK BUFFER. 67 002632 002000 .WORD 1024. 68 ; 69 002634 HEAD 205,B/SCR,322,BSCR,DOCON ; ***** B/SCR 70 ; DISK BLOCKS PER FORTH SCREEN. 71 002646 000001 .WORD 1 72 ; 73 002650 HEAD 207,+ORIGIN,316,PORIG,DOCOL ; ***** +ORIGIN 74 ; RETURNS ADDRESS, GIVEN OFFSET FROM ORIGIN. 75 002664 000060' 000000' 001664' .WORD LIT,ORIGIN,PLUS,SEMIS 002672 001446' 76 ; 77 ; USER VARIABLES 78 ; 79 002674 HEAD 202,S0,240,SZERO,DOUSE ; ***** S0 80 ; STACK ORIGIN. 81 002704 000006 .WORD 6 82 ; 83 002706 HEAD 202,R0,240,RZERO,DOUSE ; ***** R0 84 ; RETURN STACK ORIGIN. 85 002716 000010 .WORD 10 86 ; 87 002720 HEAD 203,TIB,302,TIB,DOUSE ; ***** TIB 88 ; TERMINAL INPUT BUFFER. 89 002730 000012 .WORD 12 90 ; 91 002732 HEAD 205,WIDTH,310,WIDTH,DOUSE ; ***** WIDTH 92 ; MAXIMUM NAME LENGTH (DEFAULT, 31 CHARACTERS). 93 002744 000014 .WORD 14 94 ; 95 002746 HEAD 207,WARNING,307,WARN,DOUSE ; ***** WARNING 96 ; WARNING MODE (DEFAULT, GIVE MESSAGE NUMBER AT ERROR 97 ; OR WARNING CONDITION, DON'T GO TO DISK FOR MESSAGE). 98 002762 000016 .WORD 16 99 ; 100 002764 HEAD 205,FENCE,305,FENCE,DOUSE ; ***** FENCE 101 ; PREVENTS 'FORGET' BELOW THIS 'FENCE' SETTING. 102 002776 000020 .WORD 20 103 ; 104 003000 HEAD 202,DP,240,DP,DOUSE ; ***** DP 105 ; DICTIONARY POINTER TO NEXT AVAILABLE SPACE. 106 003010 000022 .WORD 22 107 ; 108 003012 HEAD 210,VOC-LINK,240,VOCL,DOUSE ; ***** VOC-LINK 109 ; VOCABULARY LINK (MAINLY FOR FUTURE USE). F.I.G. MACRO V04.00 00:00:13 PAGE 7-2 110 003030 000024 .WORD 24 111 ; 112 003032 HEAD 205,FIRST,324,FIRST,DOUSE ; ***** FIRST 113 ; ADDRESS OF BEGINNING OF DISK BUFFER. 114 003044 000026 .WORD 26 115 ; 116 003046 HEAD 205,LIMIT,324,LIMIT,DOUSE ; ***** LIMIT 117 ; ADDRESS JUST BEYOND END OF DISK BUFFERS. 118 003060 000030 .WORD 30 119 ; 120 ; POSITIONS 32 AND 34 ARE AVAILABLE FOR EXPANSION. 121 ; THEY ARE INITIALIZED FROM BOOT-UP TABLE, AT COLD START. 122 ; 123 003062 HEAD 203,BLK,313,BLK,DOUSE ; ***** BLK 124 ; CURRENT DISK BLOCK BEING LOADED (0=TERMINAL) 125 003072 000036 .WORD 36 126 ; 127 003074 HEAD 202,IN,240,IN,DOUSE ; ***** IN 128 ; OFFSET IN TERMINAL INPUT BUFFER. 129 003104 000040 .WORD 40 130 ; 131 003106 HEAD 203,OUT,324,OUT,DOUSE ; ***** OUT 132 ; OFFSET IN OUTPUT LINE. 133 003116 000042 .WORD 42 134 ; 135 003120 HEAD 203,SCR,322,SCR,DOUSE ; ***** SCR 136 ; CURRENT FORTH DISK SCREEN. 137 003130 000044 .WORD 44 138 ; 139 003132 HEAD 206,OFFSET,240,OFSET,DOUSE ; ***** OFFSET 140 ; OFFSET TO GET TO ANOTHER DISK DRIVE. 141 003146 000046 .WORD 46 142 ; 143 003150 HEAD 207,CONTEXT,324,CONT,DOUSE ; ***** CONTEXT 144 003164 000050 .WORD 50 145 ; 146 003166 HEAD 207,CURRENT,324,CURR,DOUSE ; ***** CURRENT 147 003202 000052 .WORD 52 148 ; 149 003204 HEAD 205,STATE,305,STATE,DOUSE ; ***** STATE 150 003216 000054 .WORD 54 151 ; 152 003220 HEAD 204,BASE,240,BASE,DOUSE ; ***** BASE 153 003232 000056 .WORD 56 154 ; 155 003234 HEAD 203,DPL,314,DPL,DOUSE ; ***** DPL 156 ; OFFSET OF DECIMAL POINT AFTER DOUBLE-INTEGER INPUT. 157 003244 000060 .WORD 60 158 ; 159 003246 HEAD 203,FLD,304,FLD,DOUSE ; ***** FLD 160 ; OUTPUT FIELD WIDTH. 161 003256 000062 .WORD 62 162 ; 163 003260 HEAD 203,CSP,320,CSP,DOUSE ; ***** CSP 164 ; USED BY COMPILER TO HOLD CURRENT STACK POSITION, 165 ; FOR ERROR CHECKING. 166 003270 000064 .WORD 64 F.I.G. MACRO V04.00 00:00:13 PAGE 7-3 167 ; 168 003272 HEAD 202,R#,240,RNUM,DOUSE ; ***** R# 169 ; CURSOR POSITION (FOR SOME EDITORS). 170 003302 000066 .WORD 66 171 ; 172 003304 HEAD 203,HLD,304,HLD,DOUSE ; ***** HLD 173 ; POINTS TO LAST CHARACTER HELD IN 'PAD' 174 003314 000070 .WORD 70 175 ; 176 003316 HEAD 203,USE,305,USE,DOUSE ; ***** USE 177 003326 000072 .WORD 72 178 ; 179 003330 HEAD 204,PREV,240,PREV,DOUSE ; ***** PREV 180 003342 000074 .WORD 74 181 ; 182 ; 183 ; END OF USER AREA 184 ; 185 ; 186 003344 HEAD 202,1+,240,ONEP ; ***** 1+ 187 003354 005215 INC (S) 188 003356 NEXT 189 ; 190 003362 HEAD 202,2+,240,TWOP ; ***** 2+ 191 003372 062715 000002 ADD #2,(S) 192 003376 NEXT 193 ; 194 003402 HEAD 202,1-,240,ONEM ; ***** 1- 195 003412 005315 DEC (S) 196 003414 NEXT 197 ; 198 003420 HEAD 202,2-,240,TWOM ; ***** 2- 199 003430 162715 000002 SUB #2,(S) 200 003434 NEXT 201 ; 202 003440 HEAD 204,HERE,240,HERE,DOCOL ; ***** HERE 203 003452 003006' 002226' 001446' .WORD DP,AT,SEMIS 204 ; 205 003460 HEAD 205,ALLOT,324,ALLOT,DOCOL ; ***** ALLOT 206 003472 003006' 002122' 001446' .WORD DP,PSTOR,SEMIS 207 ; 208 003500 HEAD 201,<,>,254,COMMA,DOCOL ; ***** , 209 003506 003450' 002272' 002560' .WORD HERE,STORE,TWO,ALLOT,SEMIS 003514 003470' 001446' 210 ; 211 ; THIS SYSTEM DOES NOT USE 'C,' 212 ; 213 003520 HEAD 201,-,255,SUB ; ***** - 214 003526 162515 SUB (S)+,(S) 215 003530 NEXT 216 ; 217 003534 HEAD 202,+-,240,PLMNS ; ***** +- 218 003544 005725 TST (S)+ 219 003546 002001 BGE 1$ 220 003550 005415 NEG (S) 221 003552 1$: NEXT 222 ; F.I.G. MACRO V04.00 00:00:13 PAGE 7-4 223 003556 HEAD 203,D+-,255,DPLMNS ; ***** D+- 224 003566 005725 TST (S)+ 225 003570 002004 BGE 1$ 226 ; CHANGE SIGN OF DOUBLE INTEGER WORD ON STACK. 227 003572 005415 NEG (S) 228 003574 005465 000002 NEG 2(S) 229 003600 005615 SBC (S) 230 003602 1$: NEXT 231 ; 232 003606 HEAD 201,=,275,EQUAL ; ***** = 233 003614 026525 000002 CMP 2(S),(S)+ 234 003620 001402 BEQ 1$ 235 003622 005015 CLR (S) 236 003624 000402 BR 2$ 237 003626 012715 000001 1$: MOV #1,(S) 238 003632 2$: NEXT 239 ; 240 003636 HEAD 201,^//,276,GREAT ; ***** > 249 003674 026525 000002 CMP 2(S),(S)+ 250 003700 003002 BGT 1$ 251 003702 005015 CLR (S) 252 003704 000402 BR 2$ 253 003706 012715 000001 1$: MOV #1,(S) 254 003712 2$: NEXT 255 ; 256 003716 HEAD 203,ROT,324,ROT ; ***** ROT 257 003726 011500 MOV (S),R0 258 003730 016515 000004 MOV 4(S),(S) 259 003734 016565 000002 000004 MOV 2(S),4(S) 260 003742 010065 000002 MOV R0,2(S) 261 003746 NEXT 262 ; 263 003752 HEAD 205,SPACE,305,SPACE,DOCOL ; ***** SPACE 264 003764 000060' 000040 001020' .WORD LIT,40,EMIT,SEMIS 003772 001446' 265 ; 266 003774 HEAD 204,-DUP,240,DDUP ; ***** -DUP 267 004006 005715 TST (S) 268 004010 001401 BEQ 1$ 269 004012 011545 MOV (S),-(S) 270 004014 1$: NEXT 271 ; 272 004020 HEAD 210,TRAVERSE,240,TRAV,DOCOL ; ***** TRAVERSE 273 ; MOVE (FORWARDS OR BACKWARDS) ACROSS A (VARIABLE LENGTH) 274 ; DICTIONARY NAME FIELD. 275 004036 002056' .WORD SWAP 276 004040 002012' 001664' 000060' XXN1: .WORD OVER,PLUS,LIT,177,OVER,CAT,LESS,ZBRAN,XXN1-. 004046 000177 002012' 002246' 004054 003642' 000144' 177760 F.I.G. MACRO V04.00 00:00:13 PAGE 7-5 277 004062 002056' 002034' 001446' .WORD SWAP,DROP,SEMIS 278 ; 279 004070 HEAD 206,LATEST,240,LATES,DOCOL ; ***** LATEST 280 004104 003200' 002226' 002226' .WORD CURR,AT,AT,SEMIS 004112 001446' 281 ; 282 ; THE NEXT 4 OPERATORS CAN DEPEND ON COMPUTER WORD SIZE. 283 ; THEY CONVERT ADDRESSES WITHIN THE NAME FIELDS OF FORTH 284 ; DICTIONARY ENTRIES. 285 ; 286 004114 HEAD 203,LFA,301,LFA,DOCOL ; ***** LFA 287 004124 000060' 000004 003524' .WORD LIT,4,SUB,SEMIS 004132 001446' 288 ; 289 004134 HEAD 203,CFA,301,CFA,DOCOL ; ***** CFA 290 004144 002560' 003524' 001446' .WORD TWO,SUB,SEMIS 291 ; 292 004152 HEAD 203,NFA,301,NFA,DOCOL ; ***** NFA 293 004162 000060' 000005 003524' .WORD LIT,5,SUB,LIT,-1,TRAV,SEMIS 004170 000060' 177777 004034' 004176 001446' 294 ; 295 004200 HEAD 203,PFA,301,PFA,DOCOL ; ***** PFA 296 004210 002550' 004034' 000060' .WORD ONE,TRAV,LIT,5,PLUS,SEMIS 004216 000005 001664' 001446' 297 ; 298 ; THE NEXT 7 OPERATIONS ARE USED BY THE COMPILER, FOR 299 ; COMPILE-TIME SYNTAX-ERROR CHECKS. 300 ; 301 004224 HEAD 204,!CSP,240,SCSP,DOCOL ; ***** !CSP 302 004236 001366' 003266' 002272' .WORD SPAT,CSP,STORE,SEMIS 004244 001446' 303 ; 304 004246 HEAD 206,?ERROR,240,QERR,DOCOL ; ***** ?ERROR 305 004262 002056' 000144' 000010 .WORD SWAP,ZBRAN,XXN2-.,ERROR,BRAN,XXN3-. 004270 006670' 000122' 000004 306 004276 002034' XXN2: .WORD DROP 307 004300 001446' XXN3: .WORD SEMIS 308 ; 309 004302 HEAD 205,?COMP,320,QCOMP,DOCOL ; ***** ?COMP 310 004314 003214' 002226' 001556' .WORD STATE,AT,ZEQU,LIT,21,QERR,SEMIS 004322 000060' 000021 004260' 004330 001446' 311 ; 312 004332 HEAD 205,?EXEC,303,QEXEC,DOCOL ; ***** ?EXEC 313 004344 003214' 002226' 000060' .WORD STATE,AT,LIT,22,QERR,SEMIS 004352 000022 004260' 001446' 314 ; 315 004360 HEAD 206,?PAIRS,240,QPAIR,DOCOL ; ***** ?PAIRS 316 004374 003524' 000060' 000023 .WORD SUB,LIT,23,QERR,SEMIS 004402 004260' 001446' 317 ; 318 004406 HEAD 204,?CSP,240,QCSP,DOCOL ; ***** ?CSP 319 004420 001366' 003266' 002226' .WORD SPAT,CSP,AT,SUB,LIT,24,QERR,SEMIS 004426 003524' 000060' 000024 004434 004260' 001446' 320 ; F.I.G. MACRO V04.00 00:00:13 PAGE 7-6 321 004440 HEAD 210,?LOADING,240,QLOAD,DOCOL ; ***** ?LOADING 322 004456 003070' 002226' 001556' .WORD BLK,AT,ZEQU,LIT,26,QERR,SEMIS 004464 000060' 000026 004260' 004472 001446' 323 ; 324 004474 HEAD 207,COMPILE,305,COMP,DOCOL ; ***** COMPILE 325 ; COMPILE THE EXECUTION ADDRESS FOLLOWING. 326 004510 004312' 001524' 002104' .WORD QCOMP,FROMR,DUP,TWOP,TOR,AT,COMMA,SEMIS 004516 003370' 001506' 002226' 004524 003504' 001446' 327 ; 328 004530 HEAD 301,[,333,LBRAC,DOCOL ; ***** [ 329 ; STOP COMPILATION, ENTER EXECUTION STATE. 330 004536 002540' 003214' 002272' .WORD ZERO,STATE,STORE,SEMIS 004544 001446' 331 ; 332 004546 HEAD 201,],335,RBRAC,DOCOL ; ***** ] 333 ; ENTER COMPILATION STATE. 334 004554 000060' 000300 003214' .WORD LIT,300,STATE,STORE,SEMIS 004562 002272' 001446' 335 ; 336 004566 HEAD 206,SMUDGE,240,SMUDG,DOCOL ; ***** SMUDGE 337 ; ALTER LATEST WORD NAME (SO THAT DICTIONARY SEARCH 338 ; WON'T FIND A PARTIALLY-COMPLETE ENTRY. 339 004602 004102' 000060' 000040 .WORD LATES,LIT,40,TOGGL,SEMIS 004610 002154' 001446' 340 ; 341 004614 HEAD 203,HEX,330,HEX,DOCOL ; ***** HEX 342 004624 000060' 000020 003230' .WORD LIT,20,BASE,STORE,SEMIS 004632 002272' 001446' 343 ; 344 004636 HEAD 207,DECIMAL,314,DEC,DOCOL ; ***** DECIMAL 345 004652 000060' 000012 003230' .WORD LIT,12,BASE,STORE,SEMIS 004660 002272' 001446' 346 ; 347 004664 HEAD 205,OCTAL,314,OCTAL,DOCOL ; ***** OCTAL 348 004676 000060' 000010 003230' .WORD LIT,10,BASE,STORE,SEMIS 004704 002272' 001446' 349 ; 350 004710 HEAD 207,<(;CODE)>,251,PSCOD,DOCOL ; ***** (;CODE) 351 ; USED ONLY BY COMPILER; COMPILED BY ';CODE'. 352 004724 001524' 004102' 004206' .WORD FROMR,LATES,PFA,CFA,STORE,SEMIS 004732 004142' 002272' 001446' 353 ; 354 ; 355 ; ***** THE DEFINITION OF ';CODE' WAS MOVED TO THE END OF 356 ; THE DICTIONARY, BECAUSE IT IS NOT PURE CODE (IT IS PATCHED 357 ; WHEN A FORTH ASSEMBLER IS LOADED). 358 359 ; 360 004740 HEAD 207,^/,276,DOES,DOCOL ; ***** DOES> 365 004774 001524' 004102' 004206' .WORD FROMR,LATES,PFA,STORE,PSCOD 005002 002272' 004722' F.I.G. MACRO V04.00 00:00:13 PAGE 7-7 366 005006 010446 DODOE: MOV IP,-(RP) 367 005010 012204 MOV (W)+,IP 368 005012 010245 MOV W,-(S) 369 005014 NEXT 370 ; 371 005020 HEAD 205,COUNT,324,COUNT,DOCOL ; ***** COUNT 372 ; CONVERT STRING TO THE FORMAT USED BY 'TYPE'. 373 005032 002104' 003352' 002056' .WORD DUP,ONEP,SWAP,CAT,SEMIS 005040 002246' 001446' 374 ; 375 005044 HEAD 204,TYPE,240,TYPE,DOCOL ; ***** TYPE 376 005056 004004' 000144' 000030 .WORD DDUP,ZBRAN,XXL2-.,OVER,PLUS,SWAP,XDO 005064 002012' 001664' 002056' 005072 000334' 377 005074 000360' 002246' 001020' XXL1: .WORD I,CAT,EMIT,XLOOP,XXL1-.,BRAN,XXL3-. 005102 000202' 177770 000122' 005110 000004 378 005112 002034' XXL2: .WORD DROP 379 005114 001446' XXL3: .WORD SEMIS 380 ; 381 005116 HEAD 206,=CELLS,240,ECELL,DOCOL ; ***** =CELLS 382 ; NOTE - I NEED THIS, TO FORCE EVEN ADDRESS. 383 005132 002104' 002550' 001302' .WORD DUP,ONE,AND,PLUS,SEMIS 005140 001664' 001446' 384 ; 385 005144 HEAD 211,-TRAILING,307,DTRAI,DOCOL ; ***** -TRAILING 386 005162 002104' 002540' 000334' .WORD DUP,ZERO,XDO 387 005170 002012' 002012' 001664' XXW6: .WORD OVER,OVER,PLUS,ONE,SUB,CAT 005176 002550' 003524' 002246' 388 005204 002602' 003524' 000144' .WORD BL,SUB,ZBRAN,XXW7-.,LEAVE,BRAN,XXWA-. 005212 000010 001466' 000122' 005220 000006 389 005222 002550' 003524' XXW7: .WORD ONE,SUB 390 005226 000202' 177740 001446' XXWA: .WORD XLOOP,XXW6-.,SEMIS 391 ; 392 005234 HEAD 204,(."),240,PDOTQ,DOCOL ; ***** (.") 393 ; USED ONLY BY COMPILER. COMPILED BY '."' 394 005246 001540' 005030' 002104' .WORD R,COUNT,DUP,ONEP,ECELL 005254 003352' 005130' 395 005260 001524' 001664' 001506' .WORD FROMR,PLUS,TOR,TYPE,SEMIS 005266 005054' 001446' 396 ; 397 005272 HEAD 302,.",240,DOTQ,DOCOL ; ***** ." 398 ; TYPE ASCII MESSAGE. 399 005302 000060' 000042 003214' .WORD LIT,34.,STATE,AT,ZBRAN,XXL6-. 005310 002226' 000144' 000026 400 005316 004506' 005244' 006110' .WORD COMP,PDOTQ,WORD,HERE,CAT,ONEP,ECELL 005324 003450' 002246' 003352' 005332 005130' 401 005334 003470' 000122' 000012 .WORD ALLOT,BRAN,XXL7-. 402 005342 006110' 003450' 005030' XXL6: .WORD WORD,HERE,COUNT,TYPE 005350 005054' 403 005352 001446' XXL7: .WORD SEMIS 404 ; 405 005354 HEAD 206,?ALIGN,240,QALIG,DOCOL ; ***** ?ALIGN 406 005370 003450' 002550' 001302' .WORD HERE,ONE,AND,ALLOT,SEMIS 005376 003470' 001446' F.I.G. MACRO V04.00 00:00:13 PAGE 7-8 407 ; 408 005402 HEAD 206,EXPECT,240,EXPEC,DOCOL ; ***** EXPECT 409 ; READ N CHARACTERS TO MEMORY (AND TERMINATE WITH NULLS). 410 ; ( ADDRESS N ==>). 411 005416 002012' 001664' 002012' .WORD OVER,PLUS,OVER,XDO 005424 000334' 412 005426 001030' 002104' 000060' XXK1: .WORD KEY,DUP,LIT,16,PORIG,AT,EQUAL,ZBRAN,XXK2-. 005434 000016 002662' 002226' 005442 003612' 000144' 000040 413 005450 002034' 000060' 000010 .WORD DROP,LIT,10,OVER,I,EQUAL,DUP,FROMR 005456 002012' 000360' 003612' 005464 002104' 001524' 414 005470 002560' 003524' 001664' .WORD TWO,SUB,PLUS,TOR,SUB,BRAN,XXK3-. 005476 001506' 003524' 000122' 005504 000060 415 005506 002104' 000060' 000015 XXK2: .WORD DUP,LIT,15,EQUAL,ZBRAN,XXK4-. 005514 003612' 000144' 000016 416 005522 001466' 002034' 002602' .WORD LEAVE,DROP,BL,ZERO,BRAN,XXK5-. 005530 002540' 000122' 000004 417 005536 002104' XXK4: .WORD DUP 418 005540 000360' 002320' 002540' XXK5: .WORD I,CSTOR,ZERO,I,ONEP,CSTOR,ZERO,I,TWOP,CSTOR 005546 000360' 003352' 002320' 005554 002540' 000360' 003370' 005562 002320' 419 ; NOTE DIFFERENCE FOR STAND-ALONE, BELOW 420 .IFDF ALONE 421 005564 001020' 000202' 177636 XXK3: .WORD EMIT,XLOOP,XXK1-.,DROP,SEMIS 005572 002034' 001446' 422 .IFF 423 XXK3: .WORD DROP,XLOOP,XXK1-.,DROP,SEMIS 424 .ENDC 425 ; 426 005576 HEAD 205,QUERY,331,QUERY,DOCOL ; ***** QUERY 427 005610 002726' 002226' 000060' .WORD TIB,AT,LIT,120,EXPEC,ZERO,IN,STORE,SEMIS 005616 000120 005414' 002540' 005624 003102' 002272' 001446' 428 ; 429 005632 HEAD 301,X,200,NULL,DOCOL ; ***** THE NULL 430 ; THE NULL OPERATION (ASCII 0) STOPS INTERPRETATION/COMPILATION 431 ; AT END OF A TERMINAL INPUT LINE, OR A DISK SCREEN. ALL DISK 432 ; BUFFERS MUST TERMINATE WITH NULLS, AND 'EXPECT' PLACES NULLS 433 ; AFTER EACH TERMINAL INPUT LINE. 434 ; NOTE THAT THE 'X' IN THE HEADER ABOVE WILL BE CHANGED TO A NULL. 435 005640 003070' 002226' .WORD BLK,AT 436 005644 000144' 000046 002550' .WORD ZBRAN,XXJ2-.,ONE,BLK,PSTOR,ZERO,IN,STORE 005652 003070' 002122' 002540' 005660 003102' 002272' 437 005664 003070' 002226' 002644' .WORD BLK,AT,BSCR,MOD,ZEQU,ZBRAN,XXJ1-.,QEXEC,FROMR,DROP 005672 010744' 001556' 000144' 005700 000010 004342' 001524' 005706 002034' 438 005710 000122' 000006 XXJ1: .WORD BRAN,XXJ4-. 439 005714 001524' 002034' XXJ2: .WORD FROMR,DROP 440 005720 001446' XXJ4: .WORD SEMIS 441 ; 442 005722 HEAD 204,FILL,240,FILL,DOCOL ; ***** FILL 443 005734 002056' 001506' 002012' .WORD SWAP,TOR,OVER,CSTOR,DUP,ONEP,FROMR F.I.G. MACRO V04.00 00:00:13 PAGE 7-9 005742 002320' 002104' 003352' 005750 001524' 444 005752 002550' 003524' 001070' .WORD ONE,SUB,CMOVE,SEMIS 005760 001446' 445 ; 446 005762 HEAD 205,ERASE,305,ERASE,DOCOL ; ***** ERASE 447 005774 002540' 005732' 001446' .WORD ZERO,FILL,SEMIS 448 ; 449 006002 HEAD 206,BLANKS,240,BLANK,DOCOL ; ***** BLANKS 450 006016 002602' 005732' 001446' .WORD BL,FILL,SEMIS 451 ; 452 006024 HEAD 204,HOLD,240,HOLD,DOCOL ; ***** HOLD 453 006036 000060' 177777 003312' .WORD LIT,-1,HLD,PSTOR,HLD,AT,CSTOR,SEMIS 006044 002122' 003312' 002226' 006052 002320' 001446' 454 ; 455 006056 HEAD 203,PAD,304,PAD,DOCOL ; ***** PAD 456 006066 003450' 000060' 000104 .WORD HERE,LIT,104,PLUS,SEMIS 006074 001664' 001446' 457 ; 458 006100 HEAD 204,WORD,240,WORD,DOCOL ; ***** WORD 459 006112 003070' 002226' 000144' .WORD BLK,AT,ZBRAN,XXI1-.,BLK,AT,BLOCK,BRAN,XXI2-. 006120 000014 003070' 002226' 006126 011524' 000122' 000006 460 006134 002726' 002226' XXI1: .WORD TIB,AT 461 006140 003102' 002226' 001664' XXI2: .WORD IN,AT,PLUS,SWAP,ENCL,HERE,LIT,42,BLANK,IN 006146 002056' 000676' 003450' 006154 000060' 000042 006014' 006162 003102' 462 006164 002122' 002012' 003524' .WORD PSTOR,OVER,SUB,TOR,R,HERE,CSTOR,PLUS 006172 001506' 001540' 003450' 006200 002320' 001664' 463 006204 003450' 003352' 001524' .WORD HERE,ONEP,FROMR,CMOVE,SEMIS 006212 001070' 001446' 464 ; 465 ; 466 006216 HEAD 210,(NUMBER),240,PNUMB,DOCOL ; ***** (NUMBER) 467 006234 003352' 002104' 001506' XXF3: .WORD ONEP,DUP,TOR,CAT,BASE,AT,DIGIT 006242 002246' 003230' 002226' 006250 000400' 468 006252 000144' 000054 002056' .WORD ZBRAN,XXG4-.,SWAP,BASE,AT,USTAR,DROP 006260 003230' 002226' 001132' 006266 002034' 469 006270 003724' 003230' 002226' .WORD ROT,BASE,AT,USTAR,DPLUS 006276 001132' 001702' 470 006302 003242' 002226' 003352' .WORD DPL,AT,ONEP,ZBRAN,XXG5-.,ONE,DPL,PSTOR 006310 000144' 000010 002550' 006316 003242' 002122' 471 006322 001524' 000122' 177706 XXG5: .WORD FROMR,BRAN,XXF3-. 472 006330 001524' 001446' XXG4: .WORD FROMR,SEMIS 473 ; 474 006334 HEAD 206,NUMBER,240,NUMB,DOCOL ; ***** NUMBER 475 006350 002540' 002540' 003724' .WORD ZERO,ZERO,ROT,DUP,ONEP,CAT,LIT,55,EQUAL 006356 002104' 003352' 002246' 006364 000060' 000055 003612' 476 006372 002104' 001506' 001664' .WORD DUP,TOR,PLUS,LIT,-1 006400 000060' 177777 F.I.G. MACRO V04.00 00:00:13 PAGE 7-10 477 006404 003242' 002272' 006232' XXF6: .WORD DPL,STORE,PNUMB,DUP,CAT,BL,SUB 006412 002104' 002246' 002602' 006420 003524' 478 006422 000144' 000026 002104' .WORD ZBRAN,XXF7-.,DUP,CAT,LIT,56,SUB 006430 002246' 000060' 000056 006436 003524' 479 006440 002540' 004260' 002540' .WORD ZERO,QERR,ZERO,BRAN,XXF6-. 006446 000122' 177734 480 006452 002034' 001524' 000144' XXF7: .WORD DROP,FROMR,ZBRAN,XXFA-.,DMINU 006460 000004 001764' 481 006464 001446' XXFA: .WORD SEMIS 482 ; 483 006466 HEAD 205,-FIND,304,DFIND,DOCOL ; ***** -FIND 484 006500 002602' 006110' 003450' .WORD BL,WORD,HERE,COUNT,UPPER,HERE,CONT,AT,AT,PFIND 006506 005030' 006556' 003450' 006514 003162' 002226' 002226' 006522 000506' 485 006524 002104' 001556' 000144' .WORD DUP,ZEQU,ZBRAN,XXE3-.,DROP,HERE,LATES,PFIND 006532 000012 002034' 003450' 006540 004102' 000506' 486 006544 001446' XXE3: .WORD SEMIS 487 ; 488 006546 HEAD 205,UPPER,322,UPPER,DOCOL ; ***** UPPER 489 ; SETS STRINGS TO UPPER CASE - TO ALLOW 490 ; LOWER AS WELL AS UPPER CASE FROM TERMINAL. 491 006560 002012' 001664' 002056' .WORD OVER,PLUS,SWAP,XDO 006566 000334' 492 006570 000360' 002246' 000060' XXE2: .WORD I,CAT,LIT,140,GREAT,I,CAT,LIT,173,LESS 006576 000140 003672' 000360' 006604 002246' 000060' 000173 006612 003642' 493 006614 001302' 000144' 000012 .WORD AND,ZBRAN,XXE1-.,I,LIT,40,TOGGL 006622 000360' 000060' 000040 006630 002154' 494 006632 000202' 177734 001446' XXE1: .WORD XLOOP,XXE2-.,SEMIS 495 ; 496 006640 HEAD 207,(ABORT),251,PABOR,DOCOL ; ***** (ABORT) 497 006654 010036' 001446' .WORD ABORT,SEMIS 498 ; 499 006660 HEAD 205,ERROR,322,ERROR,DOCOL ; ***** ERROR 500 006672 002760' 002226' 001606' .WORD WARN,AT,ZLESS,ZBRAN,XXN4-.,PABOR 006700 000144' 000004 006652' 501 006706 003450' 005030' 005054' XXN4: .WORD HERE,COUNT,TYPE,PDOTQ 006714 005244' 502 006716 003 .BYTE 3 503 006717 040 077 040 .ASCII / ? / 504 .EVEN 505 006722 011760' 001406' 003102' .WORD MESS,SPSTO,IN,AT,BLK,AT,QUIT,SEMIS 006730 002226' 003070' 002226' 006736 007760' 001446' 506 ; 507 006742 HEAD 203,ID.,256,IDDOT,DOCOL ; ***** ID. 508 006752 006064' 000060' 000040 .WORD PAD,LIT,40,LIT,137,FILL,DUP 006760 000060' 000137 005732' 006766 002104' 509 006770 004206' 004122' 002012' .WORD PFA,LFA,OVER,SUB,PAD,SWAP,CMOVE 006776 003524' 006064' 002056' F.I.G. MACRO V04.00 00:00:13 PAGE 7-11 007004 001070' 510 007006 006064' 005030' 000060' .WORD PAD,COUNT,LIT,37,AND,TYPE,SPACE,SEMIS 007014 000037 001302' 005054' 007022 003762' 001446' 511 ; 512 007026 HEAD 206,CREATE,240,CREAT,DOCOL ; ***** CREATE 513 007042 006476' 000144' 000020 .WORD DFIND,ZBRAN,XXD2-.,DROP,NFA,IDDOT 007050 002034' 004160' 006750' 514 007056 000060' 000004 011760' .WORD LIT,4,MESS,SPACE 007064 003762' 515 007066 003450' 002104' 002246' XXD2: .WORD HERE,DUP,CAT,WIDTH,AT,MIN,ONEP,ALLOT 007074 002742' 002226' 010416' 007102 003352' 003470' 516 007106 005366' 002104' 000060' .WORD QALIG,DUP,LIT,240,TOGGL,HERE,ONE,SUB 007114 000240 002154' 003450' 007122 002550' 003524' 517 007126 000060' 000200 002154' .WORD LIT,200,TOGGL,LATES,COMMA,CURR,AT,STORE 007134 004102' 003504' 003200' 007142 002226' 002272' 518 007146 003450' 003370' 003504' .WORD HERE,TWOP,COMMA,SEMIS 007154 001446' 519 ; 520 007156 HEAD 311,[COMPILE],335,BCOMP,DOCOL ; ***** [COMPILE] 521 007174 006476' 001556' 002540' .WORD DFIND,ZEQU,ZERO,QERR,DROP,CFA,COMMA,SEMIS 007202 004260' 002034' 004142' 007210 003504' 001446' 522 ; 523 007214 HEAD 307,LITERAL,314,LITER,DOCOL ; ***** LITERAL 524 007230 003214' 002226' 000144' .WORD STATE,AT,ZBRAN,XXD6-.,COMP,LIT,COMMA 007236 000010 004506' 000060' 007244 003504' 525 007246 001446' XXD6: .WORD SEMIS 526 ; 527 007250 HEAD 310,DLITERAL,240,DLITE,DOCOL ; ***** DLITERAL 528 007266 003214' 002226' 000144' .WORD STATE,AT,ZBRAN,XXN5-.,SWAP,LITER,LITER 007274 000010 002056' 007226' 007302 007226' 529 007304 001446' XXN5: .WORD SEMIS 530 ; 531 007306 HEAD 202,U<,240,ULESS,DOCOL ; ***** U< 532 ; UNSIGNED LESS-THAN, NEEDED FOR '?STACK' 533 ; : U< >R 0 R> 0 DMINUS D+ SWAP DROP 0< ; 534 007316 001506' 002540' 001524' .WORD TOR,ZERO,FROMR,ZERO,DMINU,DPLUS 007324 002540' 001764' 001702' 535 007332 002056' 002034' 001606' .WORD SWAP,DROP,ZLESS,SEMIS 007340 001446' 536 ; 537 007342 HEAD 202,D<,240,DLESS,DOCOL ; ***** D< 538 ; DOUBLE PRECISION LESS-THAN 539 ; : D< DMINUS D+ SWAP DROP 0< ; 540 007352 001764' 001702' 002056' .WORD DMINU,DPLUS,SWAP,DROP,ZLESS,SEMIS 007360 002034' 001606' 001446' 541 ; 542 007366 HEAD 206,?STACK,240,QSTAC,DOCOL ; ***** ?STACK 543 ; ERROR CHECK. 544 007402 002702' 002226' 002560' .WORD SZERO,AT,TWO,SUB,SPAT,ULESS,ONE,QERR 007410 003524' 001366' 007314' F.I.G. MACRO V04.00 00:00:13 PAGE 7-12 007416 002550' 004260' 545 007422 001366' 003450' 000060' .WORD SPAT,HERE,LIT,200,PLUS,ULESS,TWO,QERR 007430 000200 001664' 007314' 007436 002560' 004260' 546 007442 001446' .WORD SEMIS 547 ; 548 007444 HEAD 211,INTERPRET,324,INTER,DOCOL ; ***** INTERPRET 549 007462 006476' XXE4: .WORD DFIND 550 007464 000144' 000036 003214' .WORD ZBRAN,XXEA-.,STATE,AT,LESS 007472 002226' 003642' 551 007476 000144' 000012 004142' .WORD ZBRAN,XXE5-.,CFA,COMMA,BRAN,XXE6-. 007504 003504' 000122' 000006 552 007512 004142' 000102' XXE5: .WORD CFA,EXEC 553 007516 007400' 000122' 000034 XXE6: .WORD QSTAC,BRAN,XXE7-. 554 007524 003450' 006346' 003242' XXEA: .WORD HERE,NUMB,DPL,AT,ONEP,ZBRAN,XXF4-.,DLITE,BRAN,XXF5-. 007532 002226' 003352' 000144' 007540 000010 007264' 000122' 007546 000006 555 007550 002034' 007226' XXF4: .WORD DROP,LITER 556 007554 007400' XXF5: .WORD QSTAC 557 007556 000122' 177702 XXE7: .WORD BRAN,XXE4-. 558 ; 559 007562 HEAD 211,IMMEDIATE,305,IMMED,DOCOL ; ***** IMMEDIATE 560 007600 004102' 000060' 000100 .WORD LATES,LIT,100,TOGGL,SEMIS 007606 002154' 001446' 561 ; 562 007612 HEAD 212,VOCABULARY,240,VOCAB,DOCOL ; ***** VOCABULARY 563 007632 004752' 000060' 120201 .WORD BUILD,LIT,120201,COMMA,CURR,AT,CFA,COMMA 007640 003504' 003200' 002226' 007646 004142' 003504' 564 007652 003450' 003026' 002226' .WORD HERE,VOCL,AT,COMMA,VOCL,STORE,DOES 007660 003504' 003026' 002272' 007666 004772' 565 007670 003370' 003162' 002272' DOVOC: .WORD TWOP,CONT,STORE,SEMIS 007676 001446' 566 ; 567 ; 568 ; ***** THE DEFINITION OF 'FORTH' WAS MOVED TO NEAR THE END OF THE 569 ; DICTIONARY, BECAUSE IT IS NOT PURE CODE. 570 ; 571 ; 572 007700 HEAD 213,DEFINITIONS,323,DEFIN,DOCOL ; ***** DEFINITIONS 573 007720 003162' 002226' 003200' .WORD CONT,AT,CURR,STORE,SEMIS 007726 002272' 001446' 574 ; 575 007732 HEAD 301,(,250,PAREN,DOCOL ; ***** ( 576 007740 000060' 000051 006110' .WORD LIT,51,WORD,SEMIS 007746 001446' 577 ; 578 007750 HEAD 204,QUIT,240,QUIT,DOCOL ; ***** QUIT 579 007762 002540' 003070' 002272' .WORD ZERO,BLK,STORE,LBRAC 007770 004534' 580 007772 001426' 001056' 005606' XXB1: .WORD RPSTO,CR,QUERY,INTER,STATE,AT 010000 007460' 003214' 002226' 581 010006 001556' 000144' 000010 .WORD ZEQU,ZBRAN,XXB2-.,PDOTQ 010014 005244' 582 010016 003 .BYTE 3 F.I.G. MACRO V04.00 00:00:13 PAGE 7-13 583 010017 040 117 113 .ASCII / OK/ 584 .EVEN 585 010022 000122' 177746 XXB2: .WORD BRAN,XXB1-. 586 ; 587 010026 HEAD 205,ABORT,324,ABORT,DOCOL ; ***** ABORT 588 010040 001406' 004650' 003762' .WORD SPSTO,DEC,SPACE 589 010046 001056' 005244' .WORD CR,PDOTQ 590 010052 023 .BYTE 23 591 010053 106 111 107 .ASCII /FIG-FORTH V 1.3.3 / 010056 055 106 117 010061 122 124 110 010064 040 040 126 010067 040 061 056 010072 063 056 063 010075 040 592 .EVEN 593 010076 015044' 007716' 007760' .WORD FORTH,DEFIN,QUIT 594 ; 595 010104 HEAD 203,NOT,324,NOT,DOCOL ; ***** NOT 596 010114 001556' 001446' .WORD ZEQU,SEMIS 597 ; 598 ; COLD AND WARM STARTS 599 ; 600 010120 HEAD 204,COLD,240,COLD ; ***** COLD 601 010132 CENT: ; COLD START ENTRY POINT 602 010132 016767 167656 004712 MOV ORIGIN+14,FORTH+6 ; SET 'FORTH' VOCABULARY FROM STARTUP TABLE 603 010140 016703 167654 MOV ORIGIN+20,U ; INITIALIZE USER POINTER 604 ; NOTE - FOR SMALLER STAND-ALONE BOOT, INITIALIZE AREAS IN 605 ; HIGH MEMORY WHICH MUST BE INITIALIZED. 606 ; CLEAR DISK BUFFERS ON FIRST TIME THROUGH 607 010144 016700 167672 MOV ORIGIN+42,R0 ; 'FIRST' - BEGINNING OF DISK BUFFERS 608 010150 016701 167670 MOV ORIGIN+44,R1 ; 'LIMIT' - JUST BEYOND DISK BUFFERS 609 010154 005020 1$: CLR (R0)+ 610 010156 020001 CMP R0,R1 611 010160 002775 BLT 1$ 612 ; NOW INITIALIZE 'OUT', 'OFFSET', 'USE' AND 'PREV' 613 010162 005063 000042 CLR 42(U) ; CLEAR 'OUT' 614 010166 005063 000046 CLR 46(U) ; CLEAR 'OFFSET' 615 010172 016763 167644 000072 MOV ORIGIN+42,72(U) ; TO 'USE' 616 010200 016763 167636 000074 MOV ORIGIN+42,74(U) ; TO 'PREV' 617 ; INITIALIZE VIDEO TERMINAL CURSOR POSITION 618 010206 012767 000000 052566 MOV #0,OUTPOS 619 ; END OF SPECIAL HIGH-MEMORY INITIALIZE 620 010214 012701 000030 MOV #30,R1 ; ON COLD START, MOVE 24. BYTES 621 010220 000402 BR W2 622 010222 WENT: ; WARM START ENTRY POINT 623 010222 012701 000012 MOV #12,R1 ; ON WARM START, MOVE TEN BYTES 624 010226 012705 000022' W2: MOV #ORIGIN+22,R5 ; START MOVING FROM HERE 625 010232 016700 167562 MOV ORIGIN+20,R0 ; MOVE TO THE USER AREA 626 010236 062700 000006 ADD #6,R0 ; PLUS 6 627 010242 060501 ADD R5,R1 ; COMPUTE LOOP STOP ADDRESS 628 010244 012520 1$: MOV (R5)+,(R0)+ 629 010246 020501 CMP R5,R1 630 010250 002775 BLT 1$ 631 010252 016706 167546 MOV ORIGIN+24,RP ; INITIALIZE THE RETURN-STACK POINTER 632 ; NOW SET FORTH'S INSTRUCTION COUNTER, AND GO 633 010256 012704 010266' MOV #GO,IP ; START EXECUTION WITH 'ABORT' F.I.G. MACRO V04.00 00:00:13 PAGE 7-14 634 010262 NEXT 635 ; NOTE - NORMALLY THE ABOVE INSTRUCTION WOULD BE 'MOV #ABORT+2,IP'. 636 ; IT HAS BEEN CHANGED HERE TO ALLOW USER TO PATCH A DIFFERENT 637 ; START-UP. BUT THE SYSTEM WON'T WORK UNTIL SOME OF THE WORK 638 ; OF 'ABORT' HAS BEEN DONE, SO THAT WORK IS REPEATED. THE USER 639 ; CAN PATCH OVER THE 'ABORT' AND THE ZEROS. 640 ; 641 010266 001406' 004650' 015044' GO: .WORD SPSTO,DEC,FORTH,DEFIN,ABORT,0,0,0 010274 007716' 010036' 000000 010302 000000 000000 642 ; 643 ; 644 ; 645 ; 646 ; 647 010306 HEAD 204,S->D,240,STOD ; ***** S->D 648 010320 005045 CLR -(S) ; SIGN EXTEND WITH ZEROS 649 010322 005765 000002 TST 2(S) ; BUT IF NEGATIVE, 650 010326 100001 BPL 1$ 651 010330 005315 DEC (S) ; CHANGE THE ZEROS TO ONES 652 010332 1$: NEXT 653 ; 654 ; NOTE - THIS SYSTEM DOESN'T NEED THE OPERATIONS '+-' AND 'D+-', 655 ; BECAUSE 'M*' AND 'M/' ARE DEFINED IN CODE. 656 ; 657 010336 HEAD 203,ABS,323,ABS,DOCOL ; ***** ABS 658 010346 002104' 001606' 000144' .WORD DUP,ZLESS,ZBRAN,XXR5-.,MINUS 010354 000004 001742' 659 010360 001446' XXR5: .WORD SEMIS 660 ; 661 010362 HEAD 204,DABS,240,DABS,DOCOL ; ***** DABS 662 010374 002104' 001606' 000144' .WORD DUP,ZLESS,ZBRAN,XXRB-.,DMINU 010402 000004 001764' 663 010406 001446' XXRB: .WORD SEMIS 664 ; 665 010410 HEAD 203,MIN,316,MIN,DOCOL ; ***** MIN 666 010420 002012' 002012' 003672' .WORD OVER,OVER,GREAT,ZBRAN,XXR7-.,SWAP 010426 000144' 000004 002056' 667 010434 002034' 001446' XXR7: .WORD DROP,SEMIS 668 ; 669 010440 HEAD 203,MAX,330,MAX,DOCOL ; ***** MAX 670 010450 002012' 002012' 003642' .WORD OVER,OVER,LESS,ZBRAN,XXR6-.,SWAP 010456 000144' 000004 002056' 671 010464 002034' 001446' XXR6: .WORD DROP,SEMIS 672 ; 673 010470 HEAD 202,M*,240,MSTAR ; ***** M* 674 .IFDF EIS ; HARDWARE MULTIPLY/DIVIDE? 675 MOV (S)+,R0 676 MUL (S),R0 677 MOV R1,(S) 678 MOV R0,-(S) 679 NEXT 680 .IFF 681 010500 016546 000002 MOV 2(S),-(RP) ; USE RETURN STACK FOR SAVING SIGN 682 010504 100002 BPL 1$ 683 010506 005465 000002 NEG 2(S) ; GET ABSOLUTE VALUE 684 010512 005715 1$: TST (S) F.I.G. MACRO V04.00 00:00:13 PAGE 7-15 685 010514 100002 BPL 2$ 686 010516 005416 NEG (RP) ; ADJUST SIGN WHICH WAS SAVED 687 010520 005415 NEG (S) ; GET ABSOLUTE VALUE 688 010522 004767 170416 2$: JSR PC,UMULT 689 010526 005726 TST (RP)+ ; NEGATIVE RESULT? 690 010530 100007 BPL 3$ ; NO 691 ; IF GET HERE, NEGATE THE DOUBLE-INTEGER NUMBER ON THE STACK 692 010532 005115 COM (S) 693 010534 005165 000002 COM 2(S) 694 010540 062765 000001 000002 ADD #1,2(S) 695 010546 005515 ADC (S) 696 010550 3$: NEXT 697 .ENDC 698 ; 699 010554 HEAD 202,M/,240,MSLAS ; ***** M/ 700 .IFDF EIS ; HARDWARD MULTIPLY/DIVIDE? 701 MOV 2(S),R0 702 MOV 4(S),R1 703 DIV (S)+,R0 704 MOV R1,2(S) 705 MOV R0,(S) 706 NEXT 707 .IFF 708 010564 016546 000002 MOV 2(S),-(RP) ; SAVE DIVIDEND SIGN 709 010570 001001 BNE 5$ ; ZERO WOULDN'T INDICATE 710 010572 005216 INC (RP) ; A SIGN CHANGE. 711 010574 011646 5$: MOV (RP),-(RP) ; DUPLICATE IT 712 010576 100011 BPL 1$ 713 ; IF GET HERE, TAKE ABSOLUTE VALUE OF DOUBLE-INTEGER DIVIDEND. 714 010600 005165 000002 COM 2(S) 715 010604 005165 000004 COM 4(S) 716 010610 062765 000001 000004 ADD #1,4(S) 717 010616 005565 000002 ADC 2(S) 718 010622 005715 1$: TST (S) ; IS DIVISOR NEGATIVE? 719 010624 100002 BPL 2$ 720 010626 005416 NEG (RP) ; IF YES, NEGATE QUOTIENT SIGN 721 010630 005415 NEG (S) ; AND TAKE ABS. VALUE OF DIVISOR 722 010632 004767 170370 2$: JSR PC,UDIV 723 010636 005726 TST (RP)+ ; NEGATIVE QUOTIENT? 724 010640 100001 BPL 3$ ; NO 725 010642 005415 NEG (S) ; NEGATE THE QUOTIENT 726 010644 005726 3$: TST (RP)+ ; NEGATIVE DIVIDEND? 727 010646 100002 BPL 4$ ; NEGATE THE REMAINDER 728 010650 005465 000002 NEG 2(S) 729 010654 4$: NEXT 730 .ENDC 731 ; 732 010660 HEAD 201,*,252,STAR,DOCOL ; ***** * 733 010666 010476' 002034' 001446' .WORD MSTAR,DROP,SEMIS 734 ; 735 010674 HEAD 204,/MOD,240,SLMOD,DOCOL ; ***** /MOD 736 010706 001506' 010316' 001524' .WORD TOR,STOD,FROMR,MSLAS,SEMIS 010714 010562' 001446' 737 ; 738 010720 HEAD 201,/,257,SLASH,DOCOL ; ***** / 739 010726 010704' 002056' 002034' .WORD SLMOD,SWAP,DROP,SEMIS 010734 001446' F.I.G. MACRO V04.00 00:00:13 PAGE 7-16 740 ; 741 010736 HEAD 203,MOD,304,MOD,DOCOL ; ***** MOD 742 010746 010704' 002034' 001446' .WORD SLMOD,DROP,SEMIS 743 ; 744 010754 HEAD 205,*/MOD,304,SSMOD,DOCOL ; ***** */MOD 745 010766 001506' 010476' 001524' .WORD TOR,MSTAR,FROMR,MSLAS,SEMIS 010774 010562' 001446' 746 ; 747 011000 HEAD 202,*/,240,SSLA,DOCOL ; ***** */ 748 011010 010764' 002056' 002034' .WORD SSMOD,SWAP,DROP,SEMIS 011016 001446' 749 ; 750 011020 HEAD 205,M/MOD,304,MSMOD,DOCOL ; ***** M/MOD 751 011032 001506' 002540' 001540' .WORD TOR,ZERO,R,USLAS,FROMR 011040 001214' 001524' 752 011044 002056' 001506' 001214' .WORD SWAP,TOR,USLAS,FROMR,SEMIS 011052 001524' 001446' 753 ; 754 ; 755 ; 756 ; 757 ; F.I.G. MACRO V04.00 00:00:13 PAGE 8 1 ; **************************************************************** 2 ; 3 ; DISK I/O (SECTION COMMON TO ALL OPERATING SYSTEMS) 4 ; NOTE THAT EACH OPERATING SYSTEM DEFINED 'R/W' - READ 5 ; OR WRITE A 1024-BYTE RANDOM-ACCESS BLOCK. 6 ; 7 ; **************************************************************** 8 ; 9 ; 10 ; 'USE' AND 'PREV' MOVED TO USER AREA 11 ; 12 011056 HEAD 204,+BUF,240,PBUF,DOCOL ; ***** +BUF 13 011070 002630' 000060' 000004 .WORD BBUF,LIT,4,PLUS,PLUS,DUP,LIMIT,AT,EQUAL 011076 001664' 001664' 002104' 011104 003056' 002226' 003612' 14 011112 000144' 000010 002034' .WORD ZBRAN,XXT1-.,DROP,FIRST,AT 011120 003042' 002226' 15 011124 002104' 003340' 002226' XXT1: .WORD DUP,PREV,AT,SUB,SEMIS 011132 003524' 001446' 16 ; 17 011136 HEAD 206,UPDATE,240,UPDAT,DOCOL ; ***** UPDATE 18 011152 003340' 002226' 002226' .WORD PREV,AT,AT,LIT,100000,OR,PREV 011160 000060' 100000 001322' 011166 003340' 19 011170 002226' 002272' 001446' .WORD AT,STORE,SEMIS 20 ; 21 011176 HEAD 215,EMPTY-BUFFERS,323,MTBUF,DOCOL ; ***** EMPTY-BUFFERS 22 011220 003042' 002226' 003056' .WORD FIRST,AT,LIMIT,AT,OVER,SUB,ERASE,SEMIS 011226 002226' 002012' 003524' 011234 005772' 001446' 23 ; 24 011240 HEAD 205,FLUSH,310,FLUSH,DOCOL ; ***** FLUSH 25 ; SOME SYSTEMS DEFINE THIS IN THE EDITOR, NOT HERE. 26 011252 003056' 002226' 003042' .WORD LIMIT,AT,FIRST,AT,XDO 011260 002226' 000334' 27 011264 000360' 002226' 001606' XXTA: .WORD I,AT,ZLESS,ZBRAN,XXT7-.,I,TWOP,I,AT 011272 000144' 000024 000360' 011300 003370' 000360' 002226' 28 011306 000060' 077777 001302' .WORD LIT,77777,AND,ZERO,RW 011314 002540' 014766' 29 011320 002630' 000060' 000004 XXT7: .WORD BBUF,LIT,4,PLUS,XPLOO,XXTA-.,MTBUF,SEMIS 011326 001664' 000250' 177732 011334 011216' 001446' 30 ; 31 011340 HEAD 203,DR0,260,DRZER,DOCOL ; ***** DR0 32 ; SELECT DRIVE #0 - NOT USED WITH RT11 OR RSX11 33 011350 002540' 003144' 002272' .WORD ZERO,OFSET,STORE,SEMIS 011356 001446' 34 ; 35 011360 HEAD 203,DR1,261,DRONE,DOCOL ; ***** DR1 36 ; SELECT DRIVE #1 - NOT USED IN RSX11 OR RT11 37 011370 000060' 000360 003144' .WORD LIT,240.,OFSET,STORE,SEMIS 011376 002272' 001446' 38 ; 39 011402 HEAD 206,BUFFER,240,BUFFE,DOCOL ; ***** BUFFER 40 011416 003324' 002226' 002104' .WORD USE,AT,DUP,TOR 011424 001506' F.I.G. MACRO V04.00 00:00:13 PAGE 8-1 41 011426 011066' 000144' 177774 XXT2: .WORD PBUF,ZBRAN,XXT2-.,USE,STORE 011434 003324' 002272' 42 011440 001540' 002226' 001606' .WORD R,AT,ZLESS,ZBRAN,XXT3-. 011446 000144' 000024 43 011452 001540' 003370' 001540' .WORD R,TWOP,R,AT,LIT,77777,AND 011460 002226' 000060' 077777 011466 001302' 44 011470 002540' 014766' .WORD ZERO,RW 45 011474 001540' 002272' 001540' XXT3: .WORD R,STORE,R,PREV,STORE,FROMR,TWOP,SEMIS 011502 003340' 002272' 001524' 011510 003370' 001446' 46 ; 47 011514 HEAD 205,BLOCK,313,BLOCK,DOCOL ; ***** BLOCK 48 ; CHANGED TO MASK OFF THE UPDATE BIT WHEN COMPARING 49 011526 003144' 002226' 001664' .WORD OFSET,AT,PLUS,TOR 011534 001506' 50 011536 003340' 002226' 002104' .WORD PREV,AT,DUP,AT,LIT,077777,AND,R,SUB,ZBRAN,XXT4-. 011544 002226' 000060' 077777 011552 001302' 001540' 003524' 011560 000144' 000066 51 011564 011066' 001556' 000144' XXT5: .WORD PBUF,ZEQU,ZBRAN,XXT6-. 011572 000024 52 011574 002034' 001540' 011414' .WORD DROP,R,BUFFE 53 011602 002104' 001540' 002550' .WORD DUP,R,ONE,RW,TWO,SUB 011610 014766' 002560' 003524' 54 011616 002104' 002226' 000060' XXT6: .WORD DUP,AT,LIT,077777,AND,R,SUB,ZEQU 011624 077777 001302' 001540' 011632 003524' 001556' 55 011636 000144' 177724 .WORD ZBRAN,XXT5-. 56 011642 002104' 003340' 002272' .WORD DUP,PREV,STORE 57 011650 001524' 002034' 003370' XXT4: .WORD FROMR,DROP,TWOP,SEMIS 011656 001446' 58 ; 59 ; 60 ; 61 ; 62 ; 63 ; 64 011660 HEAD 206,(LINE),240,PLINE,DOCOL ; ***** (LINE) 65 011674 001506' 002614' 002630' .WORD TOR,CL,BBUF,SSMOD,FROMR,BSCR 011702 010764' 001524' 002644' 66 011710 010664' 001664' 011524' .WORD STAR,PLUS,BLOCK,PLUS,CL,SEMIS 011716 001664' 002614' 001446' 67 ; 68 011724 HEAD 205,.LINE,305,DLINE,DOCOL ; ***** .LINE 69 011736 011672' 005160' 005054' .WORD PLINE,DTRAI,TYPE,SEMIS 011744 001446' 70 ; 71 011746 HEAD 207,MESSAGE,305,MESS,DOCOL ; ***** MESSAGE 72 011762 002760' 002226' 000144' .WORD WARN,AT,ZBRAN,XXW5-.,DDUP,ZBRAN,XXW3-.,LIT,4 011770 000034 004004' 000144' 011776 000022 000060' 000004 73 012004 003144' 002226' 002644' .WORD OFSET,AT,BSCR,SLASH,SUB,DLINE 012012 010724' 003524' 011734' 74 012020 000122' 000016 XXW3: .WORD BRAN,XXW4-. 75 012024 005244' XXW5: .WORD PDOTQ 76 012026 006 .BYTE 6 F.I.G. MACRO V04.00 00:00:13 PAGE 8-2 77 012027 115 123 107 .ASCII /MSG # / 012032 040 043 040 78 .EVEN 79 012036 013354' .WORD DOT 80 012040 001446' XXW4: .WORD SEMIS 81 ; 82 012042 HEAD 204,LOAD,240,LOAD,DOCOL ; ***** LOAD 83 012054 003070' 002226' 001506' .WORD BLK,AT,TOR,IN,AT,TOR,ZERO,IN,STORE 012062 003102' 002226' 001506' 012070 002540' 003102' 002272' 84 012076 002644' 010664' 003070' .WORD BSCR,STAR,BLK,STORE,INTER,FROMR,IN,STORE 012104 002272' 007460' 001524' 012112 003102' 002272' 85 012116 001524' 003070' 002272' .WORD FROMR,BLK,STORE,SEMIS 012124 001446' 86 ; 87 012126 HEAD 303,-->,276,ARROW,DOCOL ; ***** --> 88 012136 004454' 002540' 003102' .WORD QLOAD,ZERO,IN,STORE,BSCR,BLK,AT,OVER 012144 002272' 002644' 003070' 012152 002226' 002012' 89 012156 010744' 003524' 003070' .WORD MOD,SUB,BLK,PSTOR,SEMIS 012164 002122' 001446' 90 ; 91 ; 92 ; 93 ; 94 ; NOTE - THE INSTALLATION-DEPENDENT I/O IS AT THE END 95 ; OF THE DICTIONARY - JUST BELOW 'TASK'. 'XI/O' IS THE 96 ; PRIMITIVE READ OR WRITE OF A 512-BYTE BLOCK. 97 ; 98 ; 99 ; 100 ; 101 ; 102 ; F.I.G. MACRO V04.00 00:00:13 PAGE 9 1 ; **************************************************************** 2 ; 3 ; MISCELLANEOUS HIGHER LEVEL 4 ; 5 ; **************************************************************** 6 ; 7 ; 8 012170 HEAD 301,',247,TICK,DOCOL ; ***** ' 9 012176 006476' 001556' 002540' .WORD DFIND,ZEQU,ZERO,QERR,DROP,LITER,SEMIS 012204 004260' 002034' 007226' 012212 001446' 10 ; 11 012214 HEAD 206,FORGET,240,FORGE,DOCOL ; ***** FORGET 12 012230 003200' 002226' 003162' .WORD CURR,AT,CONT,AT,SUB,LIT,30,QERR,TICK,DUP 012236 002226' 003524' 000060' 012244 000030 004260' 012174' 012252 002104' 13 012254 002774' 002226' 003642' .WORD FENCE,AT,LESS,LIT,25,QERR 012262 000060' 000025 004260' 14 012270 002104' 004160' 003006' .WORD DUP,NFA,DP,STORE,LFA,AT,CONT,AT 012276 002272' 004122' 002226' 012304 003162' 002226' 15 012310 002272' 001446' .WORD STORE,SEMIS 16 ; 17 ; 18 ; 19 ; 20 012314 HEAD 204,BACK,240,BACK,DOCOL ; ***** BACK 21 012326 003450' 003524' 003504' .WORD HERE,SUB,COMMA,SEMIS 012334 001446' 22 ; 23 012336 HEAD 305,BEGIN,316,BEGIN,DOCOL ; ***** BEGIN 24 012350 004312' 003450' 002550' .WORD QCOMP,HERE,ONE,SEMIS 012356 001446' 25 ; 26 012360 HEAD 305,ENDIF,306,ENDIF,DOCOL ; ***** ENDIF 27 012372 004312' 002560' 004372' .WORD QCOMP,TWO,QPAIR,HERE,OVER,SUB,SWAP,STORE,SEMIS 012400 003450' 002012' 003524' 012406 002056' 002272' 001446' 28 ; 29 012414 HEAD 304,THEN,240,THEN,DOCOL ; ***** THEN 30 012426 012370' 001446' .WORD ENDIF,SEMIS 31 ; 32 012432 HEAD 302,DO,240,DO,DOCOL ; ***** DO 33 012442 004506' 000334' 003450' .WORD COMP,XDO,HERE,LIT,3,SEMIS 012450 000060' 000003 001446' 34 ; 35 012456 HEAD 304,LOOP,240,LOOP,DOCOL ; ***** LOOP 36 012470 000060' 000003 004372' .WORD LIT,3,QPAIR,COMP,XLOOP,BACK,SEMIS 012476 004506' 000202' 012324' 012504 001446' 37 ; 38 012506 HEAD 305,+LOOP,320,PLOOP,DOCOL ; ***** +LOOP 39 012520 000060' 000003 004372' .WORD LIT,3,QPAIR,COMP,XPLOO,BACK,SEMIS 012526 004506' 000250' 012324' 012534 001446' 40 ; F.I.G. MACRO V04.00 00:00:13 PAGE 9-1 41 012536 HEAD 305,UNTIL,314,UNTIL,DOCOL ; ***** UNTIL 42 012550 002550' 004372' 004506' .WORD ONE,QPAIR,COMP,ZBRAN,BACK,SEMIS 012556 000144' 012324' 001446' 43 ; 44 012564 HEAD 303,END,304,END,DOCOL ; ***** END 45 012574 012546' 001446' .WORD UNTIL,SEMIS 46 ; 47 012600 HEAD 305,AGAIN,316,AGAIN,DOCOL ; ***** AGAIN 48 012612 002550' 004372' 004506' .WORD ONE,QPAIR,COMP,BRAN,BACK,SEMIS 012620 000122' 012324' 001446' 49 ; 50 012626 HEAD 306,REPEAT,240,REPEAT,DOCOL ; ***** REPEAT 51 012642 001506' 001506' 012610' .WORD TOR,TOR,AGAIN,FROMR,FROMR,TWO,SUB,ENDIF,SEMIS 012650 001524' 001524' 002560' 012656 003524' 012370' 001446' 52 ; 53 012664 HEAD 302,IF,240,IF,DOCOL ; ***** IF 54 012674 004506' 000144' 003450' .WORD COMP,ZBRAN,HERE,ZERO,COMMA,TWO,SEMIS 012702 002540' 003504' 002560' 012710 001446' 55 ; 56 012712 HEAD 304,ELSE,240,ELSE,DOCOL ; ***** ELSE 57 012724 002560' 004372' 004506' .WORD TWO,QPAIR,COMP,BRAN,HERE,ZERO,COMMA 012732 000122' 003450' 002540' 012740 003504' 58 012742 002056' 002560' 012370' .WORD SWAP,TWO,ENDIF,TWO,SEMIS 012750 002560' 001446' 59 ; 60 012754 HEAD 305,WHILE,305,WHILE,DOCOL ; ***** WHILE 61 012766 012672' 003370' 001446' .WORD IF,TWOP,SEMIS 62 ; 63 ; 64 ; 65 ; 66 012774 HEAD 206,SPACES,240,SPACS,DOCOL ; ***** SPACES 67 013010 002540' 010446' 004004' .WORD ZERO,MAX,DDUP,ZBRAN,XXR4-.,ZERO,XDO 013016 000144' 000014 002540' 013024 000334' 68 013026 003762' 000202' 177774 XXRA: .WORD SPACE,XLOOP,XXRA-. 69 013034 001446' XXR4: .WORD SEMIS 70 ; 71 013036 HEAD 202,^/<#/,240,BDIGS,DOCOL ; ***** <# 72 013046 006064' 003312' 002272' .WORD PAD,HLD,STORE,SEMIS 013054 001446' 73 ; 74 013056 HEAD 202,#>,240,EDIGS,DOCOL ; ***** #> 75 013066 002034' 002034' 003312' .WORD DROP,DROP,HLD,AT,PAD,OVER,SUB,SEMIS 013074 002226' 006064' 002012' 013102 003524' 001446' 76 ; 77 013106 HEAD 204,SIGN,240,SIGN,DOCOL ; ***** SIGN 78 013120 003724' 001606' 000144' .WORD ROT,ZLESS,ZBRAN,XXR1-.,LIT,55,HOLD 013126 000010 000060' 000055 013134 006034' 79 013136 001446' XXR1: .WORD SEMIS 80 ; 81 013140 HEAD 201,#,243,DIG,DOCOL ; ***** # F.I.G. MACRO V04.00 00:00:13 PAGE 9-2 82 013146 003230' 002226' 011030' .WORD BASE,AT,MSMOD,ROT,LIT,11,OVER,LESS 013154 003724' 000060' 000011 013162 002012' 003642' 83 013166 000144' 000010 000060' .WORD ZBRAN,XXR2-.,LIT,7,PLUS 013174 000007 001664' 84 013200 000060' 000060 001664' XXR2: .WORD LIT,60,PLUS,HOLD,SEMIS 013206 006034' 001446' 85 ; 86 013212 HEAD 202,#S,240,DIGS,DOCOL ; ***** #S 87 013222 013144' 002012' 002012' XXR3: .WORD DIG,OVER,OVER,OR,ZEQU,ZBRAN,XXR3-.,SEMIS 013230 001322' 001556' 000144' 013236 177764 001446' 88 ; 89 013242 HEAD 203,D.R,322,DDOTR,DOCOL ; ***** D.R 90 013252 001506' 002056' 002012' .WORD TOR,SWAP,OVER,DABS,BDIGS,DIGS,SIGN,EDIGS 013260 010372' 013044' 013220' 013266 013116' 013064' 91 013272 001524' 002012' 003524' .WORD FROMR,OVER,SUB,SPACS,TYPE,SEMIS 013300 013006' 005054' 001446' 92 ; 93 013306 HEAD 202,.R,240,DOTR,DOCOL ; ***** .R 94 013316 001506' 010316' 001524' .WORD TOR,STOD,FROMR,DDOTR,SEMIS 013324 013250' 001446' 95 ; 96 013330 HEAD 202,D.,240,DDOT,DOCOL ; ***** D. 97 013340 002540' 013250' 003762' .WORD ZERO,DDOTR,SPACE,SEMIS 013346 001446' 98 ; 99 013350 HEAD 201,.,256,DOT,DOCOL ; ***** . 100 013356 010316' 013336' 001446' .WORD STOD,DDOT,SEMIS 101 ; 102 013364 HEAD 201,?,277,QUEST,DOCOL ; ***** ? 103 013372 002226' 013354' 001446' .WORD AT,DOT,SEMIS 104 ; 105 013400 HEAD 202,U.,240,UDOT,DOCOL ; ***** U. 106 013410 002540' 013336' 001446' .WORD ZERO,DDOT,SEMIS 107 ; 108 ; UTILITY SECTION. 109 ; 110 ; 111 013416 HEAD 204,LIST,240,LIST,DOCOL ; ***** LIST 112 ; ( N---. LIST GIVEN SCREEN.) 113 013430 004650' 001056' 002104' .WORD DEC,CR,DUP,SCR,STORE,PDOTQ 013436 003126' 002272' 005244' 114 013444 006 .BYTE 6 115 013445 123 103 122 .ASCII /SCR # / 013450 040 043 040 116 .EVEN 117 013454 013354' 000060' 000020 .WORD DOT,LIT,20,ZERO,XDO 013462 002540' 000334' 118 013466 001056' 000360' 002570' XXZ1: .WORD CR,I,THREE,DOTR,SPACE 013474 013314' 003762' 119 013500 000360' 003126' 002226' .WORD I,SCR,AT,DLINE,XLOOP,XXZ1-.,CR,SEMIS 013506 011734' 000202' 177754 013514 001056' 001446' 120 ; 121 013520 HEAD 205,INDEX,330,INDEX,DOCOL ; ***** INDEX F.I.G. MACRO V04.00 00:00:13 PAGE 9-3 122 ; LIST FIRST LINE OF A RANGE OF DISK SCREENS. 123 013532 001056' 003352' 002056' .WORD CR,ONEP,SWAP,XDO 013540 000334' 124 013542 001056' 000360' 002570' XXZ2: .WORD CR,I,THREE,DOTR,SPACE,ZERO,I,DLINE 013550 013314' 003762' 002540' 013556 000360' 011734' 125 013562 001046' 000144' 000004 .WORD QTERM,ZBRAN,XXZ3-.,LEAVE 013570 001466' 126 013572 000202' 177746 001446' XXZ3: .WORD XLOOP,XXZ2-.,SEMIS 127 ; 128 013600 HEAD 205,TRIAD,304,TRIAD,DOCOL ; ***** TRIAD 129 ; LIST DISK SCREENS THREE PER PAGE. 130 013612 000060' 000014 001020' .WORD LIT,14,EMIT ; FORM FEED 131 013620 002570' 010724' 002570' .WORD THREE,SLASH,THREE,STAR,THREE 013626 010664' 002570' 132 013632 002012' 001664' 002056' .WORD OVER,PLUS,SWAP,XDO 013640 000334' 133 013642 001056' 000360' 013426' XXZ4: .WORD CR,I,LIST,XLOOP,XXZ4-.,CR,LIT,17,MESS,CR,SEMIS 013650 000202' 177770 001056' 013656 000060' 000017 011760' 013664 001056' 001446' 134 ; 135 013670 HEAD 205,VLIST,324,VLIST,DOCOL ; ***** VLIST 136 013702 000060' 000200 003114' .WORD LIT,200,OUT,STORE,CONT,AT,AT 013710 002272' 003162' 002226' 013716 002226' 137 013720 003114' 002226' 000060' XXZ5: .WORD OUT,AT,LIT,100,GREAT,ZBRAN,XXZ6-. 013726 000100 003672' 000144' 013734 000012 138 013736 001056' 002540' 003114' .WORD CR,ZERO,OUT,STORE 013744 002272' 139 013746 002104' 006750' 003762' XXZ6: .WORD DUP,IDDOT,SPACE,SPACE,PFA,LFA,AT 013754 003762' 004206' 004122' 013762 002226' 140 013764 002104' 001556' 001046' .WORD DUP,ZEQU,QTERM,OR,ZBRAN,XXZ5-.,DROP,SEMIS 013772 001322' 000144' 177722 014000 002034' 001446' 141 ; 142 .IFDF LINKS 143 HEAD 205,VLINK,313,XVLINK,DOCON ; ***** VLINK 144 ; THIS IS ONLY USED FOR LINKAGE FROM FORTH TO SUBROUTINES 145 ; IN OTHER LANGUAGES. SEE USER'S GUIDE FOR DOCUMENTATION. 146 .WORD VLINK 147 .ENDC 148 ; 149 ; 150 ; 151 ; 152 ; 153 ; F.I.G. MACRO V04.00 00:00:13 PAGE 10 1 ; **************************************************************** 2 ; 3 ; INSTALLATION-DEPENDENT SECTION (TERMINAL AND DISK I/O, AND TRAPS) 4 ; 5 ; **************************************************************** 6 ; 7 ; 8 ; *************** 9 ; 10 ; RSX-11M TERMINAL I/O 11 ; 12 ; *************** 13 ; 14 .IFDF RSX11 15 ; 16 .EVEN 17 ; NOTE - FOR RSX-11 ON HEAVILY LOADED MACHINES, IT IS BETTER 18 ; FOR 'KEY' TO READ A WHOLE LINE AT A TIME, AND UNPACK IT. 19 ; ALSO, 'KEY' SHOULD EMIT A LINE FEED WHEN A CARRIAGE RETURN 20 ; HAS BEEN READ. 21 22 PEMIT: JSR R1,ITERM ; INITIALIZE RSX? 23 ; INCREMENT 'OUT', UNLESS A CONTROL CHARACTER BEING OUTPUT. 24 CMP (S),#40 ; TEST FOR CONTROL CHARACTER 25 BLT 1$ 26 INC 42(U) ; INCREMENT 'OUT' 27 1$: 28 JSR R1,XCOUT ; OUTPUT A CHARACTER 29 NEXT 30 ; 31 PKEY: JSR R1,ITERM ; INITIALIZE RSX? 32 TST INTERM ; ZERO MEANS READ NEW LINE 33 BNE XCHAR 34 XLINE: MOV #XBUFF,INTERM ; READ NEW LINE 35 QIOW$C IO.RVB,4,4,,IOSTAT,, 36 ADD #XBUFF,IOSTAT+2 ; TERMINATE LINE WITH CR 37 MOVB #15,@IOSTAT+2 38 XCHAR: TST -(S) ; DECREMENT STACK POINTER 39 MOVB @INTERM,(S) ; FOR THIS BYTE INSTRUCTION 40 INC INTERM 41 BIC #177600,(S) 42 CMP (S),#15 ; IF CR IS BEING SENT, 43 BNE XRETRN 44 CLR INTERM ; THEN READ NEW LINE NEXT TIME. 45 MOV #12,-(S) ; AND ALSO EMIT A LINE FEED 46 JSR R1,XCOUT 47 XRETRN: NEXT 48 ; 49 PQTER: JSR R1,ITERM ; INITIALIZE RSX? 50 MOV QFLAG,-(S) 51 CLR QFLAG 52 NEXT 53 ; PUT THE AST ROUTINE HERE 54 AST1: MOV (RP)+,QFLAG ; SET UP FOR NEXT '?TERMINAL'; 55 ; NOTE THAT 'RP' IS SYSTEM STACK. 56 CMP QFLAG,#3 ; TEST FOR ^C 57 BNE 1$ F.I.G. MACRO V04.00 00:00:13 PAGE 10-1 58 MOV #GO,IP 59 1$: ASTX$S 60 ; 61 ; 62 PCR: JSR R1,ITERM ; INITIALIZE RSX? 63 MOV #15,-(S) 64 JSR R1,XCOUT 65 MOV #12,-(S) 66 JSR R1,XCOUT 67 NEXT 68 ; 69 XCOUT: MOV (S)+,IOCHR 70 QIOW$C IO.WVB!TF.WAL,4,4,,IOSTAT,, 71 RTS R1 72 ; 73 ITERM: ; INITIALIZE RSX IF FIRST TIME THROUGH 74 CMP INTERM,#-1 ; FIRST TIME TERMINAL I/O? 75 BNE RSXRTS 76 CLR INTERM ; YES 77 ALUN$C 4,TI,0 ; ASSIGN LUN 78 QIOW$C IO.ATA,4,,,,, ; ATTACH - UNSOLICITED I/O 79 SVTK$S #TRAPV,#6 ; SET UP FOR TRAPS 80 RSXRTS:RTS R1 81 INTERM: .WORD -1 ; FLAG FOR FIRST TIME TERMINAL I/O. 82 ; DO NOT REINITIALIZE 'INTERM' AT COLD START, LEST ASSIGNMENT DONE TWICE. 83 IOCHR: .WORD 0 ; TEMPORARY AREA FOR 'KEY' AND 'EMIT' 84 QFLAG: .WORD 0 ; FOR '?TERMINAL' 85 XBUFF: .BLKB 82. ; TERMINAL BUFFER FOR RSX LINE I/O 86 ; 87 ; 88 ; 89 HEAD 203,BYE,305,BYE ; ***** BYE (LOG OFF) 90 CLOSE$ #FDBIO ; CLOSE DISK I/O 91 EXIT$S 92 ; 93 ; 94 ; *************** 95 ; 96 ; RSX11-M DISK I/O 97 ; 98 ; *************** 99 ; 100 HEAD 204,XI/O,240,XIO ; ***** XI/O (RSX) 101 ; PHYSICAL READ-WRITE 102 ; ADDRESS BLOCK# FLAG ==> REPORT. READS OR WRITES A 512-BYTE BLOCK. 103 ; FLAG 1=READ, 0=WRITE. REPORT '0'=GOOD I/O, '1'=I/O ERROR. 104 ; IF REPORT IS '1', THEN NEXT ON STACK IS '1'=OPEN ERROR, 105 ; '2'=READ ERROR, '3'=WRITE ERROR, '4'=WAIT ERROR, '5'=ARGUMENT 106 ; ERROR (FLAG NOT '0' OR '1'). 107 CLR DSKERR ; FOR I/O ERROR REPORT 108 TST OPENF ; DISK FILE ALREADY OPENED? 109 BNE 2$ 110 OPEN$M #FDBIO 111 BCC 2$ 112 MOV #1,DSKERR ; ERROR IN OPEN 113 BR ERRR 114 2$: MOV #1,OPENF ; INDICATE FILE IS OPEN F.I.G. MACRO V04.00 00:00:13 PAGE 10-2 115 CLR VIRBLK 116 MOV 2(S),VIRBLK+2 ; SET UP VIRTUAL BLOCK NUMBER 117 MOV 4(S),IOADDR ; SET UP I/O ADDRESS 118 TST (S) ; WAS TOP OF STACK - READ OR WRITE? 119 BEQ WRITE 120 CMP (S),#1 121 BEQ READ 122 MOV #5,DSKERR ; ERROR, FLAG NOT EITHER '0' OR '1' 123 BR ERRR 124 READ: READ$ #FDBIO,IOADDR,,#VIRBLK,#2 125 BCC WAIT 126 MOV #2,DSKERR ; ERROR IN READ 127 BR ERRR 128 WRITE: WRITE$ #FDBIO,IOADDR,,#VIRBLK,#2 129 BCC WAIT 130 MOV #3,DSKERR ; ERROR IN WRITE 131 BR ERRR 132 WAIT: WAIT$ 133 BCC DONE 134 MOV #4,DSKERR ; ERROR IN WAIT 135 BR ERRR 136 DONE: ADD #6,S 137 CLR -(S) ; INDICATE GOOD I/O 138 BR DONE2 139 ERRR: ADD #6,S 140 MOV DSKERR,-(S) ; RETURN THE ERROR INDICATOR 141 MOV #1,-(S) ; INDICATE ERROR IN I/O 142 DONE2: NEXT 143 FSRSZ$ 0 144 FDBIO: FDBDF$ 145 FDRC$A FD.RWM 146 FDBK$A ,512.,,2,IOSTAT 147 FDOP$A 3,DESCR,,FO.MFY 148 DESCR: .WORD 0,0 ; USE DEFAULT DEVICE 149 .WORD 0,0 ; AND DIRECTORY. 150 .WORD FILSZ,FIL 151 FIL: .ASCII /FORTH.DAT/ 152 FILSZ=.-FIL 153 .EVEN 154 ; 155 OPENF: .WORD 0 ; FLAG FOR FIRST TIME DISK I/O 156 ; DO NOT INITIALIZE 'OPENF' AT COLD START 157 DSKERR: .WORD 0 ; SPACE FOR DISK ERROR MESSAGE 158 IOADDR: .WORD 0 ; ADDRESS FOR DISK READ/WRITE 159 IOSTAT: .BLKW 2 ; I/O STATUS REPORT 160 VIRBLK: .BLKW 2 ; VIRTUAL BLOCK NUMBER 161 ; 162 HEAD 212,BLOCK-READ,240,BREAD,DOCOL ; ***** BLOCK-READ 163 ; ( ADDRESS BLOCK# ==> REPORT). REPORT: 0=GOOD READ, ELSE ERROR 164 .WORD ONE,XIO,SEMIS 165 ; 166 HEAD 213,BLOCK-WRITE,305,BWRIT,DOCOL ; ***** BLOCK-WRITE 167 ; ( ADDRESS BLOCK# ==> REPORT). REPORT: 0=GOOD WRITE, ELSE ERROR 168 .WORD ZERO,XIO,SEMIS 169 ; 170 HEAD 203,I/O,317,IO,DOCOL ; ***** I/O 171 ; READ OR WRITE 512-BYTE BLOCK, HANDLE ERRORS. F.I.G. MACRO V04.00 00:00:13 PAGE 10-3 172 ; ( ADDRESS BLOCK# FLAG(1=READ,0=WRITE) ==> ) 173 .WORD DUP,ONE,EQUAL,ZBRAN,XXS1-.,DROP,BREAD 174 .WORD ZBRAN,XXS2-.,CR,PDOTQ 175 .BYTE 22 176 .ASCII /DISK READ ERROR # / 177 .EVEN 178 .WORD DOT,ABORT 179 XXS2: .WORD BRAN,XXS3-. 180 XXS1: .WORD ZEQU,ZBRAN,XXS4-.,BWRIT,ZBRAN,XXS5-. 181 .WORD CR,PDOTQ 182 .BYTE 23 183 .ASCII /DISK WRITE ERROR # / 184 .EVEN 185 .WORD DOT,ABORT 186 XXS5: 187 XXS4: 188 XXS3: .WORD SEMIS 189 ; 190 HEAD 203,R/W,327,RW,DOCOL ; ***** R/W 191 ; READ OR WRITE 1024-BYTE SCREEN. ( ADDRESS SCREEN# FLAG ==> ) 192 ; NOTE THAT SCREEN N IS BLOCKS 2N-1 AND 2N. 193 .WORD TOR,TWO,STAR,OVER,OVER,ONE,SUB,R,IO 194 .WORD SWAP,LIT,512.,PLUS 195 .WORD SWAP,FROMR,IO,SEMIS 196 ; 197 .ENDC 198 ; 199 ; *************** 200 ; 201 ; RT-11 TERMINAL I/O 202 ; 203 ; *************** 204 ; 205 .IFDF RT11 206 ITERM: CMP INTERM,#-1 207 BNE RTRTS 208 CLR INTERM 209 .RCTRLO ; RESET CNTL-O 210 .TRPSET #TRAPBL,#TRAPZ 211 RTRTS: RTS R1 212 ; 213 PEMIT: 214 JSR R1,ITERM 215 ; INCREMENT 'OUT', UNLESS A CONTROL CHARACTER BEING OUTPUT. 216 CMP (S),#40 ; TEST FOR CONTROL CHARACTER 217 BLT 1$ 218 INC 42(U) ; INCREMENT 'OUT' 219 1$: 220 JSR R1,XCOUT 221 NEXT 222 ; 223 PKEY: JSR R1,ITERM 224 .TTYIN 225 BIC #177600,R0 226 CMP R0,#12 ; IGNORE LINEFEED 227 BEQ PKEY 228 MOV R0,-(S) F.I.G. MACRO V04.00 00:00:13 PAGE 10-4 229 NEXT 230 ; 231 PQTER: JSR R1,ITERM 232 MOV 44,-(RP) ; SAVE JSW 233 BIS #10100,44 ; SET BITS 6 AND 12 OF JSW 234 .TTINR 235 BCC 1$ 236 ; IF CARRY SET, NO CHARACTER - SUPPLY ZERO 237 CLR R0 238 1$: BIC #177600,R0 239 CMP R0,#12 ; IGNORE LINEFEED 240 BNE 2$ 241 CLR R0 242 2$: MOV R0,-(S) 243 MOV (RP)+,44 ; RESTORE JSW 244 NEXT 245 ; 246 PCR: JSR R1,ITERM 247 MOV #15,-(S) 248 JSR R1,XCOUT 249 MOV #12,-(S) 250 JSR R1,XCOUT 251 NEXT 252 ; 253 XCOUT: MOV (S)+,R0 254 .TTYOUT 255 RTS R1 256 ; 257 INTERM: .WORD -1 ; FLAG FOR FIRST TIME TERMINAL I/O 258 ; DO NOT INITIALIZE 'INTERM' AT COLD START 259 IOCHR: .WORD 0 ; TEMPORARY AREA FOR 'KEY', 'EMIT' 260 ; 261 HEAD 203,BYE,305,BYE ; ***** BYE (RT) 262 .EXIT 263 ; 264 ; 265 ; *************** 266 ; 267 ; RT-11 DISK I/O 268 ; 269 ; *************** 270 ; 271 HEAD 204,XI/O,240,XIO ; ***** XI/O (RT) 272 CLR DSKERR 273 TST OPENF 274 BNE RTOPEN 275 MOV #1,OPENF ; INDICATE FILE IS OPEN 276 ; NOW OPEN THE FILE 277 .SETTOP #-2 278 MOV #RTSTAT,R1 279 .DSTATUS R1,#RTFILE 280 BCC 1$ 281 MOV #1,DSKERR 282 BR RTRET 283 1$: TST 4(R1) ; HANDLER IN? 284 BNE 2$ 285 .FETCH HANDLR,#RTFILE F.I.G. MACRO V04.00 00:00:13 PAGE 10-5 286 BCC 2$ 287 MOV #2,DSKERR 288 BR RTRET 289 2$: .LOOKUP #LOOK1,#0,#RTFILE 290 BCC RTOPEN 291 MOV #3,DSKERR 292 BR RTRET 293 RTOPEN: ; FILE IS OPEN - NOW READ IT 294 MOV 2(S),R1 ; BLOCK # 295 DEC R1 ; BEGINS AT 1 IN FORTH 296 MOV 4(S),IOADDR ; BUFFER ADDRESS 297 TST (S) 298 BEQ WRITE 299 CMP (S),#1 300 BEQ READ 301 MOV #5,DSKERR 302 BR RTRET 303 READ: .READW #RTBLK,#0,IOADDR,,R1 304 BCC 1$ 305 MOV #6,DSKERR 306 1$: BR RTRET 307 WRITE: .WRITW #RTBLK,#0,IOADDR,,R1 308 BCC 2$ 309 MOV #7,DSKERR 310 2$: BR RTRET 311 RTRET: ADD #6,S 312 MOV DSKERR,-(S) 313 TST DSKERR 314 BEQ 1$ 315 MOV #1,-(S) ; INDICATE ERROR OCCURRED 316 1$: NEXT 317 RTFILE: .RAD50 /DK FORTH DAT/ 318 RTBLK: .BYTE 0,10 319 .WORD 0,0,256.,0 320 ; 321 OPENF: .WORD 0 ; FLAG FOR FIRST TIME DISK I/O 322 DSKERR: .WORD 0 ; SPACE FOR DISK ERROR MESSAGE 323 IOADDR: .WORD 0 ; ADDRESS FOR DISK READ/WRITE 324 RTSTAT: .BLKW 4 ; DISK I/O STATUS 325 LOOK1: .BLKW 3 ; EMT ARGUMENT BLOCK 326 TRAPBL: .BLKW 2 ; EMT ARGUMENT BLOCK 327 ; 328 HEAD 212,BLOCK-READ,240,BREAD,DOCOL ; ***** BLOCK-READ 329 ; ( ADDRESS BLOCK# ==> REPORT). REPORT: 0=GOOD READ, ELSE ERROR 330 .WORD ONE,XIO,SEMIS 331 ; 332 HEAD 213,BLOCK-WRITE,305,BWRIT,DOCOL ; ***** BLOCK-WRITE 333 ; ( ADDRESS BLOCK# ==> REPORT). REPORT: 0=GOOD WRITE, ELSE ERROR 334 .WORD ZERO,XIO,SEMIS 335 ; 336 HEAD 203,I/O,317,IO,DOCOL ; ***** I/O 337 ; READ OR WRITE 512-BYTE BLOCK, HANDLE ERRORS. 338 ; ( ADDRESS BLOCK# FLAG(1=READ,0=WRITE) ==> ) 339 .WORD DUP,ONE,EQUAL,ZBRAN,XXS1-.,DROP,BREAD 340 .WORD ZBRAN,XXS2-.,CR,PDOTQ 341 .BYTE 22 342 .ASCII /DISK READ ERROR # / F.I.G. MACRO V04.00 00:00:13 PAGE 10-6 343 .EVEN 344 .WORD DOT,ABORT 345 XXS2: .WORD BRAN,XXS3-. 346 XXS1: .WORD ZEQU,ZBRAN,XXS4-.,BWRIT,ZBRAN,XXS5-. 347 .WORD CR,PDOTQ 348 .BYTE 23 349 .ASCII /DISK WRITE ERROR # / 350 .EVEN 351 .WORD DOT,ABORT 352 XXS5: 353 XXS4: 354 XXS3: .WORD SEMIS 355 ; 356 HEAD 203,R/W,327,RW,DOCOL ; ***** R/W 357 ; READ OR WRITE 1024-BYTE SCREEN. ( ADDRESS SCREEN# FLAG ==> ) 358 ; NOTE THAT SCREEN N IS BLOCKS 2N-1 AND 2N. 359 .WORD TOR,TWO,STAR,OVER,OVER,ONE,SUB,R,IO 360 .WORD SWAP,LIT,512.,PLUS 361 .WORD SWAP,FROMR,IO,SEMIS 362 ; 363 ; 364 .ENDC 365 ; 366 ; *************** 367 ; 368 ; STAND-ALONE TERMINAL I/O 369 ; 370 ; **************** 371 ; 372 .IFDF ALONE 373 ; 374 ; TERMINAL CONTROLLER REGISTER DEFINITIONS 375 ; 376 177560 RCSR=177560 ; TERMINAL RECEIVE CONTROL & STATUS 377 177562 RBUF=177562 ; TERMINAL RECEIVE BUFFER 378 177564 XCSR=177564 ; TERMINAL TRANSMIT CONTROL & STATUS 379 177566 XBUF=177566 ; TERMINAL TRANSMIT BUFFER 380 ; 381 014004 PEMIT: 382 ; INCREMENT 'OUT', UNLESS A CONTROL CHARACTER BEING OUTPUT. 383 014004 021527 000040 CMP (S),#40 ; TEST FOR CONTROL CHARACTER 384 014010 002402 BLT 1$ 385 014012 005263 000042 INC 42(U) ; INCREMENT 'OUT' 386 014016 005737 177564 1$: TST @#XCSR 387 014022 001775 BEQ 1$ 388 014024 042715 177600 BIC #177600,(S) ; CLEAR UPPER BITS FOR ASCII 389 014030 012537 177566 MOV (S)+,@#XBUF ; ONLY OUTPUTS LOW 8 BITS 390 014034 NEXT 391 ; 392 014040 105737 177560 PKEY: TSTB @#RCSR 393 014044 001775 BEQ PKEY 394 014046 005037 177560 CLR @#RCSR 395 014052 113701 177562 MOVB @#RBUF,R1 396 014056 042701 177600 BIC #177600,R1 397 014062 010145 MOV R1,-(S) 398 014064 022701 000177 CMP #177,R1 399 014070 001005 BNE PK001 F.I.G. MACRO V04.00 00:00:13 PAGE 10-7 400 014072 004767 000032 CALL PBKSP ; OUTPUT , 401 014076 012715 000010 MOV #10,(S) ; CHANGE RUBOUT TO BACKSPACE CHARACTER 402 014102 000410 BR PK003 403 014104 021527 000015 PK001: CMP (S),#15 ; CARRIAGE RETURN 404 014110 001403 BEQ PK002 405 014112 005267 046664 INC OUTPOS ; PRINTABLE--INCREMENT OUTPUT POSITION 406 014116 000402 BR PK003 407 014120 005067 046656 PK002: CLR OUTPOS 408 014124 PK003: NEXT 409 ; 410 ; PRINT , COMBINATION TO ERASE CHARACTER 411 ; 412 014130 005767 046646 PBKSP: TST OUTPOS 413 014134 003416 BLE PBKRET ; EMPTY OUTPUT BUFFER--RETURN 414 014136 005367 046640 DEC OUTPOS ; OUTPUT POSITION MOVES LEFT 415 014142 005737 177564 PBKOUT: TST @#XCSR 416 014146 001775 BEQ PBKOUT ; WAIT UNTIL READY TO TRANSMIT 417 014150 012737 000010 177566 MOV #10,@#XBUF ; OUTPUT BACKSPACE CHARACTER 418 014156 005737 177564 PSPOUT: TST @#XCSR 419 014162 001775 BEQ PSPOUT ; WAIT UNTIL READY TO TRANSMIT 420 014164 012737 000040 177566 MOV #40,@#XBUF ; OUTPUT SPACE CHARACTER 421 014172 000207 PBKRET: RETURN 422 ; 423 014174 105737 177560 PQTER: TSTB @#RCSR 424 014200 001403 BEQ 1$ 425 014202 013745 177562 MOV @#RBUF,-(S) 426 014206 000401 BR 2$ 427 014210 005045 1$: CLR -(S) 428 014212 005037 177560 2$: CLR @#RCSR 429 014216 NEXT 430 ; 431 014222 005737 177564 PCR: TST @#XCSR 432 014226 001775 BEQ PCR 433 014230 012737 000015 177566 MOV #15,@#XBUF 434 014236 005737 177564 1$: TST @#XCSR 435 014242 001775 BEQ 1$ 436 014244 012737 000012 177566 MOV #12,@#XBUF 437 014252 NEXT 438 ; 439 014256 HEAD 203,BYE,305,BYE ; ***** BYE (ALONE) 440 441 014266 000000 HALT 442 ; 443 ; *************** 444 ; 445 ; STAND-ALONE DISK I/O 446 ; 447 ; *************** 448 ; 449 .IFDF RL02 450 ; 451 ; STANDALONE MODE IS USING RL02, NOT RX01 FLOPPY DISK. 452 ; 453 174400 RLCS=174400 454 174402 RLBA=174402 455 174404 RLDA=174404 456 174406 RLMP=174406 F.I.G. MACRO V04.00 00:00:13 PAGE 10-8 457 ; 458 ; RL02 DISK LOCATION WORD: 459 ; 460 ; 15 7 6 5 0 461 ; +----------+------+--------+ 462 ; | CYLINDER | HEAD | SECTOR | 463 ; +----------+------+--------+ 464 ; 465 ; ( EXTRACT THE CYLINDER, HEAD, OR SECTOR FROM DISK LOCATION ) 466 ; : RLCYL 0 200 U/ SWAP DROP 777 AND ; ( GET DISK CYLINDER ) 467 ; : RLHEAD 100 AND 100 / ; ( GET DISK HEAD ) 468 ; : RLSEC 77 AND ; ( GET DISK SECTOR ) 469 ; 470 014270 HEAD 205,RLCYL,314,RLCYL,DOCOL ; ***** RLCYL 471 ; CYL/HD/SEC -> CYLINDER 472 ; CONVERT CYL|HD|SEC TO DOUBLE, THEN DIVIDE BY 200 473 014302 002540' 000060' 000200 .WORD ZERO,LIT,200,USLAS 014310 001214' 474 014312 002056' 002034' .WORD SWAP,DROP ; DISCARD REMAINDER 475 014316 001446' .WORD SEMIS 476 ; 477 014320 HEAD 206,RLHEAD,240,RLHEAD,DOCOL ; ***** RLHEAD 478 ; CYL/HD/SEC -> HEAD 479 014334 000060' 000100 001302' .WORD LIT,100,AND,LIT,100,SLASH 014342 000060' 000100 010724' 480 014350 001446' .WORD SEMIS 481 ; 482 014352 HEAD 205,RLSEC,303,RLSEC,DOCOL ; ***** RLSEC 483 ; CYL/HD/SEC -> SECTOR 484 014364 000060' 000077 001302' .WORD LIT,77,AND 485 014372 001446' .WORD SEMIS 486 ; 487 014374 HEAD 205,RLCHS,323,RLCHS,DOCOL ; ***** RLCHS 488 ; CONVERT ABSOLUTE DISK BLOCK NUMBER TO RL02 CYLINDER|HEAD|SECTOR WORD. 489 ; 12 (OCTAL) SECTORS PER TRACK. 490 ; BLOCK# -> CYL|HD|SEC 491 014406 000060' 000012 010704' .WORD LIT,12,SLMOD ; STACK: SECTOR/4 CYL|HD 492 014414 000060' 000100 001132' .WORD LIT,100,USTAR,DROP ; STACK: SECTOR/4 CYL|HD*100 014422 002034' 493 014424 002056' 000060' 000004 .WORD SWAP,LIT,4,STAR,OR ; STACK: CYL|HD|SECTOR 014432 010664' 001322' 494 014436 001446' .WORD SEMIS 495 ; 496 ; 497 ; RLCS REGISTER: 498 ; 499 ; 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 500 ; +---+--+---+--+--+--+---+---+----+--+----+----+--+--+--+----+ 501 ; |ERR|DE|NXM|E2|E1|E0|DS1|DS0|CRDY|IE|BA17|BA16|F2|F1|F0|DRDY| 502 ; +---+--+---+--+--+--+---+---+----+--+----+----+--+--+--+----+ 503 ; \---------V-------/ \----------------V---------------/ \-V-/ 504 ; READ ONLY READ/WRITE READ 505 ; 506 ; ERR = ERROR; DETAILS IN E2|E1|E0 507 ; DE = DRIVE ERROR 508 ; NXM = NON-EXISTENT MEMORY 509 ; E2 = DATA LATE; E1 = DATA CRC ERROR; E0 = OPERATION INCOMPLETE F.I.G. MACRO V04.00 00:00:13 PAGE 10-9 510 ; CRDY = CONTROLLER READY (1 = READY FOR NEW COMMAND) 511 ; IE = INTERRUPT ENABLE 512 ; DS1|DS0 = DRIVE SELECT (DRIVE NUMBER 0 TO 3) 513 ; 514 ; F2|F1|F0 = FUNCTION: 515 ; 0 = NOP (RL11)/MAINT (RLV11) 4 = READ HEADER 516 ; 1 = WRITE CHECK 5 = WRITE DATA 517 ; 2 = GET STATUS 6 = READ DATA 518 ; 3 = SEEK 7 = READ WITHOUT HEADER CHECK 519 ; 520 ; 521 ; RLMP REGISTER AFTER GET STATUS COMMAND: 522 ; 523 ; 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 524 ; +---+---+--+----+---+---+--+---+--+--+--+--+--+---+---+---+ 525 ; |WDE|CHE|WL|SKTO|SPE|WGE|VC|DSE|DT|HS|CO|HO|BH|STC|STB|STA| 526 ; +---+---+--+----+---+---+--+---+--+--+--+--+--+---+---+---+ 527 ; 528 ; WDE = WRITE DATA ERROR 529 ; CHE = CURRENT HEADER ERROR 530 ; WL = WRITE LOCK (DRIVE IS WRITE PROTECTED) 531 ; SKTO = SEEK TIMEOUT 532 ; SPE = SPIN ERROR (SPINDLE SPEED NOT REACHED WITHIN TIME LIMIT) 533 ; WGE = WRITE GATE ERROR (DRIVE NOT READY OR WRITE PROTECTED, ETC.) 534 ; VC = VOLUME CHECK (CARTRIDGE IS MOUNTED AND SPUN UP (CLEARED BY 535 ; EXECUTION OF A GET STATUS COMMAND WITH BIT 3 SET) 536 ; DSE = DRIVE SELECT ERROR (MULTIPLE DRIVE SELECTION ERROR) 537 ; DT = DRIVE TYPE (0 = RL01; 1 = RL02) 538 ; HS = CURRENTLY SELECTED HEAD (0 = UPPER; 1 = LOWER) 539 ; CO = COVER OPEN 540 ; HO = HEADS OUT (HEADS ARE OVER THE DISK) 541 ; BH = BRUSH HOME (DISK BRUSHES ARE HOME) 542 ; 543 ; STC|STB|STA = STATE OF DRIVE: 544 ; 0 0 0 = LOAD CARTRIDGE 545 ; 0 0 1 = SPIN UP 546 ; 0 1 0 = BRUSH CYCLE 547 ; 0 1 1 = LOAD HEADS 548 ; 1 0 0 = SEEK 549 ; 1 0 1 = LOCK ON 550 ; 1 1 0 = UNLOAD HEADS 551 ; 1 1 1 = SPIN DOWN 552 ; 553 ; FIRST CALL RLSTAT TO MAKE SURE RL02 DRIVE IS READY, 554 ; THEN CALL RLPOS TO DETERIMINE CURRENT READ/WRITE HEAD POSITION. 555 ; 556 014440 HEAD 206,RLSTAT,240,RLST ; ***** RLSTAT 557 ; GET RL02 DISK STATUS; SEE RLMP REGISTER GET STATUS WORD ABOVE 558 ; -> RLSTATUS 559 014454 012700 174400 MOV #RLCS,R0 560 014460 012760 000013 000004 MOV #13,4(R0) ; RLDA SETUP FOR GET STATUS: 561 ; CLEAR ERROR REGISTER & GET STATUS 562 014466 012710 000004 MOV #4,(R0) ; RLCS GET STATUS FUNCTION CODE 563 014472 105710 TSTB (R0) ; RLCS TEST FOR READY STATE 564 014474 100376 BPL .-2 ; NOT READY YET--KEEP CHECKING 565 014476 016045 000006 MOV 6(R0),-(S) ; PUSH RLMP STATUS RESULT ONTO STACK 566 014502 NEXT F.I.G. MACRO V04.00 00:00:13 PAGE 10-10 567 ; 568 014506 HEAD 205,RLHDR,322,RLHDR ; ***** RLHDR 569 ; GET CURRENT CYLINDER|HEAD|SECTOR HEADER (POSITION) ON DISK 570 ; -> CYLINDER|HEAD|SECTOR 571 014520 012700 174400 MOV #RLCS,R0 572 014524 012710 000010 MOV #10,(R0) ; RLCS READ HEADER FUNCTION CODE 573 014530 105710 TSTB (R0) ; RLCS TEST FOR READY STATE 574 014532 100376 BPL .-2 ; NOT READY YET--KEEP CHECKING 575 014534 016045 000006 MOV 6(R0),-(S) ; PUSH CYLINDER|HEAD|SECTOR WORD ONTO STACK 576 014540 016001 000006 MOV 6(R0),R1 ; READ ZEROES WORD FROM SILO (DISCARDED) 577 014544 016001 000006 MOV 6(R0),R1 ; READ CRC WORD FROM SILO (DISCARDED) 578 014550 NEXT 579 ; 580 ; 581 ; RL02 SEEK OFFSET WORD: 582 ; 583 ; 15 7 6 5 4 3 2 1 0 584 ; +---------------------+---+---+------+---+-----------+---+---+ 585 ; | CYLINDER DIFFERENCE | 0 | 0 | HEAD | 0 | DIRECTION | 0 | 1 | 586 ; +---------------------+---+---+------+---+-----------+---+---+ 587 ; 588 ; 589 014554 HEAD 205,RLDIR,322,RLDIR,DOCOL ; ***** RLDIR 590 ; GET DIRECTION BIT FOR SEEK WORD FROM CYLDIFF SIGN BIT. 591 ; CYLDIFF -> ABS(CYLDIF) DIRECTION|1 592 ; DIRECTION BIT IS 4 OR 0 593 014566 002104' 000060' 100000 .WORD DUP,LIT,100000,AND ; STACK: CYLDIFF SIGN 014574 001302' 594 014576 000144' 000012 .WORD ZBRAN,RLN1-. 595 014602 010344' 002550' 000122' .WORD ABS,ONE,BRAN,RLN2-. ; STACK: ABS(CYLDIFF) DIR|1 014610 000006 596 014612 000060' 000005 RLN1: .WORD LIT,5 ; STACK: ABS(CYLDIFF) DIR|1 597 014616 001446' RLN2: .WORD SEMIS ; STACK: ABS(CYLDIFF) DIR|1 598 ; 599 014620 HEAD 206,RLDIFF,240,RLDIFF,DOCOL ; ***** RLDIFF 600 ; CALCULATE DIFFERENCE BETWEEN TWO CYL|HD|SEC WORDS, FOR SEEKING. 601 ; CHS0 CHS1 -> DIFFWORD 602 014634 002104' 003724' .WORD DUP,ROT ; STACK: CHS1 CHS1 CHS0 603 014640 014300' 002056' 014300' .WORD RLCYL,SWAP,RLCYL ; STACK: CHS1 CYL0 CYL1 604 014646 003524' .WORD SUB ; STACK: CHS1 CYL0-CYL1 605 014650 014564' .WORD RLDIR ; STACK: CHS1 ABS(CYLDIFF) DIR|1 606 014652 002056' 000060' 000100 .WORD SWAP,LIT,100,USTAR,DROP,OR ; STACK: CHS1 ABS(CYLDIF)|DIR|1 014660 001132' 002034' 001322' 607 014666 002056' 014332' 000060' .WORD SWAP,RLHEAD,LIT,20,STAR,OR ; STACK: ABS(CYLDIF)|HD|DIR|1 014674 000020 010664' 001322' 608 014702 001446' .WORD SEMIS 609 ; 610 014704 HEAD 206,RLSEEK,240,RLSEEK 611 ; SEEK CYLINDER, HEAD, SECTOR BY RELATIVE OFFSET 612 ; DIFFWORD -> RLCS 613 014720 012560 000004 MOV (S)+,4(R0) ; LOAD DIFFERENCE IN RLDA REGISTER 614 014724 012710 000006 MOV #000006,(R0) ; SEEK COMMAND 615 ; TSTB (R0) ; RLCS TEST FOR READY STATE 616 ; BPL .-2 ; LOOP BACK UNTIL READY 617 ; MOV (R0),-(S) ; PUSH SEEK RETURN STATUS ON STACK 618 014730 NEXT 619 ; F.I.G. MACRO V04.00 00:00:13 PAGE 10-11 620 ; RL02 SETUP OPERATION: 621 ; 622 ; RLHDR: 623 ; 1. ISSUE READ HEADER COMMAND AND WAIT FOR CRDY. 624 ; 2. CHECK ERROR FLAG. 625 ; 3. READ HEADER WORD FROM RLMP REGISTER. 626 ; RLDIFF: 627 ; 4. CALCULATE DIFFERENCE AND DIRECTION FOR SEEK. 628 ; RLSEEK: 629 ; 5. MOVE DIFFERENCE WORD TO RLDA REGISTER. 630 ; 6. ISSUE SEEK FUNCTION AND WATI FOR COMPLETION (DRIVE READY BIT). 631 ; 7. CHECK ERROR FLAG. 632 ; 633 014734 HEAD 206,RLSET,240,RLSET,DOCOL ; ***** RLSET 634 ; SEEK TO CORRECT CYLINDER AND HEAD BEFORE READING OR WRITING 635 ; BLOCK# -> CYLINDER|HEAD|SECTOR 636 014746 014404' .WORD RLCHS ; STACK: CYL|HD|SEC (I.E., CHSDEST) 637 014750 002104' .WORD DUP ; STACK: CHSDEST CHSDEST 638 014752 014516' .WORD RLHDR ; STACK: CHSDEST CHSDEST CHSORIGIN 639 014754 014632' .WORD RLDIFF ; STACK: CHSDEST 640 ; .WORD RLSEEK ; STACK: CHSDEST RLCSVALUE 641 014756 001446' .WORD SEMIS 642 ; 643 ; ( READ OR WRITE A 1024-BYTE DISK BLOCK ) 644 ; : R/W ( ADDR SCREEN# FLAG:0=WRITE,1=READ -> ) 645 ; SWAP 6 + ( STACK: ADDR FLAG BLOCK# ) 646 ; NSETUP ( STACK: ADDR FLAG CYL/HD/SEC ) 647 ; SWAP ( STACK: ADDR CYL/HD/SEC FLAG ) 648 ; 0= IF RLWR ELSE RLRD ENDIF ; ( STACK: -- ) 649 ; 650 014760 HEAD 203,R/W,327,RW,DOCOL ; ***** R/W 651 ; READ OR WRITE 1024-BYTE SCREEN. 652 ; ADDR BLOCK# FLAG(R=1,W=0) -> 653 ; CHANGE SCREEN# TO ABSOLUTE DISK BLOCK# 654 014770 002056' 000060' 000006 .WORD SWAP,LIT,6,PLUS ; STACK: ADDR FLAG BLOCK# 014776 001664' 655 015000 014744' 002056' .WORD RLSET,SWAP ; STACK: ADDR CYL/HD/SEC FLAG 656 015004 001446' .WORD SEMIS 657 ; 658 .IFF 659 ; 660 ; STANDALONE MODE IS USING RX01 FLOPPY DISK, NOT RL02. 661 ; 662 RXCS=177170 ; CONTROL AND STATUS REGISTER 663 RXDB=177172 ; DATA BUFFER REGISTER 664 ; 665 ; 666 HEAD 204,NRTS,240,NRTS ; ***** NRTS 667 ; ADDRN TRN SECN...ADDR1 TR1 SEC1 N -> FLAG 668 ; READ N SECTORS. USES R0, R1, R2 669 ; THIS OPERATION IS IN CODE TO KEEP UP WITH DISK TIMING FOR 670 ; STANDARD PDP-11 SECTOR SKEWING. 671 MOV (S)+,R1 ; # OF SECTORS TO READ 672 1$: MOV #10,R2 ; RETRY COUNT 673 21$: MOV #7,R0 ; 'READ' COMMAND 674 JSR PC,DRIV2 ; ADJUST R0 COMMAND 675 ; IF SECOND DRIVE F.I.G. MACRO V04.00 00:00:13 PAGE 10-12 676 MOV R0,@#RXCS ; READ COMMAND 677 2$: BIT #200,@#RXCS ; WAIT FOR TRANSFER FLAG 678 BEQ 2$ 679 MOV (S),@#RXDB ; SECTOR # 680 3$: BIT #200,@#RXCS ; WAIT FOR TRANSFER FLAG 681 BEQ 3$ 682 MOV 2(S),@#RXDB ; TRACK # 683 4$: BIT #40,@#RXCS ; WAIT FOR DONE FLAG 684 BEQ 4$ 685 ; CHECK FOR ERROR 686 TST @#RXCS 687 BLT 20$ ; ERROR 688 ; 689 MOV #3,@#RXCS ; 'EMPTY' COMMAND 690 ; EMPTY THE CONTROLLER'S BUFFER 691 MOV 4(S),R0 ; ADDRESS TO RECEIVE DATA 692 MOV #200,-(S) ; COUNT OF TIMES TO LOOP 693 6$: BIT #200,@#RXCS ; WAIT FOR TRANSFER FLAG 694 BEQ 6$ 695 MOVB @#RXDB,(R0)+ 696 DEC (S) ; DECREMENT THE COUNT 697 BNE 6$ 698 TST (S)+ ; POP THE COUNT 699 ; CHECK FOR ERROR 700 TST @#RXCS 701 BGE 7$ 702 20$: ; ERROR, SO RE-TRY 703 MOV #40000,@#RXCS ; CLEAR ERROR STATUS 704 22$: BIT #40,@#RXCS 705 BEQ 22$ 706 DEC R2 ; RE-TRY COUNT 707 BGT 21$ 708 MOV #-1,-(S) 709 NEXT ; ERROR EXIT 710 7$: ADD #6,S ; GOOD READ, SO POP THE 3 ARGS 711 DEC R1 712 BNE 1$ ; LOOP UNLESS ALL SECTORS READ 713 ; 714 CLR -(S) ; GOOD-READ INDICATOR 715 NEXT ; EXIT 716 ; 717 ; SUBROUTINE TO ADJUST COMMAND FOR SECOND DISK DRIVE 718 ; NOTE - 'NWTS' ALSO USES THIS SUBROUTINE. 719 ; NOTE USE OF R0, AND OF FORTH STACK. 720 DRIV2: CMP 2(S),#114 ; TRACK > 76 ? 721 BLE 10$ 722 SUB #115,2(S) ; SUBTRACT 77 723 BIS #20,R0 ; SET UNIT-SELECT BIT 724 10$: RTS PC 725 ; 726 HEAD 204,NWTS,240,NWTS ; ***** NWTS 727 ; ADDRN TRN SECN...ADDR1 TR1 SEC1 N -> FLAG 728 ; WRITE N SECTORS. USES R0, R1, R2. 729 MOV (S)+,R1 ; # OF SECTORS TO BE WRITTEN 730 1$: MOV #10,R2 ; RE-TRY COUNT 731 21$: MOV #1,@#RXCS ; 'FILL' COMMAND 732 2$: BIT #200,@#RXCS ; WAIT FOR TRANSFER FLAG F.I.G. MACRO V04.00 00:00:13 PAGE 10-13 733 BEQ 2$ 734 ; NOW FILL THE BUFFER 735 MOV 4(S),R0 736 MOV #200,-(S) ; COUNT 737 3$: BIT #200,@#RXCS ; WAIT FOR TRANSFER FLAG 738 BEQ 3$ 739 MOVB (R0)+,@#RXDB ; MOVE ONE BYTE 740 DEC (S) 741 BNE 3$ 742 TST (S)+ ; POP STACK 743 ; CHECK FOR ERROR 744 TST @#RXCS 745 BLT 20$ ; ERROR 746 ; 747 MOV #5,R0 ; 'WRITE' COMMAND 748 JSR PC,DRIV2 ; ADJUST IF SECOND DRIVE 749 MOV R0,@#RXCS ; 'WRITE' COMMAND 750 5$: BIT #200,@#RXCS ; WAIT FOR TRANSFER FLAG 751 BEQ 5$ 752 MOV (S),@#RXDB ; MOVE SECTOR # 753 6$: BIT #200,@#RXCS ; WAIT FOR TRANSFER FLAG 754 BEQ 6$ 755 MOV 2(S),@#RXDB ; MOVE TRACK # 756 7$: BIT #40,@#RXCS ; WAIT FOR DONE FLAG 757 BEQ 7$ 758 ; CHECK FOR ERROR 759 TST @#RXCS 760 BGE 10$ 761 20$: ; ERROR SO RE-TRY 762 MOV #40000,@#RXCS ; CLEAR ERROR STATUS 763 22$: BIT #40,@#RXCS 764 BEQ 22$ 765 DEC R2 ; RE-TRY COUNT 766 BGT 21$ 767 MOV #-1,-(S) ; ERROR INDICATOR 768 NEXT ; EXIT 769 10$: ADD #6,S ; GOOD WRITE, SO POP THE 3 ARGS 770 DEC R1 771 BNE 1$ ; LOOP UNLESS ALL SECTORS WRITTEN 772 ; 773 CLR -(S) ; GOOD-WRITE INDICATOR 774 NEXT 775 ; 776 HEAD 203,RTS,323,RTS,DOCOL ; ***** RTS 777 ; ADDR TR SEC -> 778 ; READ A SINGLE SECTOR. 779 .WORD ONE,NRTS,ZBRAN,1$-.,PDOTQ 780 .BYTE 26 781 .ASCII /DISK READ ERROR IN RTS/ 782 .EVEN 783 .WORD QUIT 784 1$: .WORD SEMIS 785 ; 786 HEAD 203,WTS,323,WTS,DOCOL ; ***** WTS 787 ; ADDR TR SEC -> 788 ; WRITE A SINGLE SECTOR. 789 .WORD ONE,NWTS,ZBRAN,1$-.,PDOTQ F.I.G. MACRO V04.00 00:00:13 PAGE 10-14 790 .BYTE 30 791 .ASCII /DISK WRITE ERROR IN WTS / 792 .EVEN 793 .WORD QUIT 794 1$: .WORD SEMIS 795 ; 796 ; 797 HEAD 205,SKEW1,261,SKEW1,DOCOL ; ***** SKEW1 798 ; SEQUENCE -> TRACK SECTOR 799 ; HANDLE THE SECTOR SKEWING. 800 ; NOTE - 'SEQUENCE #' IS ZERO-ORIGIN INDEX OF SECTOR (SKEWED). 801 ; NOTE - 'SKEW1' DOES SKEWING OF ONLY ONE DRIVE; 'SKEW' GENERALIZES 802 ; 'SKEW1' TO BOTH DRIVES. 803 .WORD DUP,LIT,32,SLASH,SWAP 804 .WORD OVER,LIT,6,STAR,OVER,DUP,PLUS,PLUS,SWAP 805 .WORD LIT,32,MOD,LIT,15,SLASH,PLUS 806 .WORD LIT,32,MOD,ONEP 807 .WORD SWAP,ONEP,SWAP,SEMIS 808 ; 809 HEAD 206,S-SKIP,240,SSKIP,DOVAR ; ***** S-SKIP 810 ; VARIABLE - NUMBER OF SECTORS SKIPPED AT BEGINNING OF DISK. 811 ; DEFAULT IS 56 DECIMAL (SKIP AN RT-11 DIRECTORY). ALSO, TRACK 812 ; ZERO IS SKIPPED, FOR COMPATIBILITY. 813 .WORD 56. 814 ; 815 HEAD 206,S-USED,240,SUSED,DOVAR ; ***** S-USED 816 ; VARIABLE - NUMBER OF SECTORS USED ON ON ONE DISK. 817 ; NORMALLY, S-USED + S-SKIP = 1976. (2002. - 26. OF TR 0). 818 .WORD 1920. 819 ; 820 HEAD 204,SKEW,240,SKEW,DOCOL ; ***** SKEW 821 ; SEQUENCE# -> TRACK SECTOR 822 .WORD DUP,ONEP,SUSED,AT,GREAT,ZBRAN,1$-. 823 .WORD SUSED,AT,SUB,SSKIP,AT,PLUS,SKEW1 824 .WORD SWAP,LIT,77.,PLUS,SWAP 825 .WORD BRAN,2$-. 826 1$: .WORD SSKIP,AT,PLUS,SKEW1 827 2$: .WORD SEMIS 828 ; 829 HEAD 206,NSETUP,240,NSET,DOCOL ; ***** NSETUP 830 ; ADDR SEQUENCE# N -> ADDRN TRN SECN...ADDR1 TR1 SEC1 831 ; THIS PREPARES A WHOLE SCREEN (IF N=8) FOR 'NRTS' OR 'NWTS'. 832 .WORD ROT,OVER,LIT,128.,STAR,PLUS,ROT,ROT 833 .WORD OVER,PLUS,ONE,SUB,SWAP,ONE,SUB,SWAP 834 .WORD XDO 835 2$: .WORD LIT,128.,SUB,DUP,I,SKEW,ROT 836 .WORD LIT,-1,XPLOO,2$-. 837 .WORD DROP,SEMIS 838 ; 839 HEAD 203,R/W,327,RW,DOCOL ; ***** R/W 840 ; READ OR WRITE 1024-BYTE SCREEN. 841 ; ADDR BLOCK# FLAG(R=1,W=0) -> 842 .WORD TOR,ONE,SUB,LIT,8.,STAR,FROMR 843 ; CHANGE THE SCREEN # TO FIRST SEQUENCE #. 844 ; IF READ, SETUP AND READ 8 SECTORS 845 .WORD ZBRAN,1$-.,LIT,8.,NSET,LIT,8.,NRTS 846 .WORD ZBRAN,2$-.,PDOTQ F.I.G. MACRO V04.00 00:00:13 PAGE 10-15 847 .BYTE 20 848 .ASCII /DISK READ ERROR / 849 .EVEN 850 .WORD QUIT 851 2$: .WORD BRAN,3$-. 852 ; SETUP AND WRITE 8 SECTORS 853 1$: .WORD LIT,8.,NSET,LIT,8.,NWTS 854 .WORD ZBRAN,4$-.,PDOTQ 855 .BYTE 20 856 .ASCII /DISK WRITE ERROR/ 857 .EVEN 858 .WORD QUIT 859 4$: 860 3$: .WORD SEMIS 861 ; 862 ; END STAND-ALONE RL02/RX01 DISK MODE 863 .ENDC 864 ; END STAND-ALONE SECTION 865 .ENDC 866 ; 867 ; *************** 868 ; 869 ; TRAP RECOVERY SECTION, RSX-11M 870 ; 871 ; *************** 872 ; 873 .IFNDF ALONE ; STAND-ALONE MUST HANDLE OWN INTERRUPTS. 874 HEAD 205,TRAPS,323,TRAPS,DOCOL ; ***** TRAPS 875 .WORD CR,PDOTQ 876 .BYTE 14 877 .ASCII /TRAP-ERROR, / 878 .EVEN 879 .WORD DOT,SWAP,UDOT,UDOT,QUIT 880 .ENDC 881 ; 882 .IFDF RSX11 883 TRAPV: .WORD TRAP0,TRAP1,TRAP2,TRAP3,TRAP4,TRAP5 884 TRAP0: CLR R1 ; TRAP # 0 885 BR TRAPZ 886 TRAP1: MOV #1,R1 ; TRAP # 1 887 ADD #6,SP ; DROP MMU INFO 888 BR TRAPZ 889 TRAP2: MOV #2,R1 890 BR TRAPZ 891 TRAP3: MOV #3,R1 892 BR TRAPZ 893 TRAP4: MOV #4,R1 894 BR TRAPZ 895 TRAP5: MOV #5,R1 896 BR TRAPZ 897 ; TO RETURN FROM TRAP HANDLER, SET UP STACK, ETC. FOR FORTH 'TRAPS' 898 ; DON'T USE RTT OR RTI. 899 TRAPZ: MOV (SP)+,-(S) ; PC 900 MOV (SP)+,-(S) ; PS 901 MOV R1,-(S) ; TRAP # 902 MOV #TRAPS+2,IP ; EXECUTE 'TRAPS' 903 NEXT F.I.G. MACRO V04.00 00:00:13 PAGE 10-16 904 ; 905 .ENDC 906 ; **************** 907 ; 908 ; TRAP RECOVERY SECTION, RT-11 909 ; 910 ; **************** 911 .IFDF RT11 912 TRAPZ: BCS 1$ 913 ; IF CARRY CLEAR, TRAP 4 914 MOV #4,R1 915 BR 2$ 916 1$: MOV #10,R1 917 2$: MOV (SP)+,-(S) ; PC 918 MOV (SP),-(S) ; PS 919 MOV R1,-(S) ; TRAP # 920 MOV #3$,-(SP) ; SO RTI WILL RESTORE PC TO '3$' 921 .TRPSET #TRAPBL,#TRAPZ ; RE-SET TRAPS 922 RTI 923 3$: MOV #TRAPS+2,IP ; EXECUTE 'TRAPS' 924 NEXT 925 .ENDC 926 ; 927 ; F.I.G. MACRO V04.00 00:00:13 PAGE 11 1 ; NOTE - '.W' ('DW') IS USED ONLY FOR TESTING - TO GET OCTAL OUTPUT 2 ; WHEN '.' IS NOT WORKING DURING SYSTEM DEVELOPMENT. 3 ; 4 ; 5 ; HEAD 202,.W,240,DW ; ***** .W 6 ; MOV (S),XOUT 7 ; ROL XOUT 8 ; ROL XOUT 9 ; MOV XOUT,IOCHR 10 ; ROR XOUT 11 ; BIC #177776,IOCHR 12 ; ADD #60,IOCHR 13 ; MOV IOCHR,-(S) 14 ; JSR R1,XCOUT 15 ; MOV #5,XCOUNT 16 ;XLP: ROL XOUT 17 ; ROL XOUT 18 ; ROL XOUT 19 ; ROL XOUT 20 ; MOV XOUT,IOCHR 21 ; ROR XOUT 22 ; BIC #177770,IOCHR 23 ; ADD #60,IOCHR 24 ; MOV IOCHR,-(S) 25 ; JSR R1,XCOUT 26 ; DEC XCOUNT 27 ; BNE XLP 28 ; MOV #40,IOCHR 29 ; MOV IOCHR,-(S) 30 ; JSR R1,XCOUT 31 ; NEXT 32 ;XOUT: .WORD 0 33 ;XCOUT: .WORD 0 34 ; 35 ; 36 ; 37 ; 38 ; 39 ; **************************************************************** 40 ; 41 ; THE FOLLOWING TWO DEFINITIONS ARE NOT PURE CODE, SO THEY WERE 42 ; MOVED HERE, NEAR THE END OF THE DICTIONARY. 43 ; 44 ; **************************************************************** 45 ; 46 015006 HEAD 305,<;CODE>,305,SEMIC,DOCOL ; ***** ;CODE 47 ; CREATE NEW DATA TYPE WITH CODE ROUTINE WRITTEN IN ASSEMBLY. 48 015020 004416' 004506' 004722' .WORD QCSP,COMP,PSCOD,LBRAC,SMUDG,SEMIS 015026 004534' 004600' 001446' 49 ; NOTE: LATER, THE ASSEMBLER WILL PATCH THIS DEFINITION. 50 ; 51 015034 HEAD 305,FORTH,310,FORTH,DODOE ; ***** FORTH 52 015046 007670' .WORD DOVOC 53 015050 120201 .WORD 120201 ; DUMMY HEADER AT INTERSECTION 54 015052 015056' .WORD TASK-10 55 015054 000000 XXVOC: .WORD 0 ; THE VOCABULARY LINK (FOR FUTURE USE) 56 015056 HEAD 204,TASK,240,TASK,DOCOL ; ***** TASK F.I.G. MACRO V04.00 00:00:13 PAGE 11-1 57 015070 001446' .WORD SEMIS 58 ; 59 ; 60 ; 61 ; F.I.G. MACRO V04.00 00:00:13 PAGE 12 1 ; **************************************************************** 2 ; 3 ; STACKS AND BUFFERS 4 ; 5 ; **************************************************************** 6 ; 7 ; NOTE - 'UP', 'OPENF', 'INTERM', AND DISK BUFFERS ARE 8 ; INITIALIZED AT COLD START, OR AT FIRST TIME THROUGH. 9 .EVEN 10 015072 XDP: ; DICTIONARY STARTS HERE 11 015072 .BLKB 16000. ; FOR DICTIONARY AND COMP. STACK 12 ; INCREASE THIS NUMBER TO USE A LARGER MEMORY SIZE. 13 054272 XS0: ; START OF COMPUTATION STACK 14 054272 .BLKW 2 ; IN CASE OF EMPTY STACK 15 ; 16 ; 17 ; 18 ; 19 ; 20 054276 DSKBUF: ; ROOM FOR 3 1K DISK BUFFERS 21 ; INITIALIZE BUFFERS' UPDATE BITS, AND TERMINATING NULLS, TO ZERO. 22 ; NOTE - THESE BUFFERS ARE CLEARED AT COLD START, ANYWAY, 23 ; BECAUSE A STAND-ALONE BOOT MAY NOT INITIALIZE HIGH MEMORY; 24 ; AND ALSO SO THAT THE NUMBER OR LOCATION OF BUFFERS CAN BE 25 ; CHANGED AT RUN TIME. 26 054276 .BLKW 1 27 054300 .BLKB 1024. 28 056300 .BLKW 1 29 056302 .BLKW 1 30 056304 .BLKB 1024. 31 060304 .BLKW 1 32 060306 .BLKW 1 33 060310 .BLKB 1024. 34 062310 .BLKW 1 35 062312 ENDBUF: ; CAUTION - 'ENDBUF' - 'DSKBUF' MUST BE EXACT MULTIPLE 36 ; OF THE BUFFER LENGTH PLUS 4. 37 ; 38 ; 39 ; 40 ; 41 ; 42 ; 'XTIB', 'XR0', AND 'XUP' ARE ONLY USED IN BOOT-UP TABLE; 43 ; THEREFORE THE AREAS DEFINED HERE CAN BE MOVED AT RUN TIME. 44 062312 XTIB: .BLKW 42. ; TERMINAL INPUT BUFFER 45 062436 .BLKW 50. ; FOR RETURN STACK 46 062602' XR0=. 47 062602 XUP: .BLKW 100 ; ROOM FOR 100 USER VARIABLES 48 ; 49 ; 50 .IFDF RT11 51 ; DISK HANDLER GOES HERE 52 HANDLR: .WORD .+2 53 .ENDC 54 ; 55 ; TERMINAL OUTPUT COLUMN COUNTER 56 ; 57 063002 OUTPOS: .BLKW 1 F.I.G. MACRO V04.00 00:00:13 PAGE 12-1 58 ; 59 ; 60 ; NOTE - CHANGE THE FOLLOWING LINE TO '.END' IF LINKING TO OTHER LANGUAGES. 61 000000' .END ORIGIN F.I.G. MACRO V04.00 00:00:13 PAGE 12-2 SYMBOL TABLE ABORT 010036R DODOE 005006R IN 003102R PK001 014104R SEMI 002404R ABS 010344R DOES 004772R INDEX 013530R PK002 014120R SEMIC 015016R AGAIN 012610R DOT 013354R INTER 007460R PK003 014124R SEMIS 001446R ALLOT 003470R DOTQ 005300R IP =%000004 PLINE 011672R SIGN 013116R ALONE = 000001 DOTR 013314R KEY 001030R PLMNS 003542R SLASH 010724R AND 001302R DOUSE 002524R LATES 004102R PLOOP 012516R SLMOD 010704R ARROW 012134R DOVAR 002500R LBRAC 004534R PLUS 001664R SMUDG 004600R AT 002226R DOVOC 007670R LEAVE 001466R PNUMB 006232R SPACE 003762R BACK 012324R DP 003006R LESS 003642R PORIG 002662R SPACS 013006R BASE 003230R DPL 003242R LFA 004122R PQTER 014174R SPAT 001366R BBUF 002630R DPLMNS 003564R LIMIT 003056R PREV 003340R SPSTO 001406R BCOMP 007172R DPLUS 001702R LINK = 015056R PSCOD 004722R SSLA 011006R BDIGS 013044R DRONE 011366R LINK2 = 015056R PSPOUT 014156R SSMOD 010764R BEGIN 012346R DROP 002034R LIST 013426R PSTOR 002122R STAR 010664R BL 002602R DRZER 011346R LIT 000060R QALIG 005366R STATE 003214R BLANK 006014R DSKBUF 054276R LITER 007226R QCOMP 004312R STOD 010316R BLK 003070R DTRAI 005160R LOAD 012052R QCSP 004416R STORE 002272R BLOCK 011524R DUP 002104R LOOP 012466R QERR 004260R SUB 003524R BRAN 000122R ECELL 005130R MAX 010446R QEXEC 004342R SWAP 002056R BSCR 002644R EDIGS 013064R MESS 011760R QLOAD 004454R SZERO 002702R BUFFE 011414R ELSE 012722R MIN 010416R QPAIR 004372R TASK 015066R BUILD 004752R EMIT 001020R MINUS 001742R QSTAC 007400R THEN 012424R BYE 014264R ENCL 000676R MLOOP 000566R QTERM 001046R THREE 002570R CAT 002246R ENC1 000712R MOD 010744R QUERY 005606R TIB 002726R CENT 010132R ENC2 000726R MSLAS 010562R QUEST 013370R TICK 012174R CFA 004142R ENC3 000744R MSMOD 011030R QUIT 007760R TOGGL 002154R CL 002614R ENC4 000772R MSTAR 010476R R 001540R TOR 001506R CMOVE 001070R END 012572R MTBUF 011216R RBRAC 004552R TRAV 004034R COLD 010130R ENDBUF 062312R NFA 004160R RBUF = 177562 TRIAD 013610R COLON 002344R ENDIF 012370R NOFAST 000560R RCSR = 177560 TWO 002560R COMMA 003504R EQUAL 003612R NOFST1 000604R REPEAT 012640R TWOM 003426R COMP 004506R ERASE 005772R NOT 010112R RLBA = 174402 TWOP 003370R CON 002436R ERROR 006670R NULL 005636R RLCHS 014404R TYPE 005054R CONT 003162R EXEC 000102R NUMB 006346R RLCS = 174400 U =%000003 COUNT 005030R EXPEC 005414R OCTAL 004674R RLCYL 014300R UDIV 001226R CR 001056R FAILED 000646R OFSET 003144R RLDA = 174404 UDOT 013406R CREAT 007040R FAST 000532R ONE 002550R RLDIFF 014632R ULESS 007314R CSP 003266R FCOMP 000532R ONEM 003410R RLDIR 014564R UMULT 001144R CSTOR 002320R FENCE 002774R ONEP 003352R RLHDR 014516R UNTIL 012546R CURR 003200R FILL 005732R OR 001322R RLHEAD 014332R UPDAT 011150R DABS 010372R FIRST 003042R ORIGIN 000000R RLMP = 174406 UPPER 006556R DDOT 013336R FLD 003254R OUT 003114R RLN1 014612R USE 003324R DDOTR 013250R FLUSH 011250R OUTPOS 063002R RLN2 014616R USER 002516R DDUP 004004R FORGE 012226R OVER 002012R RLSEC 014362R USLAS 001214R DEC 004650R FORTH 015044R PABOR 006652R RLSEEK 014716R USTAR 001132R DEFIN 007716R FROMR 001524R PAD 006064R RLSET 014744R VAR 002472R DFIND 006476R GFORTH 000000RG PAREN 007736R RLST 014452R VLIST 013700R DIG 013144R GO 010266R PBKOUT 014142R RL02 = 000001 VOCAB 007630R DIGIT 000400R GREAT 003672R PBKRET 014172R RNUM 003300R VOCL 003026R DIGS 013220R HERE 003450R PBKSP 014130R ROT 003724R W =%000002 DLESS 007350R HEX 004622R PBUF 011066R RP =%000006 WARN 002760R DLINE 011734R HLD 003312R PCR 014222R RPSTO 001426R WENT 010222R DLITE 007264R HOLD 006034R PDOTQ 005244R RW 014766R WHILE 012764R DMINU 001764R I 000360R PEMIT 014004R RZERO 002714R WIDTH 002742R DO 012440R IDDOT 006750R PFA 004206R S =%000005 WORD 006110R DOCOL 002370R IF 012672R PFIND 000506R SCR 003126R W2 010226R DOCON 002450R IMMED 007576R PKEY 014040R SCSP 004234R XBUF = 177566 F.I.G. MACRO V04.00 00:00:13 PAGE 12-3 SYMBOL TABLE XCSR = 177564 XXE3 006544R XXJ4 005720R XXRB 010406R XXWA 005226R XDO 000334R XXE4 007462R XXK1 005426R XXR1 013136R XXW3 012020R XDP 015072R XXE5 007512R XXK2 005506R XXR2 013200R XXW4 012040R XLOOP 000202R XXE6 007516R XXK3 005564R XXR3 013222R XXW5 012024R XMATCH 000544R XXE7 007556R XXK4 005536R XXR4 013034R XXW6 005170R XOR 001340R XXFA 006464R XXK5 005540R XXR5 010360R XXW7 005222R XPLOO 000250R XXF3 006234R XXL1 005074R XXR6 010464R XXZ1 013466R XR0 = 062602R XXF4 007550R XXL2 005112R XXR7 010434R XXZ2 013542R XS0 054272R XXF5 007554R XXL3 005114R XXTA 011264R XXZ3 013572R XTIB 062312R XXF6 006404R XXL6 005342R XXT1 011124R XXZ4 013642R XUP 062602R XXF7 006452R XXL7 005352R XXT2 011426R XXZ5 013720R XXB1 007772R XXG4 006330R XXN1 004040R XXT3 011474R XXZ6 013746R XXB2 010022R XXG5 006322R XXN2 004276R XXT4 011650R ZBRAN 000144R XXD2 007066R XXI1 006134R XXN3 004300R XXT5 011564R ZEQU 001556R XXD6 007246R XXI2 006140R XXN4 006706R XXT6 011616R ZERO 002540R XXEA 007524R XXJ1 005710R XXN5 007304R XXT7 011320R ZGT 001636R XXE1 006632R XXJ2 005714R XXRA 013026R XXVOC 015054R ZLESS 001606R XXE2 006570R . ABS. 000000 000 063004 001 ERRORS DETECTED: 0 VIRTUAL MEMORY USED: 8448 WORDS ( 33 PAGES) DYNAMIC MEMORY AVAILABLE FOR 67 PAGES DK:FORTH,DK:FORTH.LST[400]=DK:FORTH.MAC