.TITLE FORTH ; ; *************************************************************** ; ; FORTH-83 ; ; *************************************************************** ; ; ; ; M. P. HANSON ; DEPARTMENT OF CHEMISTRY ; ; AND ; ; R. J. WILSON ; COMPUTING SERVICES ; ; HUMBOLDT STATE UNIVERSITY ; ARCATA, CALIFORNIA 95521 ; USA ; ; ; ; THIS PROGRAM IS THOUGHT TO MEET THE 1983 STANDARD OF THE FORTH ; LANGUAGE BUT NO GUARANTEE IS MADE OR IMPLIED TO THAT FACT. ; ; THIS PROGRAM IS A REVISION OF A PUBLIC DOMAIN VERSION DUE TO ; JAMES. CHANGES TO JAMES' VERSION HAVE BEEN COMMENTED OUT ; WITH ; MPH. ANY ADDITIONS ARE PRECEEDED ; WITH ; MPH DATE VVVVVVVVVV AND FOLLOWED WITH ; ; MPH DATE ^^^^^^^^^^. ; ; MANY OF THE CHANGES TO JAMES' VERSION ARE CODE IMPLEMENTATIONS ; FROM A HIGHER LEVEL PROGRAM BY VERNOR VINGE OF THE DEPARTMENT OF ; MATH SCIENCES, SAN DIEGO STATE UNIVERSITY, SAN DIEGO, CALIFORNIA ; USA ; .PAGE ; **************************************************************** ; ; PDP-11 FORTH INTRODUCTION PDP-11 FORTH ; ; **************************************************************** ; ; ; ; PDP-11 FORTH RT-11, RSX-11M, AND STAND-ALONE JANUARY 1980 ; ; ; ; DEVELOPED BY THE ; FORTH INTEREST GROUP / FORTH IMPLEMENTATION TEAM ; P.O. BOX 1105 ; SAN CARLOS, CA. 94070 ; ; ; IMPLEMENTED BY ; JOHN S. JAMES ; P.O. BOX 348 ; BERKELEY, CA. 94701 ; ; ; THIS SYSTEM IS IN THE PUBLIC DOMAIN AND CAN BE USED ; WITHOUT RESTRICTION. PLEASE CREDIT THE FORTH INTEREST ; GROUP IF YOU REPUBLISH SUBSTANTIAL PORTIONS. ; ; ; THE FORTH INTEREST GROUP / FORTH IMPLEMENTATION TEAM ; ALSO HAS DEVELOPED NEARLY IDENTICAL VERSIONS OF THIS ; SYSTEM FOR THE ; 8080 ; 6800 ; 6502 ; 9900 ; PACE ; ; ; FOR MORE INFORMATION, WRITE: ; ; JOHN S. JAMES ; P.O. BOX 348 ; BERKELEY, CA. 94701 ; ; OR ; ; FORTH INTEREST GROUP ; P.O. BOX 1105 ; SAN CARLOS, CA. 94070 ; ; ; 'PDP' AND 'RSX' ARE TRADEMARKS OF DIGITAL EQUIPMENT CORPORATION. .PAGE ; THIS FORTH SYSTEM HAS ; - FULL LENGTH NAMES ; - EXTENSIVE COMPILE-TIME CHECKS AND ERROR MESSAGES ; - DOUBLE INTEGER I/O ; - A FORTH ASSEMBLER, PERMITTING STRUCTURED, INTERACTIVE ; DEVELOPMENT OF DEVICE HANDLERS, SPEED-CRITICAL ; ROUTINES, AND LINKAGE TO OPERATING SYSTEMS OR TO ; SUBROUTINE PACKAGES WRITTEN IN OTHER LANGUAGES. ; - STRING-HANDLING ROUTINES ; - A STRING-SEARCH EDITOR ; - LINKED VOCABULARIES ; - HOOKS FOR MULTITASKING/MULTIUSER (CURRENTLY SINGLE TASK) ; - AND AS CURRENTLY CONFIGURED IT RUNS IN A 24K BYTE ; TASK IMAGE (THIS INCLUDES BUFFERS, OPERATING-SYSTEM ; AREA, AND ROOM FOR SUBSTANTIAL ADDITIONAL FORTH ; PROGRAMMING) ON ANY PDP-11 OR LSI-11 CPU, WITH OR ; WITHOUT HARDWARE MULTIPLY/DIVIDE. THIS DISKETTE ; WILL BOOT AND RUN STAND-ALONE; ALSO IT CONTAINS A ; SOURCE PROGRAM WHICH CAN BE ASSEMBLED TO RUN ; UNDER RT-11, RSX-11M, OR STAND-ALONE. THIS SYSTEM ; CAN BE MODIFIED TO INTERFACE WITH ANY OTHER OPERATING ; SYSTEM WHICH SUPPORTS READ AND WRITE A CHARACTER, ; DETECT A CHARACTER (OPTIONAL), AND READ AND WRITE ; A DISK BLOCK. ; ; ; ; ; RECOMMENDED DOCUMENTATION: ; MPH 11/85 VVVVVVVVVV ; - A FORTH LANGUAGE MANUAL. WE PARTICULARLY RECOMMEND EITHER ; 'STARTING FORTH' BY LEO BRODIE ( PRENTICE-HALL ) ; AND ; 'INSIDE F83', BY TING ; ; EITHER IS AVAILABLE THROUGH ; MOUNTAIN VIEW PRESS ; MOUNTAIN VIEW, CA 94040 ; MPH 11/85 ^^^^^^^^^^ ; ; ; ; ACKNOWLEDGMENTS: ; THIS FORTH SYSTEM (IN 'FORTH.MAC') IS A GROUP PRODUCT ; OF THE FORTH IMPLEMENTATION TEAM OF THE FORTH INTEREST ; GROUP (P.O. BOX 1105, SAN CARLOS CA. 94070). THE IMPLEMENTER ; IS RESPONSIBLE FOR THIS PDP-11 VERSION OF THE MODEL, AND FOR ; THE SOFTWARE ON SCREENS IN 'FORTH.DAT'. ALTHOUGH THE LATTER ; IS NOT AN OFFICIAL RELEASE OF THE F.I.G., THE CONTRIBUTIONS ; FROM MEMBERS OF THE GROUP ARE TOO NUMEROUS TO CITE ; INDIVIDUALLY. ; IN ADDITION WE APPRECIATE THE PDP-11 CODING ; IMPROVEMENTS SUGGESTED BY STUART R. DOLE, DOLE & FARMER, ; PO BOX 142, PETALUMA, CA. 94952; BY PAUL EDELSTEIN; ; BY RICK STEVENS OF KITT PEAK; AND OTHERS. .PAGE ; **************************************************************** ; ; BRINGING UP THE SYSTEM ; ; **************************************************************** ; ; ; ; TO RUN IN A MULTIUSER SYSTEM (RSTS OR RSX) ; - USING AN EDITOR SEARCH FOR THE STRING 'INITIALIZATION' ; AND FOLLOW THE DIRECTIONS GIVEN IN THE LINES WHICH ; FOLLOW. IN GENERAL THIS INVOLVES REPLACEMENT OF ; ASCII STRINGS TO CUSTOMIZE THE SYSTEM FOR YOUR ; INSTALLATION. ; - MAKE SURE THE FILE TEACHER.DAT EXISTS ON THE DEVICE SPECIFIED ; IN THE INITIALIZATION. THE FILE STUDENT.DAT SHOULD EXIST ; AND RESIDE IN EVERY STUDENT'S ACCOUNT ON THE DEFAULT DEVICE. ; ; TO RUN STAND-ALONE: ; - BOOT THE DISKETTE LIKE ANY OTHER SYSTEM DISK, FROM DX0. ; FORTH SHOULD COME UP AND TYPE 'FIG FORTH' AND THE VERSION ; NUMBER. TEST AS DESCRIBED FOR RT-11 BELOW. ; - MAKE A COPY OF THE DISK; THIS STAND-ALONE SYSTEM DOES NOT ; PROTECT AGAINST ACCIDENTALLY OVERWRITING THE SYSTEM OR THE ; SOURCE PROGRAMS. TO MAKE AN EXACT COPY OF THE ENTIRE DISK, ; 1. PUT A BLANK DISK INTO THE SECOND DRIVE (DX1). FOR ; SAFETY, SET THE WRITE-PROTECT SWITCH ON THE DRIVE ; WHICH CONTAINS THE ORIGINAL SYSTEM DISK. ; 2. TYPE '38 LOAD', AND CARRIAGE RETURN. THE SYSTEM SHOULD ; RESPOND 'OK'. THEN TYPE 'COPY' AND RETURN. EACH OF ; THE 77 TRACKS WILL BE READ FROM DX0 AND WRITTEN ON DX1. ; - NOTE THE LAYOUT OF THE DISKETTE. IT IS SET UP TO BOOT AND ; RUN STAND-ALONE, BUT IT ALSO CONTAINS AN RT-11 DIRECTORY, ; AND A MACRO-11 SOURCE PROGRAM 'FORTH.MAC' (WHICH PRODUCED ; THIS LISTING). THIS ALLOWS THE SAME DISK TO BE BOOTED ; AND RUN, OR TO PROVIDE SOURCE FOR MODIFICATION AND RE-ASSEMBLY. ; AS PROVIDED, THE FILE 'FORTH.DAT' CONTAINS FORTH SCREENS ; 1-70. YOU CAN USE LOCATIONS BEYOND 70, BUT THESE WILL ; OVERWRITE THE 'FORTH.MAC' SOURCE PROGRAM. STAND-ALONE USERS ; MAY NEVER NEED TO USE THIS SOURCE, AND MAY WANT TO REMOVE IT ; AND USE THE SPACE FOR SOMETHING ELSE. MAKE A COPY FIRST. ; - STAND-ALONE USERS CAN ADD THEIR OWN OPERATIONS AND THEN ; SAVE A BOOTABLE IMAGE OF THE NEW SYSTEM. THE NEW OPERATIONS ; WILL BE AVAILABLE WHEN THE DISK IS BOOTED IN THE FUTURE. ; THE LOADER WHICH IS USED WILL ONLY LOAD IMAGES UP TO 7.9K; ; THIS LEAVES SEVERAL HUNDRED BYTES FOR NEW OPERATIONS, WHICH ; CAN INCLUDE EXTENDING THE SYSTEM BY BRINGING IN SOURCE OR ; OBJECT CODE. TO SAVE THE CURRENT SYSTEM, EXECUTE 'FORTH DEFINITIONS' ; IF NECESSARY TO GET INTO THE FORTH VOCABULARY, THEN 'DECIMAL 34 LOAD'. ; SOME WARNING MESSAGES WILL BE PRINTED (MSG #4); THEY CAN BE ; IGNORED. ; - IF YOU DO WANT TO RE-ASSEMBLE THE SYSTEM FOR STAND-ALONE ; USE (WHICH MOST USERS SHOULD NEVER FIND NECESSARY), ; YOU MUST USE RT-11 TO EDIT AND ASSEMBLE 'FORTH.MAC'. NOTE ; THAT ALTHOUGH THIS LISTING IS ASSEMBLED FOR STAND-ALONE, ; THE SOURCE PROGRAM SUPPLIED IS SET FOR RT-11 ASSEMBLY; ; COMMENT OUT THE 'RT11' DEFINITION, AND REMOVE THE COMMENTING ; ON 'ALONE'. ASSEMBLE, LINK, AND RUN, AND THE SYSTEM SHOULD ; COME UP STAND-ALONE. IMMEDIATELY REMOVE THE RT-11 SYSTEM DISK ; AND PLACE THE FORTH DISK IN DRIVE ZERO. TO REVISE ; THE BOOTABLE IMAGE ON THE FORTH DISK SO THAT YOUR NEW SYSTEM ; BOOTS STAND-ALONE, LIST SCREEN 34 (DECIMAL), AND FOLLOW THE ; INSTRUCTIONS THERE. THE RUN TAKES ABOUT ONE MINUTE. ; - THE BOOTABLE SYSTEM DOES NOT USE HARDWARE MULTIPLY AND DIVIDE. ; IF YOU DON'T HAVE RT-11 TO EDIT AND RECOMPILE WITH 'EIS' ; CONDITIONAL ASSEMBLY, THE MULTIPLY/DIVIDE ROUTINES CAN BE ; PATCHED. IF YOU PATCH FROM THE KEYBOARD MONITOR, THE ; RESTART ADDRESS IS 1000 OCTAL ( COLD START) OR 1004 (WARM ; START). SAVE THE NEW VERSION AS A BOOTABLE SYSTEM, AS ; DESCRIBED ABOVE. ; - THE SKEWED DISK I/O OPERATIONS SKIP TRACK ZERO, FOR COMPATIBILITY ; WITH STANDARD PDP-11 SECTOR SKEWING. THE PHYSICAL READ ; OPERATIONS ('RTS', 'WTS', 'NRTS', 'NWTS') CAN READ ANY SECTOR, ; HOWEVER. ; - ALSO THE SYSTEM AS DISTRIBUTED SKIPS THE FIRST 56 SECTORS ; (7 SCREENS) IN ORDER TO SKIP THE BOOT BLOCK AND AN ; RT-11 DIRECTORY. THIS CAUSES THE SCREEN POSITIONS TO BE THE ; SAME FOR STAND-ALONE AND FOR RT-11 (WHICH ACCESSES THE FILE ; 'FORTH.DAT'). YOU CAN CHANGE THIS BY CHANGING THE VALUE OF ; THE VARIABLES 'S-SKIP' (NUMBER OF SCREENS SKIPPED) AND ; 'S-USE' (NUMBER OF SCREENS USED BEFORE ACCESSING THE ; SECOND DISK). THESE VARIABLES CAN BE CHANGED AT ANY TIME, ; SO DISK SCREENS CAN BE READ INTO BUFFERS AND THEN FLUSHED ; TO DIFFERENT LOCATIONS ON THE DISK. ; - ADVANCED USERS MAY NOTE THAT THIS SYSTEM IS DESIGNED TO ; ALLOW THE MEMORY LAYOUT - NUMBER AND LOCATION OF DISK ; BUFFERS, LOCATION OF THE STACK, ETC. - TO BE CHANGED ; DYNAMICALLY, WITHOUT REASSEMBLY. ; ; ; TO BRING UP THIS SYSTEM UNDER RT-11: ; - BE SURE THAT RT-11 IS SELECTED BELOW. THE LINES DEFINING ; 'RSX11M' AND 'ALONE' SHOULD BE COMMENTED OUT; 'RT11' SHOULD ; NOT BE. NOTE THAT THIS DISK IS DISTRIBUTED READY FOR RT-11 ; ASSEMBLY (EVEN THOUGH THIS LISTING IS FOR STAND-ALONE). ; - IF YOU HAVE HARDWARE MULTIPLY/DIVIDE, ALSO REMOVE THE ; SEMICOLON FROM THE LINE DEFINING 'EIS'. ; - IF YOU ARE USING AN OLDER VERSION OF RT-11 (VERSION 2), ; YOU MAY NEED TO USE THE MACROS '..V2..' AND '.REGDEF'. ; - ASSEMBLE, LINK, AND RUN. THE SYSTEM SHOULD COME UP AND ; TYPE 'FIG-FORTH' AND THE VERSION NUMBER. ; - TEST THAT IT IS UP BY TRYING SOME ARITHMETIC OR DEFINITIONS, E.G. ; 88 88 * . (NOTE THAT THE '.' MEANS PRINT) ; : SQUARE DUP * ; ; 25 SQUARE . ; OR TYPE 'VLIST' FOR A LIST OF ALL THE FORTH OPERATIONS IN THE ; DICTIONARY. ; - THE DISK SHOULD WORK IF THE DISKETTE IS IN DRIVE 'DK'. ; MAKE SURE THAT 'DK' IS ASSIGNED TO WHATEVER PHYSICAL ; DRIVE YOU ARE USING - OR CHANGE LINE 'RTFILE:' IN ; 'FORTH.MAC'. TEST THE DISK BY TYPING ; 1 LIST ; WHICH SHOULD LIST THE SCREEN WHICH LOADS THE EDITOR, ; ASSEMBLER, AND STRING ROUTINES. ; - IN CASE YOU NEED TO GET A LISTING FROM THE ASSEMBLY OF ; 'FORTH.MAC' (NOT USUALLY NECESSARY), AND YOUR SYSTEM HAS ; ONLY DISKETTES (NO LARGER DISKS), THE 'ALLOCATE' OPTION ; IS NECESSARY BECAUSE OF THE SIZE OF THE '.LST' FILE ; (AROUND 230 BLOCKS). FIRST COPY 'FORTH.MAC' ONTO A ; SEPARATE DISKETTE BY ITSELF. THEN EXECUTE ; .MACRO /LIST:FORTH.LST /ALLOCATE:300. /NOOBJECT ; AND REPLY 'FORTH.MAC' WHEN ASKED FOR 'FILES?'. ; ; ; ; TO BRING UP THE SYSTEM UNDER RSX-11M: ; - THE DISKETTE PROVIDED IS IN RT-11 FILE FORMAT. THE TWO FILES ; MUST BE COPIED OFF THE DISKETTE INTO AN RSX DIRECTORY. THE ; 'FORTH.DAT' FILE MUST BE COPIED IN IMAGE MODE. ANY RSX ; DIRECTORY MAY BE USED. ASSUMING THE DISKETTE IS IN DRIVE 0, ; USE THE RSX COMMANDS: ; >FLX =DX:FORTH.MAC/RT ; >FLX =DX:FORTH.DAT/RT/IM ; INCIDENTALLY, 'FORTH.DAT' IS THE SYSTEM'S 'VIRTUAL MEMORY' ; FILE, USED FOR DISK I/O. THE REST OF THE SYSTEM (THIS ; PROGRAM ALONE) CAN RUN INDEPENDENTLY, EVEN IF 'FORTH.DAT' ; IS NOT AVAILABLE. ; - EDIT 'FORTH.MAC' TO SELECT RSX ASSEMBLY. CHANGE THE SEMICOLON ; TO COMMENT OUT 'RT11' NOT 'RSX11'. LET 'EIS' BE DEFINED IF ; YOU HAVE HARDWARE MULTIPLY/DIVIDE. ; - ASSEMBLE, TASK BUILD, AND RUN. TEST AS WITH RT11 ABOVE. ; - THE DISK I/O SHOULD WORK IF 'FORTH.DAT' IS IN THE DEFAULT ; DEVICE AND DIRECTORY. TEST AS ABOVE. ; ; ; ; THE SYSTEM AS SUPPLIED RESERVES 8000. BYTES FOR YOUR FORTH ; PROGRAMMING AND STACK. THIS IS ENOUGH FOR SUBSTANTIAL PROJECTS. ; (NOTE THAT THE EDITOR, ASSEMBLER, AND STRING PACKAGE, IF LOADED, ; USE MORE THAN 5K OF THIS.) TO CHANGE THIS MEMORY SIZE, CHANGE ; THE '8000.' WHICH IS IN THE LINES FOLLOWING THE LABEL 'DP:', ; NEAR THE END OF THIS PROGRAM. INCIDENTALLY, VERY FEW JOBS ; (E.G. RECURSION) WILL EVER USE MORE THAN 100 WORDS OF THIS SPACE ; FOR THE STACK; THE REST OF THE SPACE IS AVAILABLE FOR A STRING ; STACK (IF USED) OR FOR YOUR PROGRAMS - AND FORTH OBJECT CODE IS ; CONSIDERABLY MORE COMPACT THAN ASSEMBLY. ; ; ; ; THE FORTH VIRTUAL FILE 'FORTH.DAT' IS USED FOR STORING SOURCE ; PROGRAMS (OR DATA). THIS FILE HAS 70 1-K SCREENS (1-70), ; I.E. 140 PDP-11 DISK BLOCKS. SCREENS 4 AND 5 ARE USED BY THE ; SYSTEM FOR STORING ERROR AND WARNING MESSAGES. SCREENS 6-30 ; CONTAIN A TEXT EDITOR, ASSEMBLER, STRING PACKAGE, AND MISCELLANEOUS ; EXAMPLES. SCREENS 40 THROUGH 47 CONTAIN A BINARY STAND-ALONE ; SYSTEM (NOT USED UNDER RT-11 OR RSX-11M). USERS MAY WANT ; TO SAVE THEIR SOURCE PROGRAMS AND DATA IN THE BLANK SCREENS. ; THE SIZE OF THIS FORTH SCREENS FILE ('FORTH.DAT') CAN BE INCREASED ; IF NEEDED. IF THE SYSTEM IS TO BE BOOTED STAND-ALONE, THE LOCATION ; OF THE SYSTEM BINARY IMAGE ON THE DISK MUST NOT BE CHANGED; ; THEREFORE, IF THE DISK IS TO BE USED TO RUN STAND-ALONE, DO NOT ; USE RT-11 TO MOVE 'FORTH.DAT' TO ANOTHER PLACE ON THE DISK. ; ; ; ; ; ; NOTE THAT THE RT-11 AND RSX-11M SYSTEMS DO NOT ECHO CHARACTERS ; WHICH ARE INPUT FROM THE TERMINAL. INSTEAD, THEY LET THE OPERATING ; SYSTEM (RT-11 OR RSX-11M) ECHO THEM. THIS IS DONE SO THAT TYPING ; CONVENTIONS WILL BE THE SAME AS THE USER IS FAMILIAR WITH. ALSO, ; TO AVOID SWAPPING DELAYS, THE RSX VERSION OF 'KEY' READS A LINE OF ; CHARACTERS AT A TIME. ; ; MPH 8/85 VVVVVVVVVV ; NOTE HOWEVER THE PRECEEDING PARAGRAPH IS NOT TRUE IF LOADED=0 (SEE ; BELOW). ; MPH 8/85 ^^^^^^^^^^ ; ; ; ; CHANGE THESE LINES TO CONTROL CONDITIONAL ASSEMBLY: ; ;RT11=1 ; COMMENTED OUT UNLESS RT-11 RSX11=1 ; COMMENTED OUT UNLESS RSX11M ; MPH 8/85 VVVVVVVVVV EMUL =1 ; COMMENTED OUT UNLESS RSX EMULATION WITH RSTS ;LOADED=1 ; SINGLE CHARACTER INPUT PLACES A HEAVY LOAD ; ON THE PROCESSOR IN A TIME SHARING SYSTEM ; AND CAN DEGRADE PERFORMANCE. SETTING LOADED ; MAKES KEY READ ONE LINE AT A TIME. THIS IS TRUE ; FOR BOTH RSX AND RT-11. COMMENT THIS LINE OUT ; TO MEET THE STANDARD. ; MPH 8/85 ^^^^^^^^^^ ;ALONE=1 ; COMMENTED OUT UNLESS STAND-ALONE EIS=1 ; COMMENTED OUT UNLESS HARDWARE MULTIPLY-DIVIDE ;LINKS=1 ; COMMENTED OUT UNLESS SUBROUTINE LINKAGE FROM ; FORTH TO OTHER LANGUAGES ; .PAGE ; **************************************************************** ; ; VARIATIONS FROM F.I.G. MODEL ; ; **************************************************************** ; ; ; 'FIRST' AND 'LIMIT' HAVE BEEN MADE USER VARIABLES, NOT CONSTANTS. ; THEREFORE WHEN THEY ARE USED, 'FIRST @' AND 'LIMIT @' ARE ; REQUIRED. ; ; ';CODE' AND 'FORTH' ARE NOT PURE CODE, SO THEY WERE MOVED TO THE ; END OF THE DICTIONARY. THIS IS SO THE BULK OF THE DICTIONARY ; COULD BE PUT IN PROM OR USED RE-ENTRANTLY. ; ; THE MACHINE-INDEPENDENT I/O SECTION WAS MOVED TO NEAR THE END OF ; THE DICTIONARY, BECAUSE IT IS NOT ALWAYS PURE CODE, AND ALSO TO ; ALLOW THE I/O TO BE REDEFINED WITHOUT REASSEMBLY. ; ; THIS SYSTEM MUST TEST FOR FIRST-TIME-THROUGH TERMINAL AND DISK ; I/O, TO AVOID ERRONEOUS ATTEMPT TO OPEN FILES TWICE AT LATER COLD ; STARTS. IT CLEARS DISK BUFFERS AT COLD START. ; .PAGE ; **************************************************************** ; ; SET UP REGISTERS AND MACROS. ; ; **************************************************************** ; ; W=%2 ; TEMPORARY USED BY 'NEXT' MACRO (THE INNER INTERPRETER) U=%3 ; POINTER TO THE USER AREA IP=%4 ; FORTH INSTRUCTION COUNTER S=%5 ; FORTH STACK POINTER RP=SP ; FORTH RETURN-STACK POINTER ; ; NOTE - CODE ROUTINES CAN USE REGISTERS 0, 1, 4, AND 5, WITHOUT ; RESTORING THEM. ; ; ; MACRO DEFINITIONS ; ; ; ; THE 'HEAD' MACRO CREATES A FORTH DICTIONARY HEADER. ITS ARGUMENTS ARE: ; (1) LENGTH BYTE - THE LENGTH OF THE NAME BEING DEFINED. THE SIGN BIT ; OF THE LENGTH BYTE MUST BE SET, SO THAT THE SYSTEM WILL RECOGNIZE ; THE END OF A VARIABLE-LENGTH NAME FIELD; THEREFORE THE LENGTH BYTE ; IS GIVEN AS 200 OCTAL PLUS THE LENGTH. IF THE OPERATION IS ; IMMEDIATE, THE BIT NEXT TO THE SIGN BIT IS ALSO SET, SO THE LENGTH ; BYTE IS GIVEN AS 300 OCTAL PLUS THE LENGTH. ; (2) NAME - THE NAME OF THE OPERATION BEING DEFINED. ; (3) LCHAR - THE ASCII VALUE OF THE LAST CHARACTER OF THE NAME, WITH THE ; SIGN BIT SET. THE NAME FIELD MUST HAVE AN EVEN LENGTH (INCLUDING ; THE LENGTH BYTE), SO IF THE NUMBER OF CHARACTERS IN THE NAME IS ; EVEN, 'LCHAR' WILL BE GIVEN AS 240 (200 PLUS CODE FOR A SPACE). ; (4) LABEL - THE ASSEMBLY-LANGUAGE LABEL ASSOCIATED WITH THE 'CODE FIELD' ; OF THIS DICTIONARY HEADER. THESE LABELS ARE USED IN THE PRECOMPILED- ; FORTH SECTION OF THE SYSTEM. WHEN POSSIBLE, THE FORTH OPERATION ; NAME ITSELF IS USED AS THE ASSEMBLY LABEL; OTHERWISE AN ABBREVIATION ; IS USED. BY CONVENTION, THESE NAMES ARE LIMITED TO FIVE CHARACTERS, ; FOR CONSISTENCY AMONG VARIOUS ASSEMBLERS FOR DIFFERENT MICROPROCESSORS. ; (THE FORTH IMPLEMENTATION TEAM USES THE SAME LABELS IN ALL OF ITS ; VERSIONS.) ; (5) CODE - POINTER TO THE MACHINE-LANGUAGE "CODE ROUTINE" ASSOCIATED ; WITH THIS OPERATION TYPE OR DATA TYPE. E.G. FOR ANY COLON DEFINITION, ; THIS ARGUMENT IS 'DOCOL', THE LABEL OF A FIVE-INSTRUCTION ASSEMBLY ; ROUTINE WHICH USES THE RETURN STACK TO HANDLE THE NESTED EXECUTION ; OF ANOTHER LEVEL OF FORTH OPERATIONS. FOR ANY CONSTANT, THIS CODE ; ROUTINE IS 'DOCON', AND SIMILARLY FOR ALL OTHER DATA TYPES. ; THE CODE ARGUMENT MAY BE OMITTED. IN THAT CASE, THE 'HEAD' ; MACRO LEAVES THE CODE FIELD POINTING TWO BYTES BEYOND ITSELF, WHERE ; MACHINE-LANGUAGE CODE MUST BEING - AND THE OPERATION SO DEFINED IS ; CALLED A "PRIMITIVE". THE "NUCLEUS SECTION" OF THIS VERSION OF ; FORTH CONTAINS ABOUT 45 PRIMITIVES, FROM WHICH THE WHOLE SYSTEM ; IS BUILT; IN EFFECT, THESE PRIMITIVES DEFINE THE VIRTUAL FORTH ; MACHINE. (A FEW OPERATIONS IN THE "PRECOMPILED FORTH" SECTION ; OF THE SYSTEM HAVE BEEN REPLACED WITH PRIMITIVES, TO OPTIMIZE ; EXECUTION SPEED. AND WHEN A FORTH ASSEMBLER IS ADDED TO THIS ; SYSTEM, USERS WILL BE ABLE TO DEFINE THEIR OWN PRIMITIVES DIRECTLY ; IN FORTH, IMMEDIATELY READY FOR EXECUTION.) ; ; THE 'HEAD' MACRO CREATES A FORTH HEADER CONSISTING OF ; LENGTH BYTE - SIGN BIT SET ; NAME OF THE OPERATION - VARIABLE LENGTH - SIGN BIT SET ON LAST CHAR. ; LINK FIELD, WHICH POINTS TO THE BEGINNING OF THE PREVIOUS DICTIONARY ; HEADER (USED AT COMPILE TIME) ; CODE POINTER. ; LINK=0 ; LAST LINK FIELD IS 0, INDICATING END OF THE DICTIONARY. ; .MACRO HEAD,LENGTH,NAME,LCHAR,LABEL,CODE LINK2=. .BYTE LENGTH .ASCII ^NAME^ .EVEN .=.-1 .BYTE LCHAR ; LAST CHARACTER OF NAME (OR BLANK FILL), ; PASSED IN OCTAL, WITH HIGH BIT SET. .WORD LINK LINK=LINK2 LABEL: .IF NB CODE .WORD CODE .IFF .WORD .+2 .ENDC .ENDM ; ; ; ; THE 'NEXT' MACRO TRANSFERS CONTROL FROM ONE FORTH OPERATION TO THE ; 'CODE ROUTINE' OF THE NEXT. NOTICE THAT ONLY TWO INSTRUCTION ; EXECUTIONS ARE REQUIRED TO TRANSFER CONTROL FROM USEFUL OPERATIONS ; OF ONE FORTH PRIMITIVE TO THOSE OF THE NEXT. ; .MACRO NEXT MOV (IP)+,W JMP @(W)+ .ENDM ; ; ; MACRO CALLS ; ; .IFDF RT11 .MCALL .RCTRLO,.TTYIN,.TTINR,.TTYOUT,.EXIT,.TRPSET .MCALL .SETTOP,.DSTATUS,.FETCH,.LOOKUP,.READW,.WRITW .ENDC ; ; .IFDF RSX11 .MCALL QIOW$C,EXIT$S,ALUN$C,ASTX$S,SVTK$S .MCALL FDBDF$,FDRC$A,FDBK$A,FDOP$A,FSRSZ$ .MCALL OPEN$M,READ$,WRITE$,WAIT$,CLOSE$ .MCALL QIOW$ ; MPH 12/84 VVVVVVVVVV ; INITIALIZATION ; TGRP AND TMEM ARE THE INSTRUCTOR'S PROJECT AND ; PROGRAMER NUMBER RESPECTIVELY. TGRP = 19. TMEM = 116. TSIZE = 180. ; BLOCKS IN TEACHER.DAT ; THIS GIVES 90 FORTH SCREENS .MCALL OPEN$R,GTSK$S ; FOR THE SPLIT FILES .IFDF EMUL .MCALL SCCA$S ; FOR ^C IN ?TERMINAL .ENDC ; MPH 12/84 ^^^^^^^^^^ .ENDC .PAGE ; **************************************************************** ; ; START-UP TABLE ; ; **************************************************************** ; ; AT STARTUP, MOST OF THESE VALUES ARE MOVED INTO THE USER AREA ; (STARTING AT 'XDP:'); THEY ARE NORMALLY ACCESSED THERE. THE VALUES ; HERE ARE NOT USUALLY CHANGED, BUT THEY MAY BE CHANGED E.G. TO ; CONTROL WHAT HAPPENS AT COLD START. THIS TABLE COULD BE MOVED OUT OF ; LOW MEMORY IF NECESSARY FOR ROM SYSTEMS. ; ; ; GFORTH:: ; GLOBAL LABEL - NORMALLY NOT USED ORIGIN: JMP CENT ; COLD START ENTRY POINT JMP WENT ; WARM START ENTRY ADDRESS ; NOTE - COLD START WIPES OUT ANY NEW DICTIONARY DEFINITIONS, AND ; THEN DOES A WARM START. WARM START CLEANS UP STACKS, TERMINAL ; BUFFER, ETC. .WORD 11 ; CPU .WORD 0 ; REVISION .WORD TASK-10 ; POINTER TO LATEST WORD DEFINED .WORD 10 ; BACKSPACE CHARACTER .WORD XUP ; POINTER TO USER AREA ; NOTE - THE USER AREA IS A HOOK IN THIS SYSTEM TO ALLOW MULTITASKING ; TO BE ADDED LATER. .WORD XS0 ; POINTER TO BEGINNING OF THE STACK .WORD XR0 ; POINTER TO BEGINNING OF RETURN STACK .WORD XTIB ; POINTER TO TERMINAL INPUT BUFFER .WORD 37 ; MAXIMUM NAME-FIELD WIDTH, NORMALLY 31 .WORD 0 ; WARNING MODE; 0=ERROR #, 1=DISK MESSAGE ; NOTE - WARNING MODE INITIALIZED TO ZERO, IN CASE DISK ISN'T UP. .WORD XDP ; FENCE TO PROTECT AGAINST ACCIDENTAL ; 'FORGET' OF THE SYSTEM. .WORD XDP ; POINTER TO NEXT AVAILABLE DICTIONARY ; LOCATION (RETURNED BY 'HERE'). .WORD XXVOC ; POINTER TO INITIAL VOCABULARY LINK .WORD DSKBUF ; INITIALIZE 'FIRST' .WORD ENDBUF ; INITIALIZE 'LIMIT' ; MPH .WORD 0 ; AVAILABLE ; MPH .WORD 0 ; AVAILABLE ; MPH 10/84 VVVVVVVVVV .WORD 0 ; SPAN .WORD 120 ; #TIB,SIZE OF INPUT BUFFER ; MPH 10/84 ^^^^^^^^^^ ; .PAGE ; **************************************************************** ; ; NUCLEUS ; ; **************************************************************** ; ; ; ; THE NUCLEUS CONTAINS THE PRIMITIVES FROM WHICH THE SYSTEM IS BUILT. ; ; ; ; HEAD 203,LIT,324,LIT ; ***** LIT ; USED ONLY BY COMPILER. PUSH FOLLOWING LITERAL ONTO STACK. MOV (IP)+,-(S) NEXT ; HEAD 207,EXECUTE,305,EXEC ; ***** EXECUTE ; EXECUTE FORTH WORD WHOSE CODE ADDRESS IS ON STACK MOV (S)+,W JMP @(W)+ ; ; HEAD 206,BRANCH,240,BRAN ; ***** BRANCH ; USED ONLY BY COMPILER. FORTH BRANCH TO ADDRESS WHICH FOLLOWS. ADD (IP),IP NEXT ; HEAD 207,0BRANCH,310,ZBRAN ; ***** 0BRANCH ; USED ONLY BY COMPILER. FORTH BRANCH IF TOP OF STACK ; IS ZERO (FALSE). TST (S)+ BNE 3$ ADD (IP),IP NEXT 3$: ADD #2,IP NEXT ; HEAD 206,(LOOP),240,XLOOP ; ***** (LOOP) ; USED ONLY BY COMPILER. INCREMENT LOOP INDEX BY 1, BRANCH ; IF BELOW LIMIT. ; MPH 11/85 VVVVVVVVVV ; THIS IS THE OLD LOOP CONSTRUCT. IT IS LEFT HERE TO BE ; USED BY WORDS SUCH AS TYPE, -TRAILING, ETC. ; MPH 11/85 ^^^^^^^^^^ INC (RP) CMP (RP),2(RP) BGE 1$ ADD (IP),IP NEXT 1$: ADD #4,RP ADD #2,IP NEXT ; ; MPH 11/85 VVVVVVVVVV HEAD 207,(MLOOP),251,XMLOOP ; ***** (MLOOP) ; AFTER F83 MODEL INC (RP) BVS 1$ ADD (IP),IP NEXT 1$: ADD #6,RP ADD #2,IP NEXT ; MPH 11/85 ^^^^^^^^^^ ; HEAD 207,(+LOOP),251,XPLOO ; ***** (+LOOP) ; USED ONLY BY COMPILER. INCREMENT LOOP INDEX BY TOP OF STACK, ; MAYBE BRANCH. ; MPH 11/85 VVVVVVVVVV ; THIS IS THE OLD +LOOP CONSTRUCT. IT IS NEEDED IN FLUSH AND NSETUP. ; MPH 11/85 ^^^^^^^^^^ ADD (S),(RP) TST (S)+ BLT 2$ CMP 2(RP),(RP) BLE 1$ ADD (IP),IP NEXT 1$: ADD #4,RP ADD #2,IP NEXT 2$: CMP (RP),2(RP) ; HANDLE NEGATIVE INCREMENT ; MPH 8/84 VVVVVVVVVV ; MPH BLE 1$ ; ; CHANGE IN FORTH 83 ; BLT 1$ ; MPH 8/84 ^^^^^^^^^^ ADD (IP),IP NEXT ; ; MPH 11/85 VVVVVVVVVV HEAD 210,(+MLOOP),240,XPMLOO ; ***** (+MLOOP) ; AFTER F83 MODEL ADD (S)+,(RP) ; IN CASE WE LEAVE BVS 1$ TST -(S) ; SINCE WE DID NOT ADD (IP),IP NEXT 1$: ADD #6,RP ADD #2,IP NEXT ; MPH 11/85 ^^^^^^^^^^ ; HEAD 204,(DO),240,XDO ; ***** (DO) ; USED ONLY BY COMPILER. SET UP 'DO' LIMIT AND INDEX. ; MPH 11/85 VVVVVVVVVV ; SEE (LOOP) ABOVE. ; MPH 11/85 ^^^^^^^^^^ MOV 2(S),-(RP) MOV (S),-(RP) ADD #4,S NEXT ; ; MPH 11/85 VVVVVVVVVV HEAD 205,(MDO),251,XMDO ; ***** (MDO) ; AFTER THE F83 MODEL MOV (IP)+,-(RP) ADD #100000,2(S) MOV 2(S),-(RP) SUB 2(S),(S) MOV (S),-(RP) ADD #4,S NEXT ; MPH 11/85 ^^^^^^^^^^ ; ; MPH HEAD 201,I,311,I ; ***** I ; MPH 11/85 VVVVVVVVVV HEAD 202,OI,240,I ; ***** OI ; THIS IS JAMES' ORIGINAL I. SEE (LOOP) ABOVE. ; MPH 11/85 ^^^^^^^^^^ ; RETURN CURRENT LOOP INDEX TO STACK. MOV (RP),-(S) NEXT ; ; MPH 11/85 VVVVVVVVVV HEAD 201,I,311,MI ; ***** I ; AFTER THE F83 MODEL MOV (RP),-(S) ADD 2(RP),(S) NEXT ; ; MPH 11/85 ^^^^^^^^^^ ; MPH 5/84 VVVVVVVVVV ; HEAD 202,IP,240,IPX ; ***** IP MOV IP,-(S) NEXT ; HEAD 201,J,312,J ; ***** J ; RETURN OUTTER LOOP INDEX TO STACK MOV 6(RP),-(S) ADD 10(RP),(S) NEXT ; ; MPH 5/84 ^^^^^^^^^^ ; HEAD 205,DIGIT,324,DIGIT ; ***** DIGIT ; USED BY COMPILER. ; ( ASCII-DIGIT BASE ==> DIGIT-VALUE TRUE (OR FALSE)) SUB #60,2(S) ; VALID DIGIT IS ASCII 60 - CMP 2(S),#11 ; IF GREATER THAN 9, BLE 1$ SUB #7,2(S) ; SUBTRACT 7. CMP 2(S),#12 ; AND THEN IF <10 (A) BLT 2$ ; ERROR 1$: TST 2(S) ; IF LESS THAN ZERO, ERROR BLT 2$ CMP 2(S),(S) ; OR IF NOT LESS THAN BASE, ERR BGE 2$ ; MPH MOV #1,(S) ; VALID RETURN ; MPH 3/84 VVVVVVVVVV MOV #-1,(S) ; MPH 3/84 ^^^^^^^^^^ NEXT 2$: ADD #2,S CLR (S) ; ERROR - RETURN '0' FLAG NEXT ; ; HEAD 206,(FIND),240,PFIND ; ***** (FIND) ; USED BY COMPILER. FIND A WORD IN THE DICTIONARY. ; ( STRING-ADDRESS NFA ==> PFA LENGTH TRUE (OR FALSE)). ; STRING-ADDRESS IS ADDRESS OF THE LENGTH BYTE OF THE ; STRING BEING SOUGHT. NFA IS NAME-FIELD ADDRESS OF ; WORD IN DICTIONARY WHERE SEARCH BEGINS. PFA IS ; PARAMETER-FIELD ADDRESS OF THE DICTIONARY ENTRY ; WHICH IS FOUND. IF WORD NOT FOUND, ONLY ONE RESULT ; (0, FALSE) IS RETURNED. ; SETUP - GET ARGS, PRESERVE NEEDED REGISTERS MOV (S)+,R0 ; DICTIONARY ADDRESS MOV (S)+,R1 ; STRING ADDRESS MOV R5,-(RP) ; PRESERVE REGISTERS MOV R4,-(RP) MOV R3,-(RP) CLR -(RP) ; SPACE TO STORE LENGTH BYTE ; PREPARE R2 FOR FAST COMPARE MOV (R1),R2 BIC #100200,R2 ; FCOMP: ; FAST TEST TO ELIMINATE MOST WORDS ; COMPARE FIRST WORD TO SPECIALLY PREPARED R2 ; THEN INCREMENT TO FIND END OF NAME. FAST: MOV (R0),R3 BIC #100300,R3 CMP R2,R3 BEQ NOFAST ; NO FAST ELIMINATION POSSIBLE XMATCH: TST (R0)+ ; BRANCH HERE IF NO MATCH THIS TIME BPL XMATCH ; R0 NOW POINTS TO LINK TST (R0) BEQ FAILED MOV (R0),R0 BR FCOMP ; END OF FAST ELIMINATION TEST ; NOFAST: MOV (R0),(RP) ; SAVE LENGTH BYTE MOV R1,R5 ; SET R5 BR NOFST1 ; NOW DO THE MAIN LOOP TO CHECK FOR MATCH MLOOP: TST (R5)+ MOV (R5),R4 MOV (R0),R3 BIC #100000,R3 CMP R3,R4 BNE XMATCH NOFST1: BIT #100000,(R0)+ BEQ MLOOP ; IF GET HERE, FOUND IT. MOV (RP)+,R2 ; POP AND SAVE LENGTH BYTE MOV (RP)+,R3 ; RESTORE REGISTERS MOV (RP)+,R4 MOV (RP)+,R5 ADD #4,R0 ; GET PARAMETER FIELD ADDRESS MOV R0,-(S) BIC #177400,R2 ; R2 CONTAINS LENGTH BYTE MOV R2,-(S) ; MPH MOV #1,-(S) ; MPH 3/84 VVVVVVVVVV MOV #-1,-(S) ; MPH 3/84 ^^^^^^^^^^ NEXT FAILED: TST (RP)+ ; POP LENGTH BYTE MOV (RP)+,R3 ; RESTORE REGISTERS MOV (RP)+,R4 MOV (RP)+,R5 CLR -(S) ; REPLACE LENGTH BYTE WITH ; FAILURE FLAG. NEXT ; WE ARE DONE - FAILURE TO FIND ; HEAD 207,ENCLOSE,305,ENCL ; ***** ENCLOSE ; USED BY COMPILER. BREAK NEXT WORD OUT OF INPUT BUFFER. ; ( START-ADDRESS DELIMITER ==> ADDRESS OFFSET END NEXT-CHARACTER) MOV (S),R0 ; DELIMITER MOV 2(S),R1 ; STARTING ADDRESS SUB #4,S ; MAKE SPACE FOR RESULTS ENC1: CMPB (R1)+,R0 BEQ ENC1 ; SKIP OVER LEADING DELIMITERS SUB #1,R1 MOV R1,4(S) ENC2: TSTB (R1) ; TEST FOR NULL BEQ ENC4 CMPB (R1)+,R0 ; NOT NULL, SO FIND END OF TOKEN BNE ENC2 MOV R1,(S) SUB #1,R1 ENC3: MOV R1,2(S) ; FINISH UP AND RETURN MOV 6(S),R1 SUB R1,(S) SUB R1,2(S) SUB R1,4(S) NEXT ENC4: MOV R1,(S) ; HANDLE NULL CASE CMP R1,4(S) BNE ENC3 ADD #1,R1 BR ENC3 ; ; ; THE NEXT 4 HEADERS POINT TO INSTALLATION-DEPENDENT TERMINAL I/O ; ROUTINES. ; ; HEAD 204,EMIT,240,EMIT,PEMIT ; ***** EMIT ; HEAD 203,KEY,331,KEY,PKEY ; ***** KEY ; HEAD 211,?TERMINAL,314,QTERM,PQTER ; ***** ?TERMINAL ; HEAD 202,CR,240,CR,PCR ; ***** CR ; ; ; ; ; HEAD 205,CMOVE,305,CMOVE ; ***** CMOVE ; MOVE BYTES IN MEMORY. ( FROM TO N ==>) TST (S) BEQ 2$ ; NO MOVE MOV 2(S),R0 MOV 4(S),R1 1$: MOVB (R1)+,(R0)+ DEC (S) BNE 1$ 2$: ADD #6,S NEXT ; ; ; MPH 5/84 VVVVVVVVVV HEAD 206,CMOVE>,240,CMVUP ; ***** CMOVE> ; MOVE BYTES IN MEMORY HIGH BYTES FIRST ( FROM TO N ==>) TST (S) BEQ 2$ MOV 2(S), R0 ; TO ADD (S), R0 ; TO + N MOV 4(S),R1 ; FROM ADD (S), R1 ; FROM + N 1$: MOVB -(R1),-(R0) DEC (S) BNE 1$ 2$: ADD #6, S NEXT ; ; ; ; MPH HEAD 202,U*,240,USTAR ; ***** U* ; MPH 8/84 VVVVVVVVVV HEAD 203,UM*,252,USTAR ; ***** UM* ; MPH 8/84 ^^^^^^^^^^ ; ( N1 N2 ==> PRODUCT). PRODUCT IS 32-BIT DOUBLE INTEGER, ; HIGH WORD TOP. ; THIS MUST BE UNSIGNED MULTIPLICATION. JSR PC,UMULT NEXT UMULT: ; THE VALUES TO MULTIPLY ARE ON THE STACK. MOV (S)+,R2 MOV #20,-(RP) ; SET LOOP COUNT CLR R0 CLR R1 2$: ROL R1 ROL R0 ROL R2 BCC 1$ ADD (S),R1 ADC R0 1$: DEC (RP) BNE 2$ MOV R1,(S) MOV R0,-(S) TST (RP)+ ; POP TEMPORARY RTS PC ; ; MPH HEAD 202,U/,240,USLAS ; ***** U/ ; MPH 8/84 VVVVVVVVVV HEAD 206,UM/MOD,240,USLAS ; ***** UM/MOD ; MPH 8/84 ^^^^^^^^^^ ; THIS DIVISION MUST BE UNSIGNED. JSR PC,UDIV NEXT UDIV: ; THE VALUES TO DIVIDE ARE ON THE STACK MOV (S)+,R2 ; DIVISOR MOV (S)+,R0 MOV (S)+,R1 MOV #20,-(S) ; LOOP COUNT 1$: ASL R1 ROL R0 BEQ 2$ ; NO NEED TO SUBTRACT SUB R2,R0 INC R1 BCC 2$ ADD R2,R0 ; MUST RESTORE DEC R1 2$: DEC (S) ; LOOP SIXTEEN TIMES BNE 1$ TST (S)+ ; POP TO DISCARD COUNT MOV R0,-(S) ; REMAINDER MOV R1,-(S) ; QUOTIENT RTS PC ; HEAD 203,AND,304,AND ; ***** AND ; BITWISE AND. ( N1 N2 ==> N3). COM (S) BIC (S)+,(S) NEXT ; HEAD 202,OR,240,OR ; ***** OR BIS (S)+,(S) NEXT ; HEAD 203,XOR,322,XOR ; ***** XOR .IFDF EIS MOV (S)+,R0 XOR R0,(S) .IFF MOV (S),-(RP) BIC 2(S),(RP) BIC (S)+,(S) BIS (RP)+,(S) .ENDC NEXT ; HEAD 203,SP@,300,SPAT ; ***** SP@ MOV S,R1 MOV R1,-(S) NEXT ; HEAD 203,SP!,241,SPSTO ; ***** SP! MOV 6(U),S ; OFFSET 6 IN USER AREA NEXT ; HEAD 203,RP!,241,RPSTO ; ***** RP! MOV ORIGIN+24,RP NEXT ; ; MPH HEAD 202,<;S>,240,SEMIS ; ***** ;S ; MPH 8/84 VVVVVVVVVV HEAD 204,EXIT,240,SEMIS ; ***** EXIT ; MPH 8/84 ^^^^^^^^^^ MOV (RP)+,IP NEXT ; ; MPH HEAD 205,LEAVE,305,LEAVE ; ***** LEAVE ; MPH 10/84 VVVVVVVVVV HEAD 210,(OLEAVE),240,PLEAV ; ***** (OLEAVE) ; THIS IS THE OLD LEAVE. ; MPH 10/84 ^^^^^^^^^^ MOV (RP),2(RP) NEXT ; ; MPH 11/85 VVVVVVVVVV HEAD 207,(LEAVE),251,PMLEAV ; ***** (LEAVE) ; AFTER F83 MODEL ADD #4,RP MOV (RP)+,IP NEXT ; ; MPH 11/85 ^^^^^^^^^^ ; HEAD 202,^/>R/,240,TOR ; ***** >R MOV (S)+,-(RP) NEXT ; HEAD 202,R>,240,FROMR ; ***** R> MOV (RP)+,-(S) NEXT ; ; MPH 3/84 HEAD 201,R,322,R ; ***** R ; MPH 3/84 VVVVVVVVVV HEAD 202,R@,240,R ; ***** R@ ; ; MPH 3/84 ^^^^^^^^^^ MOV (RP),-(S) NEXT ; HEAD 202,0=,240,ZEQU ; ***** 0= TST (S) BEQ 1$ CLR (S) BR 2$ ; MPH 1$: MOV #1,(S) ; MPH 3/84 VVVVVVVVVV 1$: MOV #-1,(S) ; MPH ^^^^^^^^^^ 2$: NEXT ; HEAD 202,0<,240,ZLESS ; ***** 0< TST (S) BMI 1$ CLR (S) BR 2$ ; MPH 1$: MOV #1,(S) ; MPH 3/84 VVVVVVVVVV 1$: MOV #-1,(S) ; MPH ^^^^^^^^^^ 2$: NEXT ; ; MPH 3/83 VVVVVVVVVV HEAD 202,0>,240,ZGREA ; ***** 0> TST (S) BGT 1$ CLR (S) BR 2$ 1$: MOV #-1,(S) 2$: NEXT ; MPH 3/83 ^^^^^^^^^^ ; HEAD 201,+,253,PLUS ; ***** + ADD (S)+,(S) NEXT ; HEAD 202,D+,240,DPLUS ; ***** D+ ADD 2(S),6(S) ; ADD LOW ADC 4(S) ADD (S),4(S) ; ADD HIGH ADD #4,S NEXT ; ; MPH 3/84 HEAD 205,MINUS,323,MINUS ; ***** MINUS ; MPH 3/84 VVVVVVVVVV HEAD 206,NEGATE,240,MINUS ; ***** NEGATE ; ; MPH 3/84 ^^^^^^^^^^ ; CHANGE SIGN. NEG (S) NEXT ; ; MPH 3/84 HEAD 206,DMINUS,240,DMINU ; ***** DMINUS ; MPH 3/84 VVVVVVVVVV HEAD 207,DNEGATE,305,DMINU ; ***** DNEGATE ; ; MPH 3/84 ^^^^^^^^^^ ; CHANGE SIGN OF DOUBLE INTEGER WORD ON STACK. NEG (S) NEG 2(S) SBC (S) NEXT ; HEAD 204,OVER,240,OVER ; ***** OVER ; ( N1 N2 ==> N1 N2 N1) MOV 2(S),-(S) NEXT ; HEAD 204,DROP,240,DROP ; ***** DROP ADD #2,S NEXT ; HEAD 204,SWAP,240,SWAP ; ***** SWAP MOV 2(S),R1 MOV (S),2(S) MOV R1,(S) NEXT ; HEAD 203,DUP,320,DUP ; ***** DUP MOV (S),-(S) NEXT ; HEAD 202,+!,240,PSTOR ; ***** +! ; ADD NUMBER SECOND ON STACK TO ADDRESS ON TOP. ADD 2(S),@(S) ADD #4,S NEXT ; HEAD 206,TOGGLE,240,TOGGL ; ***** TOGGLE ; ( BYTE-ADDRESS BIT-PATTERN ==> ) EXCLUSIVE-OR INTO MEMORY BYTE. MOV 2(S),-(S) ; PUSH THE BYTE MOVB @(S),(S) ; TO BE TOGGLED ; AVOID USING 'XOR' INSTRUCTION - NOT AVAILABLE ON ALL PDP-11 MOV (S),-(RP) BIC 2(S),(RP) BIC (S)+,(S) BIS (RP)+,(S) MOV 2(S),-(S) ; SET UP RETURN ADDRESS MOVB 2(S),@(S) ; PUT THE TOGGLED BYTE BACK TO MEM. ADD #6,S ; ADJUST STACK POINTER NEXT ; HEAD 201,@,300,AT ; ***** @ MOV @(S),(S) NEXT ; HEAD 202,C@,240,CAT ; ***** C@ MOVB @(S),R1 BIC #177400,R1 MOV R1,(S) NEXT ; HEAD 201,!,241,STORE ; ***** ! MOV 2(S),@(S) ADD #4,S NEXT ; HEAD 202,C!,240,CSTOR ; ***** C! MOVB 2(S),@(S) ADD #4,S NEXT ; ; .PAGE ; **************************************************************** ; ; PRE-COMPILED FORTH SECTION ; ; **************************************************************** ; ; ; ; NOTE - A FEW OF THE FOLLOWING OPERATIONS HAVE BEEN ; CONVERTED TO CODE FOR SPEED. HOWEVER, THE WORD ORDER ; IN THE DICTIONARY HAS NOT BEEN CHANGED. ; HEAD 301,:,272,COLON,DOCOL ; ***** : ; MPH 4/84 VVVVVVVVVV ; MPH .WORD QEXEC,SCSP,CURR,AT,CONT,STORE,CREAT,RBRAC,PSCOD ; MPH JAMES VERSION. IN FORTH83 ":" ; MPH MUST SET ITS OWN SMUDGE BIT. .WORD QEXEC,SCSP,CURR,AT,CONT,STORE,CREAT,SMUDG,RBRAC,PSCOD ; MPH 4/84 ^^^^^^^^^^ DOCOL: MOV IP,-(RP) MOV W,IP NEXT ; HEAD 301,<;>,273,SEMI,DOCOL ; ***** ; .WORD QCSP,COMP,SEMIS,SMUDG,LBRAC,SEMIS ; HEAD 210,CONSTANT,240,CON,DOCOL ; ***** CONSTANT ; MPH 4/84 VVVVVVVVVV ; .WORD CREAT,SMUDG,COMMA,PSCOD ; CREATE NO LONGER SETS ITS SMUDGE BIT. .WORD CREAT,COMMA,PSCOD ; MPH 4/84 ^^^^^^^^^^ DOCON: MOV (W),-(S) NEXT ; HEAD 210,VARIABLE,240,VAR,DOCOL ; ***** VARIABLE ; MPH 4/84 VVVVVVVVVV ; .WORD CON,PSCOD ; FORTH83 VARIABLE IS A BIT DIFFERENT. .WORD CREAT,TWO,ALLOT,PSCOD ; MPH 4/84 ^^^^^^^^^^ DOVAR: MOV W,-(S) NEXT ; HEAD 204,USER,240,USER,DOCOL ; ***** USER ; CREATE A NEW USER VARIABLE. ( N ==> ). .WORD CON,PSCOD DOUSE: MOV (W),-(S) ADD U,(S) NEXT ; ; ; ; CONSTANTS ; HEAD 201,0,260,ZERO,DOCON ; ***** 0 .WORD 0 ; HEAD 201,1,261,ONE,DOCON ; ***** 1 .WORD 1 ; HEAD 201,2,262,TWO,DOCON ; ***** 2 .WORD 2 ; HEAD 201,3,263,THREE,DOCON ; ***** 3 .WORD 3 ; HEAD 202,BL,240,BL,DOCON ; ***** BL ; BLANK. .WORD 40 ; HEAD 203,C/L,314,CL,DOCON ; ***** C/L ; # OF CHARACTERS PER LINE .WORD 100 ; ; 'FIRST' AND 'LIMIT' MOVED TO USER AREA ; HEAD 205,B/BUF,306,BBUF,DOCON ; ***** B/BUF ; BYTES PER DISK-BLOCK BUFFER. .WORD 1024. ; HEAD 205,B/SCR,322,BSCR,DOCON ; ***** B/SCR ; DISK BLOCKS PER FORTH SCREEN. .WORD 1 ; HEAD 207,+ORIGIN,316,PORIG,DOCOL ; ***** +ORIGIN ; RETURNS ADDRESS, GIVEN OFFSET FROM ORIGIN. .WORD LIT,ORIGIN,PLUS,SEMIS ; ; USER VARIABLES ; HEAD 202,S0,240,SZERO,DOUSE ; ***** S0 ; STACK ORIGIN. .WORD 6 ; HEAD 202,R0,240,RZERO,DOUSE ; ***** R0 ; RETURN STACK ORIGIN. .WORD 10 ; HEAD 203,TIB,302,TIB,DOUSE ; ***** TIB ; TERMINAL INPUT BUFFER. .WORD 12 ; HEAD 205,WIDTH,310,WIDTH,DOUSE ; ***** WIDTH ; MAXIMUM NAME LENGTH (DEFAULT, 31 CHARACTERS). .WORD 14 ; HEAD 207,WARNING,307,WARN,DOUSE ; ***** WARNING ; WARNING MODE (DEFAULT, GIVE MESSAGE NUMBER AT ERROR ; OR WARNING CONDITION, DON'T GO TO DISK FOR MESSAGE). .WORD 16 ; HEAD 205,FENCE,305,FENCE,DOUSE ; ***** FENCE ; PREVENTS 'FORGET' BELOW THIS 'FENCE' SETTING. .WORD 20 ; HEAD 202,DP,240,DP,DOUSE ; ***** DP ; DICTIONARY POINTER TO NEXT AVAILABLE SPACE. .WORD 22 ; HEAD 210,VOC-LINK,240,VOCL,DOUSE ; ***** VOC-LINK ; VOCABULARY LINK (MAINLY FOR FUTURE USE). .WORD 24 ; HEAD 205,FIRST,324,FIRST,DOUSE ; ***** FIRST ; ADDRESS OF BEGINNING OF DISK BUFFER. .WORD 26 ; HEAD 205,LIMIT,324,LIMIT,DOUSE ; ***** LIMIT ; ADDRESS JUST BEYOND END OF DISK BUFFERS. .WORD 30 ; ; POSITIONS 32 AND 34 ARE AVAILABLE FOR EXPANSION. ; THEY ARE INITIALIZED FROM BOOT-UP TABLE, AT COLD START. ; ; MPH 11/84 VVVVVVVVVV HEAD 204,SPAN,240,SPAN,DOUSE ; ***** SPAN .WORD 32 ; HEAD 204,#TIB,240,NTIB,DOUSE ; ***** #TIB .WORD 34 ; ; SPAN AND #TIB ARE REQUIRED USER VARIABLES ; IN FORTH-83. ; HEAD 203,BLK,313,BLK,DOUSE ; ***** BLK ; CURRENT DISK BLOCK BEING LOADED (0=TERMINAL) .WORD 36 ; ; MPH HEAD 202,IN,240,IN,DOUSE ; ***** IN ; MPH 8/84 VVVVVVVVVV HEAD 203,^/>IN/,316,IN,DOUSE ; ***** >IN ; MPH 8/84 ^^^^^^^^^^ ; OFFSET IN TERMINAL INPUT BUFFER. .WORD 40 ; HEAD 203,OUT,324,OUT,DOUSE ; ***** OUT ; OFFSET IN OUTPUT LINE. .WORD 42 ; HEAD 203,SCR,322,SCR,DOUSE ; ***** SCR ; CURRENT FORTH DISK SCREEN. .WORD 44 ; HEAD 206,OFFSET,240,OFSET,DOUSE ; ***** OFFSET ; OFFSET TO GET TO ANOTHER DISK DRIVE. .WORD 46 ; HEAD 207,CONTEXT,324,CONT,DOUSE ; ***** CONTEXT .WORD 50 ; HEAD 207,CURRENT,324,CURR,DOUSE ; ***** CURRENT .WORD 52 ; HEAD 205,STATE,305,STATE,DOUSE ; ***** STATE .WORD 54 ; HEAD 204,BASE,240,BASE,DOUSE ; ***** BASE .WORD 56 ; HEAD 203,DPL,314,DPL,DOUSE ; ***** DPL ; OFFSET OF DECIMAL POINT AFTER DOUBLE-INTEGER INPUT. .WORD 60 ; HEAD 203,FLD,304,FLD,DOUSE ; ***** FLD ; OUTPUT FIELD WIDTH. .WORD 62 ; HEAD 203,CSP,320,CSP,DOUSE ; ***** CSP ; USED BY COMPILER TO HOLD CURRENT STACK POSITION, ; FOR ERROR CHECKING. .WORD 64 ; HEAD 202,R#,240,RNUM,DOUSE ; ***** R# ; CURSOR POSITION (FOR SOME EDITORS). .WORD 66 ; HEAD 203,HLD,304,HLD,DOUSE ; ***** HLD ; POINTS TO LAST CHARACTER HELD IN 'PAD' .WORD 70 ; HEAD 203,USE,305,USE,DOUSE ; ***** USE .WORD 72 ; HEAD 204,PREV,240,PREV,DOUSE ; ***** PREV .WORD 74 ; ; END OF USER AREA ; ; HEAD 202,1+,240,ONEP ; ***** 1+ INC (S) NEXT ; HEAD 202,2+,240,TWOP ; ***** 2+ ADD #2,(S) NEXT ; ; MPH 3/84 VVVVVVVVVV HEAD 202,1-,240,ONEM ; ***** 1- DEC (S) NEXT ; HEAD 202,2-,240,TWOM ; ***** 2- SUB #2,(S) NEXT ; HEAD 202,2/,240,TWOD ; ***** 2/ ASR (S) NEXT ; MPH 3/84 ^^^^^^^^^^ ; HEAD 204,HERE,240,HERE,DOCOL ; ***** HERE .WORD DP,AT,SEMIS ; HEAD 205,ALLOT,324,ALLOT,DOCOL ; ***** ALLOT .WORD DP,PSTOR,SEMIS ; HEAD 201,<,>,254,COMMA,DOCOL ; ***** , .WORD HERE,STORE,TWO,ALLOT,SEMIS ; ; THIS SYSTEM DOES NOT USE 'C,' ; HEAD 201,-,255,SUB ; ***** - SUB (S)+,(S) NEXT ; ; MPH 8/84 VVVVVVVVVV HEAD 203,NOT,324,NOT,DOCOL ; ***** NOT .WORD ZEQU,SEMIS ; MPH 8/84 ^^^^^^^^^^ ; HEAD 201,=,275,EQUAL ; ***** = CMP 2(S),(S)+ BEQ 1$ CLR (S) BR 2$ ; MPH 1$: MOV #1,(S) ; MPH 3/84 VVVVVVVVVV 1$: MOV #-1,(S) ; MPH 3/84 ^^^^^^^^^^ 2$: NEXT ; HEAD 201,^//,276,GREAT ; ***** > CMP 2(S),(S)+ BGT 1$ CLR (S) BR 2$ ; MPH 1$: MOV #1,(S) ; MPH VVVVVVVVVV 1$: MOV #-1,(S) ; MPH 3/84 ^^^^^^^^^^ 2$: NEXT ; HEAD 203,ROT,324,ROT ; ***** ROT MOV (S),R0 MOV 4(S),(S) MOV 2(S),4(S) MOV R0,2(S) NEXT ; HEAD 205,SPACE,305,SPACE,DOCOL ; ***** SPACE .WORD LIT,40,EMIT,SEMIS ; ; MPH 3/84 HEAD 204,-DUP,240,DDUP ; ***** -DUP ; MPH 3/84 VVVVVVVVVV HEAD 204,?DUP,240,DDUP ; ***** ?DUP ; MPH ; MPH 3/84 ^^^^^^^^^^ TST (S) BEQ 1$ MOV (S),-(S) 1$: NEXT ; HEAD 210,TRAVERSE,240,TRAV,DOCOL ; ***** TRAVERSE ; MOVE (FORWARDS OR BACKWARDS) ACROSS A (VARIABLE LENGTH) ; DICTIONARY NAME FIELD. .WORD SWAP XXN1: .WORD OVER,PLUS,LIT,177,OVER,CAT,LESS,ZBRAN,XXN1-. .WORD SWAP,DROP,SEMIS ; HEAD 206,LATEST,240,LATES,DOCOL ; ***** LATEST .WORD CURR,AT,AT,SEMIS ; ; THE NEXT 4 OPERATORS CAN DEPEND ON COMPUTER WORD SIZE. ; THEY CONVERT ADDRESSES WITHIN THE NAME FIELDS OF FORTH ; DICTIONARY ENTRIES. ; HEAD 203,LFA,301,LFA,DOCOL ; ***** LFA .WORD LIT,4,SUB,SEMIS ; HEAD 203,CFA,301,CFA,DOCOL ; ***** CFA .WORD TWO,SUB,SEMIS ; HEAD 203,NFA,301,NFA,DOCOL ; ***** NFA .WORD LIT,5,SUB,LIT,-1,TRAV,SEMIS ; HEAD 203,PFA,301,PFA,DOCOL ; ***** PFA .WORD ONE,TRAV,LIT,5,PLUS,SEMIS ; ; THE NEXT 7 OPERATIONS ARE USED BY THE COMPILER, FOR ; COMPILE-TIME SYNTAX-ERROR CHECKS. ; HEAD 204,!CSP,240,SCSP,DOCOL ; ***** !CSP .WORD SPAT,CSP,STORE,SEMIS ; HEAD 206,?ERROR,240,QERR,DOCOL ; ***** ?ERROR .WORD SWAP,ZBRAN,XXN2-.,ERROR,BRAN,XXN3-. XXN2: .WORD DROP XXN3: .WORD SEMIS ; HEAD 205,?COMP,320,QCOMP,DOCOL ; ***** ?COMP .WORD STATE,AT,ZEQU,LIT,21,QERR,SEMIS ; HEAD 205,?EXEC,303,QEXEC,DOCOL ; ***** ?EXEC .WORD STATE,AT,LIT,22,QERR,SEMIS ; HEAD 206,?PAIRS,240,QPAIR,DOCOL ; ***** ?PAIRS .WORD SUB,LIT,23,QERR,SEMIS ; HEAD 204,?CSP,240,QCSP,DOCOL ; ***** ?CSP .WORD SPAT,CSP,AT,SUB,LIT,24,QERR,SEMIS ; HEAD 210,?LOADING,240,QLOAD,DOCOL ; ***** ?LOADING .WORD BLK,AT,ZEQU,LIT,26,QERR,SEMIS ; HEAD 207,COMPILE,305,COMP,DOCOL ; ***** COMPILE ; COMPILE THE EXECUTION ADDRESS FOLLOWING. .WORD QCOMP,FROMR,DUP,TWOP,TOR,AT,COMMA,SEMIS ; HEAD 301,[,333,LBRAC,DOCOL ; ***** [ ; STOP COMPILATION, ENTER EXECUTION STATE. .WORD ZERO,STATE,STORE,SEMIS ; HEAD 201,],335,RBRAC,DOCOL ; ***** ] ; ENTER COMPILATION STATE. .WORD LIT,300,STATE,STORE,SEMIS ; HEAD 206,SMUDGE,240,SMUDG,DOCOL ; ***** SMUDGE ; ALTER LATEST WORD NAME (SO THAT DICTIONARY SEARCH ; WON'T FIND A PARTIALLY-COMPLETE ENTRY. .WORD LATES,LIT,40,TOGGL,SEMIS ; HEAD 203,HEX,330,HEX,DOCOL ; ***** HEX .WORD LIT,20,BASE,STORE,SEMIS ; HEAD 207,DECIMAL,314,DEC,DOCOL ; ***** DECIMAL .WORD LIT,12,BASE,STORE,SEMIS ; HEAD 205,OCTAL,314,OCTAL,DOCOL ; ***** OCTAL .WORD LIT,10,BASE,STORE,SEMIS ; HEAD 207,<(;CODE)>,251,PSCOD,DOCOL ; ***** (;CODE) ; USED ONLY BY COMPILER; COMPILED BY ';CODE'. .WORD FROMR,LATES,PFA,CFA,STORE,SEMIS ; ; ; ***** THE DEFINITION OF ';CODE' WAS MOVED TO THE END OF ; THE DICTIONARY, BECAUSE IT IS NOT PURE CODE (IT IS PATCHED ; WHEN A FORTH ASSEMBLER IS LOADED). ; HEAD 207,^/,276,DOES,DOCOL ; ***** DOES> .WORD FROMR,LATES,PFA,STORE,PSCOD DODOE: MOV IP,-(RP) MOV (W)+,IP MOV W,-(S) NEXT ; HEAD 205,COUNT,324,COUNT,DOCOL ; ***** COUNT ; CONVERT STRING TO THE FORMAT USED BY 'TYPE'. .WORD DUP,ONEP,SWAP,CAT,SEMIS ; HEAD 204,TYPE,240,TYPE,DOCOL ; ***** TYPE .WORD DDUP,ZBRAN,XXL2-.,OVER,PLUS,SWAP,XDO XXL1: .WORD I,CAT,EMIT,XLOOP,XXL1-.,BRAN,XXL3-. XXL2: .WORD DROP XXL3: .WORD SEMIS ; HEAD 206,=CELLS,240,ECELL,DOCOL ; ***** =CELLS ; NOTE - I NEED THIS, TO FORCE EVEN ADDRESS. .WORD DUP,ONE,AND,PLUS,SEMIS ; HEAD 211,-TRAILING,307,DTRAI,DOCOL ; ***** -TRAILING .WORD DUP,ZERO,XDO XXW6: .WORD OVER,OVER,PLUS,ONE,SUB,CAT ; MPH .WORD BL,SUB,ZBRAN,XXW7-.,LEAVE,BRAN,XXWA-. ; MPH 8/84 VVVVVVVVVV .WORD BL,SUB,ZBRAN,XXW7-.,PLEAV,BRAN,XXWA-. ; MPH OLD LEAVE RENAMED PLEAV. ; MPH 8/84 ^^^^^^^^^^ XXW7: .WORD ONE,SUB XXWA: .WORD XLOOP,XXW6-.,SEMIS ; HEAD 204,(."),240,PDOTQ,DOCOL ; ***** (.") ; USED ONLY BY COMPILER. COMPILED BY '."' .WORD R,COUNT,DUP,ONEP,ECELL .WORD FROMR,PLUS,TOR,TYPE,SEMIS ; HEAD 302,.",240,DOTQ,DOCOL ; ***** ." ; TYPE ASCII MESSAGE. ; MPH STATE SMART WORDS ARE NOT ALLOWED IN F-83 ; MPH .WORD LIT,34.,STATE,AT,ZBRAN,XXL6-. ; MPH .WORD ALLOT,BRAN,XXL7-. ; MPH XXL6: .WORD WORD,HERE,COUNT,TYPE ; MPH XXL7: .WORD SEMIS ; MPH 11/84 VVVVVVVVVV .WORD LIT,34.,COMP,PDOTQ,WORD,CAT .WORD ONEP,ECELL,ALLOT,SEMIS ; MPH 11/84 ^^^^^^^^^^ ; ; MPH 11/84 VVVVVVVVVV HEAD 202,.(,240,DOTP,DOCOL ; ***** .( ; FORTH-83 EQUIVALENT OF ." OUTSIDE : DEF. .WORD LIT,41.,WORD,COUNT,TYPE,SEMIS ; ; MPH 11/84 ^^^^^^^^^^ ; HEAD 206,?ALIGN,240,QALIG,DOCOL ; ***** ?ALIGN .WORD HERE,ONE,AND,ALLOT,SEMIS ; HEAD 206,EXPECT,240,EXPEC,DOCOL ; ***** EXPECT ; READ N CHARACTERS TO MEMORY (AND TERMINATE WITH NULLS). ; MPH 8/84 VVVVVVVVVV ; MPH IN FORTH-83 THERE ARE NO TERMINAL ; MPH CHARACTERS SPECIFIED. A TERMINATING ; MPH RETURN IS STORED AS A BLANK. THE NEW ; MPH USER VARIABLE SPAN CONTAINS THE NUMBER ; MPH OF CHARACTERS RECEIVED AND STORED. ; MPH 8/84 ^^^^^^^^^^ ; ( ADDRESS N ==>). ; MPH .WORD OVER,PLUS,OVER,XDO ; MPH XXK1: .WORD KEY,DUP,LIT,16,PORIG,AT,EQUAL,ZBRAN,XXK2-. ; MPH .WORD DROP,LIT,10,OVER,I,EQUAL,DUP,FROMR ; MPH .WORD TWO,SUB,PLUS,TOR,SUB,BRAN,XXK3-. ; MPH 8/84 VVVVVVVVVV .WORD ZERO,SPAN,STORE .WORD OVER,PLUS,OVER,XDO XXK1: .WORD KEY,DUP,LIT,16,PORIG,AT,EQUAL,ZBRAN,XXK2-. .WORD DROP,LIT,10,OVER,I,EQUAL,DUP .WORD DUP,NOT,SPAN,PSTOR .WORD MINUS,FROMR,TWOM,PLUS,TOR .WORD PLUS,BRAN,XXK3-. ; MPH FOR A BACK SPACE DELETE A CHARACTER ; MPH UNLESS FIRST CHARACTER, THEN BELL. ; MPH ADJUST FOR TRUE = -1. XXK2: .WORD DUP,LIT,15,EQUAL,ZBRAN,XXK4-. .WORD PLEAV,DROP,BL,BL,BRAN,XXK5-. ; MPH OLD LEAVE RENAMED. XXK4: .WORD DUP XXK5: .WORD I,CSTOR,ONE,SPAN,PSTOR .WORD ZERO,I,ONEP,CSTOR,ZERO,I,TWOP,CSTOR ; MPH 8/84 ^^^^^^^^^^ ; MPH XXK2: .WORD DUP,LIT,15,EQUAL,ZBRAN,XXK4-. ; MPH .WORD LEAVE,DROP,BL,ZERO,BRAN,XXK5-. ; MPH XXK4: .WORD DUP ; MPH XXK5: .WORD I,CSTOR,ZERO,I,ONEP,CSTOR,ZERO,I,TWOP,CSTOR ; NOTE DIFFERENCE FOR STAND-ALONE, BELOW .IFDF ALONE XXK3: .WORD EMIT,XLOOP,XXK1-.,DROP,SEMIS .IFF XXK3: .WORD DROP,XLOOP,XXK1-.,DROP,SEMIS .ENDC ; HEAD 205,QUERY,331,QUERY,DOCOL ; ***** QUERY ; MPH .WORD TIB,AT,LIT,120,EXPEC,ZERO,IN,STORE,SEMIS ; MPH 10/84 VVVVVVVVVV ; MPH USES THE USER VARIABLE #TIB. .WORD TIB,AT,NTIB,AT,EXPEC,ZERO,IN,STORE,SEMIS ; MPH 10/84 ^^^^^^^^^^ ; HEAD 301,X,200,NULL,DOCOL ; ***** THE NULL ; THE NULL OPERATION (ASCII 0) STOPS INTERPRETATION/COMPILATION ; AT END OF A TERMINAL INPUT LINE, OR A DISK SCREEN. ALL DISK ; BUFFERS MUST TERMINATE WITH NULLS, AND 'EXPECT' PLACES NULLS ; AFTER EACH TERMINAL INPUT LINE. ; NOTE THAT THE 'X' IN THE HEADER ABOVE WILL BE CHANGED TO A NULL. .WORD BLK,AT .WORD ZBRAN,XXJ2-.,ONE,BLK,PSTOR,ZERO,IN,STORE .WORD BLK,AT,BSCR,MOD,ZEQU,ZBRAN,XXJ1-.,QEXEC,FROMR,DROP XXJ1: .WORD BRAN,XXJ4-. XXJ2: .WORD FROMR,DROP XXJ4: .WORD SEMIS ; HEAD 204,FILL,240,FILL,DOCOL ; ***** FILL .WORD SWAP,TOR,OVER,CSTOR,DUP,ONEP,FROMR .WORD ONE,SUB,CMOVE,SEMIS ; HEAD 205,ERASE,305,ERASE,DOCOL ; ***** ERASE .WORD ZERO,FILL,SEMIS ; HEAD 206,BLANKS,240,BLANK,DOCOL ; ***** BLANKS .WORD BL,FILL,SEMIS ; HEAD 204,HOLD,240,HOLD,DOCOL ; ***** HOLD .WORD LIT,-1,HLD,PSTOR,HLD,AT,CSTOR,SEMIS ; HEAD 203,PAD,304,PAD,DOCOL ; ***** PAD .WORD HERE,LIT,104,PLUS,SEMIS ; HEAD 204,WORD,240,WORD,DOCOL ; ***** WORD .WORD BLK,AT,ZBRAN,XXI1-.,BLK,AT,BLOCK,BRAN,XXI2-. XXI1: .WORD TIB,AT XXI2: .WORD IN,AT,PLUS,SWAP,ENCL,HERE,LIT,42,BLANK,IN .WORD PSTOR,OVER,SUB,TOR,R,HERE,CSTOR,PLUS ; MPH .WORD HERE,ONEP,FROMR,CMOVE,SEMIS ; MPH 8/84 VVVVVVVVVV .WORD HERE,ONEP,FROMR,CMOVE,HERE,SEMIS ; MPH 8/84 ^^^^^^^^^^ ; ; HEAD 210,(NUMBER),240,PNUMB,DOCOL ; ***** (NUMBER) XXF3: .WORD ONEP,DUP,TOR,CAT,BASE,AT,DIGIT .WORD ZBRAN,XXG4-.,SWAP,BASE,AT,USTAR,DROP .WORD ROT,BASE,AT,USTAR,DPLUS .WORD DPL,AT,ONEP,ZBRAN,XXG5-.,ONE,DPL,PSTOR XXG5: .WORD FROMR,BRAN,XXF3-. XXG4: .WORD FROMR,SEMIS ; HEAD 206,NUMBER,240,NUMB,DOCOL ; ***** NUMBER .WORD ZERO,ZERO,ROT,DUP,ONEP,CAT,LIT,55,EQUAL ; MPH 3/84 VVVVVVVVVV ; REQUIRED BY REDEFINITION OF TRUE AS -1 .WORD MINUS ; MPH 3/84 ^^^^^^^^^^ .WORD DUP,TOR,PLUS,LIT,-1 XXF6: .WORD DPL,STORE,PNUMB,DUP,CAT,BL,SUB .WORD ZBRAN,XXF7-.,DUP,CAT,LIT,56,SUB .WORD ZERO,QERR,ZERO,BRAN,XXF6-. XXF7: .WORD DROP,FROMR,ZBRAN,XXFA-.,DMINU XXFA: .WORD SEMIS ; HEAD 205,-FIND,304,DFIND,DOCOL ; ***** -FIND ; MPH .WORD BL,WORD,HERE,COUNT,UPPER,HERE,CONT,AT,AT,PFIND ; MPH 8/84 VVVVVVVVVV .WORD BL,WORD,COUNT,UPPER,HERE,CONT,AT,AT,PFIND ; MPH 8/84 ^^^^^^^^^^ .WORD DUP,ZEQU,ZBRAN,XXE3-.,DROP,HERE,LATES,PFIND XXE3: .WORD SEMIS ; HEAD 205,UPPER,322,UPPER,DOCOL ; ***** UPPER ; SETS STRINGS TO UPPER CASE - TO ALLOW ; LOWER AS WELL AS UPPER CASE FROM TERMINAL. .WORD OVER,PLUS,SWAP,XDO XXE2: .WORD I,CAT,LIT,140,GREAT,I,CAT,LIT,173,LESS .WORD AND,ZBRAN,XXE1-.,I,LIT,40,TOGGL XXE1: .WORD XLOOP,XXE2-.,SEMIS ; HEAD 207,(ABORT),251,PABOR,DOCOL ; ***** (ABORT) ; MPH .WORD ABORT,SEMIS ; MPH 8/84 VVVVVVVVVV .WORD PDOTQ .BYTE 7 .ASCII / ABORT!/ .EVEN .WORD ABORT,SEMIS ; HEAD 210,(ABORT"),240,PABOQ,DOCOL ; ***** (ABORT") .WORD ZBRAN,XXA1-.,R,COUNT .WORD TYPE,SPSTO,QUIT .WORD BRAN, XXA2-. XXA1: .WORD FROMR,DUP,CAT,PLUS .WORD ONEP,ECELL,TOR XXA2: .WORD SEMIS ; ; MPH 8/84 ^^^^^^^^^^ ; HEAD 205,ERROR,322,ERROR,DOCOL ; ***** ERROR .WORD WARN,AT,ZLESS,ZBRAN,XXN4-.,PABOR XXN4: .WORD HERE,COUNT,TYPE,PDOTQ .BYTE 3 .ASCII / ? / .EVEN ; MPH .WORD MESS,SPSTO,IN,AT,BLK,AT,QUIT,SEMIS ; MPH 11/84 VVVVVVVVVV ; FORTH-83 DOES NOT ALLOW ADDITIONS TO THE ; STACK FOLLOWING AN ERROR. .WORD MESS,SPSTO,QUIT,SEMIS ; MPH 11/84 ^^^^^^^^^^ ; HEAD 203,ID.,256,IDDOT,DOCOL ; ***** ID. .WORD PAD,LIT,40,LIT,137,FILL,DUP .WORD PFA,LFA,OVER,SUB,PAD,SWAP,CMOVE .WORD PAD,COUNT,LIT,37,AND,TYPE,SPACE,SEMIS ; HEAD 206,CREATE,240,CREAT,DOCOL ; ***** CREATE .WORD DFIND,ZBRAN,XXD2-.,DROP,NFA,IDDOT .WORD LIT,4,MESS,SPACE ; MPH 4/84 VVVVVVVVVV ; SEE IF THE WORD EXISTS. ; IF IT DOES, PRINT ITS NAME AND A WARNING ; MESSAGE THAT IT IS NOT UNIQUE. ; IN EITHER CASE GO ON. ; MPH 4/84 ^^^^^^^^^^ XXD2: .WORD HERE,DUP,CAT,WIDTH,AT,MIN,ONEP,ALLOT ; MPH 4/84 VVVVVVVVVV ; ADDRESS OF LENGTH BYTE IS ON THE STACK. ; HERE POINTS WIDTH+1 FURTHER. ; .WORD QALIG,DUP,LIT,240,TOGGL,HERE,ONE,SUB ; THIS IS JAMES OLD VERSION. ; FORTH83 DOES NOT SET THE SMUDGE BIT. .WORD QALIG,DUP,LIT,200,TOGGL,HERE,ONE,SUB ; MAKE SURE HERE POINTS TO AN EVEN ADDRESS, ; DUP THE LENGTH BYTE ADDRESS ; AND SET SIGN BIT. ; FIND ADDRESS OF LAST CHARACTER OF NAME. ; MPH 4/84 ^^^^^^^^^^ .WORD LIT,200,TOGGL,LATES,COMMA,CURR,AT,STORE ; MPH 4/84 VVVVVVVVVV ; SET SIGN BIT OF LAST CHARACTER, ; PUT NFA OF LAST WORD IN CURRENT ; VOCABULARY IN THE LINK FIELD AND STORE ; THE NEW WORD'S NFA IN CURRENT. ; MPH 4/84 ^^^^^^^^^^ ; .WORD HERE,TWOP,COMMA,SEMIS ; MPH 4/84 VVVVVVVVVV ; STORE PFA IN CFA. ; IN FORTH83 DO THAT BUT LEAVE PFA ON STACK. .WORD HERE,TWOP,COMMA,SEMIS ; MPH 4/84 ^^^^^^^^^^ ; HEAD 311,[COMPILE],335,BCOMP,DOCOL ; ***** [COMPILE] .WORD DFIND,ZEQU,ZERO,QERR,DROP,CFA,COMMA,SEMIS ; HEAD 307,LITERAL,314,LITER,DOCOL ; ***** LITERAL .WORD STATE,AT,ZBRAN,XXD6-.,COMP,LIT,COMMA XXD6: .WORD SEMIS ; MPH 11/84 VVVVVVVVVV ; NO STATE SMART WORDS ARE ALLOWED IN FORTH-83 ; MPH .WORD COMP,LIT,COMMA,SEMIS ; MPH 11/84 ^^^^^^^^^^ ; HEAD 310,DLITERAL,240,DLITE,DOCOL ; ***** DLITERAL ; MPH .WORD STATE,AT,ZBRAN,XXN5-.,SWAP,LITER,LITER ; MPH XXN5: .WORD SEMIS ; MPH 11/84 VVVVVVVVVV ; SEE LITERAL .WORD LITER,LITER,SEMIS ; MPH 11/84 ^^^^^^^^^^ ; HEAD 202,U<,240,ULESS,DOCOL ; ***** U< ; UNSIGNED LESS-THAN, NEEDED FOR '?STACK' ; : U< >R 0 R> 0 DMINUS D+ SWAP DROP 0< ; .WORD TOR,ZERO,FROMR,ZERO,DMINU,DPLUS .WORD SWAP,DROP,ZLESS,SEMIS ; HEAD 206,?STACK,240,QSTAC,DOCOL ; ***** ?STACK ; ERROR CHECK. .WORD SZERO,AT,TWO,SUB,SPAT,ULESS,ONE,QERR .WORD SPAT,HERE,LIT,200,PLUS,ULESS,TWO,QERR .WORD SEMIS ; HEAD 211,INTERPRET,324,INTER,DOCOL ; ***** INTERPRET XXE4: .WORD DFIND .WORD ZBRAN,XXEA-.,STATE,AT,LESS .WORD ZBRAN,XXE5-.,CFA,COMMA,BRAN,XXE6-. XXE5: .WORD CFA,EXEC XXE6: .WORD QSTAC,BRAN,XXE7-. XXEA: .WORD HERE,NUMB,DPL,AT,ONEP,ZBRAN,XXF4-.,DLITE,BRAN,XXF5-. XXF4: .WORD DROP,LITER XXF5: .WORD QSTAC XXE7: .WORD BRAN,XXE4-. ; HEAD 211,IMMEDIATE,305,IMMED,DOCOL ; ***** IMMEDIATE .WORD LATES,LIT,100,TOGGL,SEMIS ; HEAD 212,VOCABULARY,240,VOCAB,DOCOL ; ***** VOCABULARY .WORD BUILD,LIT,120201,COMMA,CURR,AT,CFA,COMMA ; MPH 11/84 VVVVVVVVVV ; MINOR CHANGE ; .WORD CREAT,LIT,120201,COMMA,CURR,AT,CFA,COMMA ; MPH 11/84 ^^^^^^^^^^ .WORD HERE,VOCL,AT,COMMA,VOCL,STORE,DOES DOVOC: .WORD TWOP,CONT,STORE,SEMIS ; ; ; ***** THE DEFINITION OF 'FORTH' WAS MOVED TO NEAR THE END OF THE ; DICTIONARY, BECAUSE IT IS NOT PURE CODE. ; ; HEAD 213,DEFINITIONS,323,DEFIN,DOCOL ; ***** DEFINITIONS .WORD CONT,AT,CURR,STORE,SEMIS ; HEAD 301,(,250,PAREN,DOCOL ; ***** ( ; MPH .WORD LIT,51,WORD,SEMIS ; MPH 8/84 VVVVVVVVVV .WORD LIT,51,WORD,DROP,SEMIS ; MPH 8/84 ^^^^^^^^^^ ; HEAD 204,QUIT,240,QUIT,DOCOL ; ***** QUIT .WORD ZERO,BLK,STORE,LBRAC ; MPH XXB1: .WORD RPSTO,CR,QUERY,INTER,STATE,AT ; MPH 2/85 VVVVVVVVVV XXB1: .WORD RPSTO,QUERY,INTER,STATE,AT ; MPH 2/85 ^^^^^^^^^^ .WORD ZEQU,ZBRAN,XXB2-.,PDOTQ .BYTE 3 .ASCII / OK/ .EVEN ; MPH 2/85 VVVVVVVVVV .WORD CR ; MPH 2/85 ^^^^^^^^^^ XXB2: .WORD BRAN,XXB1-. ; HEAD 205,ABORT,324,ABORT,DOCOL ; ***** ABORT ; MPH .WORD SPSTO,DEC,SPACE ; MPH .WORD CR,PDOTQ ; MPH .BYTE 21 ; MPH .ASCII /FIG-FORTH V 1.3 / ; MPH .EVEN ; MPH .WORD FORTH,DEFIN,QUIT ; MPH 8/84 VVVVVVVVVV .WORD SPSTO,QUIT ; HEAD 306,ABORT",240,ABORQ,DOCOL ; ***** ABORT" .WORD COMP,PABOQ,LIT,42,WORD .WORD CAT,ONEP,ECELL,ALLOT,SEMIS ;; MPH 8/84 ^^^^^^^^^^ ; ; COLD AND WARM STARTS ; HEAD 204,COLD,240,COLD ; ***** COLD CENT: ; COLD START ENTRY POINT MOV ORIGIN+14,FORTH+6 ; SET 'FORTH' VOCABULARY FROM STARTUP TABLE MOV ORIGIN+20,U ; INITIALIZE USER POINTER ; NOTE - FOR SMALLER STAND-ALONE BOOT, INITIALIZE AREAS IN ; HIGH MEMORY WHICH MUST BE INITIALIZED. ; CLEAR DISK BUFFERS ON FIRST TIME THROUGH MOV ORIGIN+42,R0 ; 'FIRST' - BEGINNING OF DISK BUFFERS MOV ORIGIN+44,R1 ; 'LIMIT' - JUST BEYOND DISK BUFFERS 1$: CLR (R0)+ CMP R0,R1 BLT 1$ ; NOW INITIALIZE 'OUT', 'OFFSET', 'USE' AND 'PREV' CLR 42(U) ; CLEAR 'OUT' CLR 46(U) ; CLEAR 'OFFSET' MOV ORIGIN+42,72(U) ; TO 'USE' MOV ORIGIN+42,74(U) ; TO 'PREV' ; END OF SPECIAL HIGH-MEMORY INITIALIZE MOV #30,R1 ; ON COLD START, MOVE 24. BYTES BR W2 WENT: ; WARM START ENTRY POINT MOV #12,R1 ; ON WARM START, MOVE TEN BYTES W2: MOV #ORIGIN+22,R5 ; START MOVING FROM HERE MOV ORIGIN+20,R0 ; MOVE TO THE USER AREA ADD #6,R0 ; PLUS 6 ADD R5,R1 ; COMPUTE LOOP STOP ADDRESS 1$: MOV (R5)+,(R0)+ CMP R5,R1 BLT 1$ MOV ORIGIN+24,RP ; INITIALIZE THE RETURN-STACK POINTER ; NOW SET FORTH'S INSTRUCTION COUNTER, AND GO MOV #GO,IP ; START EXECUTION WITH 'ABORT' NEXT ; NOTE - NORMALLY THE ABOVE INSTRUCTION WOULD BE 'MOV #ABORT+2,IP'. ; IT HAS BEEN CHANGED HERE TO ALLOW USER TO PATCH A DIFFERENT ; START-UP. BUT THE SYSTEM WON'T WORK UNTIL SOME OF THE WORK ; OF 'ABORT' HAS BEEN DONE, SO THAT WORK IS REPEATED. THE USER ; CAN PATCH OVER THE 'ABORT' AND THE ZEROS. ; GO: .WORD SPSTO,DEC,FORTH,DEFIN,ABORT,0,0,0 ; ; ; ; ; HEAD 204,S->D,240,STOD ; ***** S->D CLR -(S) ; SIGN EXTEND WITH ZEROS TST 2(S) ; BUT IF NEGATIVE, BPL 1$ DEC (S) ; CHANGE THE ZEROS TO ONES 1$: NEXT ; ; NOTE - THIS SYSTEM DOESN'T NEED THE OPERATIONS '+-' AND 'D+-', ; BECAUSE 'M*' AND 'M/' ARE DEFINED IN CODE. ; HEAD 203,ABS,323,ABS,DOCOL ; ***** ABS .WORD DUP,ZLESS,ZBRAN,XXR5-.,MINUS XXR5: .WORD SEMIS ; HEAD 204,DABS,240,DABS,DOCOL ; ***** DABS .WORD DUP,ZLESS,ZBRAN,XXRB-.,DMINU XXRB: .WORD SEMIS ; HEAD 203,MIN,316,MIN,DOCOL ; ***** MIN .WORD OVER,OVER,GREAT,ZBRAN,XXR7-.,SWAP XXR7: .WORD DROP,SEMIS ; HEAD 203,MAX,330,MAX,DOCOL ; ***** MAX .WORD OVER,OVER,LESS,ZBRAN,XXR6-.,SWAP XXR6: .WORD DROP,SEMIS ; HEAD 202,M*,240,MSTAR ; ***** M* .IFDF EIS ; HARDWARE MULTIPLY/DIVIDE? MOV (S)+,R0 MUL (S),R0 MOV R1,(S) MOV R0,-(S) NEXT .IFF MOV 2(S),-(RP) ; USE RETURN STACK FOR SAVING SIGN BPL 1$ NEG 2(S) ; GET ABSOLUTE VALUE 1$: TST (S) BPL 2$ NEG (RP) ; ADJUST SIGN WHICH WAS SAVED NEG (S) ; GET ABSOLUTE VALUE 2$: JSR PC,UMULT TST (RP)+ ; NEGATIVE RESULT? BPL 3$ ; NO ; IF GET HERE, NEGATE THE DOUBLE-INTEGER NUMBER ON THE STACK COM (S) COM 2(S) ADD #1,2(S) ADC (S) 3$: NEXT .ENDC ; HEAD 202,M/,240,MSLAS ; ***** M/ .IFDF EIS ; HARDWARD MULTIPLY/DIVIDE? ; MPH MOV 2(S),R0 ; MPH MOV 4(S),R1 ; MPH DIV (S)+,R0 ; MPH MOV R1,2(S) ; MPH MOV R0,(S) ; MPH NEXT ; MPH 5/84 VVVVVVVVVV MOV 2(S), R0 ;SET UP DIVIDEND IN R0 & R1 MOV 4(S), R1 ;R0 BECOMES QUOTIENT DIV (S), R0 ;R1 BECOMES REMAINDER TST R1 ;REMAINDER NEG OR ZERO? BLT 1$ ;YES, NEGATIVE BEQ 3$ ;NO REMAINDER, GET OUT TST (S) ;IF NOT WAS DIVISOR NEG? BMI 2$ ;YES,HAVE OPPOSIT SIGNS BR 3$ 1$: TST (S) ;DIVISOR NEGATIVE? BMI 3$ ; 2$: ADD (S), R1 ;CORRECT REMAINDER DEC R0 ;AND QUOTIENT 3$: ADD #2,S ;CLEAR STACK MOV R1, 2(S) MOV R0, (S) NEXT ; MPH 5/84 ^^^^^^^^^^ .IFF ; MPH 5/84 VVVVVVVVVV ; ; WARNING ; THE CODE HERE NEEDS TO BE CHECKED. SEE LOGIC IMMEDIATELY ABOVE. MOV (S), -(RP) ; SAVE DIVISOR MOV 2(S), -(RP) ; SAVE DIVIDEND SIGN BNE 5$ ; ZERO WON'T INDICATE SIGN CHANGE INC (RP) 5$: BPL 1$ ; IF GET HERE, TAKE ABSOLUTE VALUE OF DOUBLE-INTEGER DIVIDEND COM 2(S) COM 4(S) ADD #1, 4(S) ADC 2(S) 1$: TST (S) ; DIVISOR NEGATIVE? BPL 2$ ; NO NEG (RP) ; GIVES SIGN OF QUOTIENT NEG (S) ; TAKE ABS. VALUE OF DIVISOR 2$: JSR PC,UDIV ; (S) IS QUOTIENT AND 2(S) THE REMAINDER TST (RP)+ ; QUOTIENT NEGATIVE? BPL 3$ ; NO NEG (S) ; YES, NEGATE THE QUOTIENT TST 2(S) ; REMAINDER ZERO? BEQ 4$ ; YES, JUST LEAVE TST (RP) ; DIVISOR NEGATIVE? BLE 6$ ; BRANCH IF TRUE DEC (S) ; QUOTIENT < 0, DIVISOR > 0 NEG 2(S) ; NEGATE THE REMAINDER ADD (RP), 2(S) ; CORRECT THE REMAINDER BR 4$ ; JUST LEAVE 6$: DEC (S) ; QUOTIENT < 0, DIVISOR < 0, CORRECT QUOTIENT ADD (RP), 2(S) ; AND REMAINDER BR 4$ ; JUST LEAVE NOW 3$: TST (RP) ; QUOTIENT POSITIVE, IS DIVISOR NEGATIVE? BPL 4$ ; NO, JUST LEAVE TST 2(S) ; YES, REMAINDER ZERO? BEQ 4$ ; YES, JUST LEAVE NEG 2(S) ; NO, CORRECT REMAINDER 4$: ADD #2, RP ; CLEAR RP NEXT ; MPH 5/84 ^^^^^^^^^^ ; MPH MOV 2(S),-(RP) ; SAVE DIVIDEND SIGN ; MPH BNE 5$ ; ZERO WOULDN'T INDICATE ; MPH INC (RP) ; A SIGN CHANGE. ; MPH 5$: MOV (RP),-(RP) ; DUPLICATE IT ; MPH BPL 1$ ; IF GET HERE, TAKE ABSOLUTE VALUE OF DOUBLE-INTEGER DIVIDEND. ; MPH COM 2(S) ; MPH COM 4(S) ; MPH ADD #1,4(S) ; MPH ADC 2(S) ; MPH1$: TST (S) ; IS DIVISOR NEGATIVE? ; MPH BPL 2$ ; MPH NEG (RP) ; IF YES, NEGATE QUOTIENT SIGN ; MPH NEG (S) ; AND TAKE ABS. VALUE OF DIVISOR ; MPH 2$: JSR PC,UDIV ; MPH TST (RP)+ ; NEGATIVE QUOTIENT? ; MPH BPL 3$ ; NO ; MPH NEG (S) ; NEGATE THE QUOTIENT ; MPH 3$: TST (RP)+ ; NEGATIVE DIVIDEND? ; MPH BPL 4$ ; NEGATE THE REMAINDER ; MPH 5/84 NEG 2(S) ; MPH 5/84 4$: NEXT .ENDC ; HEAD 201,*,252,STAR,DOCOL ; ***** * .WORD MSTAR,DROP,SEMIS ; HEAD 204,/MOD,240,SLMOD,DOCOL ; ***** /MOD .WORD TOR,STOD,FROMR,MSLAS,SEMIS ; HEAD 201,/,257,SLASH,DOCOL ; ***** / .WORD SLMOD,SWAP,DROP,SEMIS ; HEAD 203,MOD,304,MOD,DOCOL ; ***** MOD .WORD SLMOD,DROP,SEMIS ; HEAD 205,*/MOD,304,SSMOD,DOCOL ; ***** */MOD .WORD TOR,MSTAR,FROMR,MSLAS,SEMIS ; HEAD 202,*/,240,SSLA,DOCOL ; ***** */ .WORD SSMOD,SWAP,DROP,SEMIS ; HEAD 205,M/MOD,304,MSMOD,DOCOL ; ***** M/MOD .WORD TOR,ZERO,R,USLAS,FROMR .WORD SWAP,TOR,USLAS,FROMR,SEMIS ; ; MPH 5/84 VVVVVVVVVV HEAD 202,D<,240,DLESS,DOCOL ; ***** D< .WORD DMINU,DPLUS,SWAP,DROP,ZLESS .WORD SEMIS ; ; ; HEAD 205,DEPTH,310,DEPTH,DOCOL ; ***** DEPTH ; STACK DEPTH .WORD SZERO,AT,SPAT,SUB .WORD TWOD,ONEM,SEMIS ; ; MPH 5/84 ^^^^^^^^^^ ; MPH 11/84 VVVVVVVVVV HEAD 204,PICK,240,PICK,DOCOL ; ***** PICK .WORD ONEP,TWO,STAR,SPAT,PLUS,AT,SEMIS ; HEAD 204,ROLL,240,ROLL,DOCOL ; ***** ROLL .WORD TOR,R,PICK,SPAT,DUP .WORD TWOP,FROMR,ONEP,TWO,STAR .WORD CMVUP,DROP,SEMIS ; ; MPH 11/84 ^^^^^^^^^^ ; ; ; ; ; .PAGE ; **************************************************************** ; ; DISK I/O (SECTION COMMON TO ALL OPERATING SYSTEMS) ; NOTE THAT EACH OPERATING SYSTEM DEFINED 'R/W' - READ ; OR WRITE A 1024-BYTE RANDOM-ACCESS BLOCK. ; ; **************************************************************** ; ; ; 'USE' AND 'PREV' MOVED TO USER AREA ; HEAD 204,+BUF,240,PBUF,DOCOL ; ***** +BUF .WORD BBUF,LIT,4,PLUS,PLUS,DUP,LIMIT,AT,EQUAL .WORD ZBRAN,XXT1-.,DROP,FIRST,AT XXT1: .WORD DUP,PREV,AT,SUB,SEMIS ; HEAD 206,UPDATE,240,UPDAT,DOCOL ; ***** UPDATE .WORD PREV,AT,AT,LIT,100000,OR,PREV .WORD AT,STORE,SEMIS ; HEAD 215,EMPTY-BUFFERS,323,MTBUF,DOCOL ; ***** EMPTY-BUFFERS .WORD FIRST,AT,LIMIT,AT,OVER,SUB,ERASE,SEMIS ; ; MPH 8/84 VVVVVVVVVV ; HEAD 214,SAVE-BUFFERS,240,SVBUF,DOCOL ; ***** SAVE-BUFFERS ; MPH HEAD 205,FLUSH,310,FLUSH,DOCOL ; ***** FLUSH ; SOME SYSTEMS DEFINE THIS IN THE EDITOR, NOT HERE. .WORD LIMIT,AT,FIRST,AT,XDO XXTA: .WORD I,AT,ZLESS,ZBRAN,XXT7-.,I,TWOP,I,AT .WORD LIT,77777,AND,DUP,I,STORE,ZERO,RW XXT7: .WORD BBUF,LIT,4,PLUS,XPLOO,XXTA-.,SEMIS ; HEAD 205,FLUSH,310,FLUSH,DOCOL ; ***** FLUSH .WORD SVBUF,MTBUF,SEMIS ; ; MPH 8/84 ^^^^^^^^^^ ; HEAD 203,DR0,260,DRZER,DOCOL ; ***** DR0 ; SELECT DRIVE #0 - NOT USED WITH RT11 OR RSX11 .WORD ZERO,OFSET,STORE,SEMIS ; HEAD 203,DR1,261,DRONE,DOCOL ; ***** DR1 ; SELECT DRIVE #1 - NOT USED IN RSX11 OR RT11 .WORD LIT,240.,OFSET,STORE,SEMIS ; HEAD 206,BUFFER,240,BUFFE,DOCOL ; ***** BUFFER .WORD USE,AT,DUP,TOR XXT2: .WORD PBUF,ZBRAN,XXT2-.,USE,STORE .WORD R,AT,ZLESS,ZBRAN,XXT3-. .WORD R,TWOP,R,AT,LIT,77777,AND .WORD ZERO,RW XXT3: .WORD R,STORE,R,PREV,STORE,FROMR,TWOP,SEMIS ; HEAD 205,BLOCK,313,BLOCK,DOCOL ; ***** BLOCK ; CHANGED TO MASK OFF THE UPDATE BIT WHEN COMPARING .WORD OFSET,AT,PLUS,TOR .WORD PREV,AT,DUP,AT,LIT,077777,AND,R,SUB,ZBRAN,XXT4-. XXT5: .WORD PBUF,ZEQU,ZBRAN,XXT6-. .WORD DROP,R,BUFFE .WORD DUP,R,ONE,RW,TWO,SUB XXT6: .WORD DUP,AT,LIT,077777,AND,R,SUB,ZEQU .WORD ZBRAN,XXT5-. .WORD DUP,PREV,STORE XXT4: .WORD FROMR,DROP,TWOP,SEMIS ; ; ; ; ; ; HEAD 206,(LINE),240,PLINE,DOCOL ; ***** (LINE) .WORD TOR,CL,BBUF,SSMOD,FROMR,BSCR .WORD STAR,PLUS,BLOCK,PLUS,CL,SEMIS ; HEAD 205,.LINE,305,DLINE,DOCOL ; ***** .LINE .WORD PLINE,DTRAI,TYPE,SEMIS ; HEAD 207,MESSAGE,305,MESS,DOCOL ; ***** MESSAGE .WORD WARN,AT,ZBRAN,XXW5-.,DDUP,ZBRAN,XXW3-.,LIT,4 .WORD OFSET,AT,BSCR,SLASH,SUB,DLINE XXW3: .WORD BRAN,XXW4-. XXW5: .WORD PDOTQ .BYTE 6 .ASCII /MSG # / .EVEN .WORD DOT XXW4: .WORD SEMIS ; HEAD 204,LOAD,240,LOAD,DOCOL ; ***** LOAD .WORD BLK,AT,TOR,IN,AT,TOR,ZERO,IN,STORE .WORD BSCR,STAR,BLK,STORE,INTER,FROMR,IN,STORE .WORD FROMR,BLK,STORE,SEMIS ; HEAD 303,-->,276,ARROW,DOCOL ; ***** --> .WORD QLOAD,ZERO,IN,STORE,BSCR,BLK,AT,OVER .WORD MOD,SUB,BLK,PSTOR,SEMIS ; ; ; ; ; NOTE - THE INSTALLATION-DEPENDENT I/O IS AT THE END ; OF THE DICTIONARY - JUST BELOW 'TASK'. 'XI/O' IS THE ; PRIMITIVE READ OR WRITE OF A 512-BYTE BLOCK. ; ; ; ; ; ; .PAGE ; **************************************************************** ; ; MISCELLANEOUS HIGHER LEVEL ; ; **************************************************************** ; ; ; MPH HEAD 301,',247,TICK,DOCOL ; ***** ' ; MPH 3/84 .WORD DFIND,ZEQU,ZERO,QERR,DROP,LITER,SEMIS ; MPH 3/84 VVVVVVVVVV HEAD 201,',247,TICK,DOCOL ; THE FUNCTION OF ' INSIDE A COLON ; DEFINITION IS TAKEN OVER BY [']. .WORD DFIND,ZEQU,ZERO,QERR,DROP .WORD TWOM,LITER,SEMIS ; MUST PUT CFA ON STACK ; MPH 3/84 ^^^^^^^^^^ ; ; MPH 11/84 VVVVVVVVVV HEAD 303,['],335,BTICK,DOCOL ; ***** ['] ; USED INSIDE A COLON DEFINITION. ; LOOK AHEAD IMMEDIATELY AND COMPILE ; THE ADDRESS OF THE NEXT ; WORD IN THE INPUT STREAM ; AS A LITERAL .WORD DFIND,ZEQU,ZERO,QERR .WORD DROP,TWOM,LITER,SEMIS ; MPH 11/84 ^^^^^^^^^^ HEAD 206,FORGET,240,FORGE,DOCOL ; ***** FORGET ; MPH 3/84 .WORD CURR,AT,CONT,AT,SUB,LIT,30,QERR,TICK,DUP ; MPH 3/84 VVVVVVVVVV .WORD CURR,AT,CONT,AT,SUB,LIT,30,QERR .WORD TICK,TWOP,DUP ; UNDO MY CHANGE IN TICK ; MPH 3/84 ^^^^^^^^^^ .WORD FENCE,AT,LESS,LIT,25,QERR .WORD DUP,NFA,DP,STORE,LFA,AT,CONT,AT .WORD STORE,SEMIS ; ; ; ; HEAD 204,BACK,240,BACK,DOCOL ; ***** BACK .WORD HERE,SUB,COMMA,SEMIS ; HEAD 305,BEGIN,316,BEGIN,DOCOL ; ***** BEGIN .WORD QCOMP,HERE,ONE,SEMIS ; HEAD 305,ENDIF,306,ENDIF,DOCOL ; ***** ENDIF .WORD QCOMP,TWO,QPAIR,HERE,OVER,SUB,SWAP,STORE,SEMIS ; HEAD 304,THEN,240,THEN,DOCOL ; ***** THEN .WORD ENDIF,SEMIS ; ; MPH 10/84 VVVVVVVVVV HEAD 302,DO,240,DO,DOCOL ; ***** DO ; AFTER F83 MODEL .WORD COMP,XMDO,HERE,ZERO,COMMA .WORD LIT,3,SEMIS ; HEAD 305,LEAVE,305,LEAVE,DOCOL ; ***** LEAVE ; AFTER F83 MODEL .WORD COMP,PMLEAV,SEMIS ; HEAD 304,LOOP,240,LOOP,DOCOL ; ***** LOOP ; AFTER F83 MODEL .WORD LIT,3,QPAIR,COMP,XMLOOP .WORD DUP,TWOP,BACK ; LOOP BACK .WORD HERE,SWAP,STORE,SEMIS ; FOR LEAVE ; HEAD 305,+LOOP,320,PLOOP,DOCOL ; ***** +LOOP .WORD LIT,3,QPAIR,COMP,XPMLOO .WORD DUP,TWOP,BACK .WORD HERE,SWAP,STORE,SEMIS ; ; MPH 10/84 ^^^^^^^^^^ ; ; MPH HEAD 302,DO,240,DO,DOCOL ; ***** DO ; MPH .WORD COMP,XDO,HERE,LIT,3,SEMIS ; MPH; ; MPH; ; MPH HEAD 304,LOOP,240,LOOP,DOCOL ; ***** LOOP ; MPH .WORD LIT,3,QPAIR,COMP,XLOOP,BACK,SEMIS ; MPH; ; MPH HEAD 305,+LOOP,320,PLOOP,DOCOL ; ***** +LOOP ; MPH .WORD LIT,3,QPAIR,COMP,XPLOO,BACK,SEMIS ; HEAD 305,UNTIL,314,UNTIL,DOCOL ; ***** UNTIL .WORD ONE,QPAIR,COMP,ZBRAN,BACK,SEMIS ; HEAD 303,END,304,END,DOCOL ; ***** END .WORD UNTIL,SEMIS ; HEAD 305,AGAIN,316,AGAIN,DOCOL ; ***** AGAIN .WORD ONE,QPAIR,COMP,BRAN,BACK,SEMIS ; HEAD 306,REPEAT,240,REPEAT,DOCOL ; ***** REPEAT .WORD TOR,TOR,AGAIN,FROMR,FROMR,TWO,SUB,ENDIF,SEMIS ; HEAD 302,IF,240,IF,DOCOL ; ***** IF .WORD COMP,ZBRAN,HERE,ZERO,COMMA,TWO,SEMIS ; HEAD 304,ELSE,240,ELSE,DOCOL ; ***** ELSE .WORD TWO,QPAIR,COMP,BRAN,HERE,ZERO,COMMA .WORD SWAP,TWO,ENDIF,TWO,SEMIS ; HEAD 305,WHILE,305,WHILE,DOCOL ; ***** WHILE .WORD IF,TWOP,SEMIS ; ; ; ; HEAD 206,SPACES,240,SPACS,DOCOL ; ***** SPACES .WORD ZERO,MAX,DDUP,ZBRAN,XXR4-.,ZERO,XDO XXRA: .WORD SPACE,XLOOP,XXRA-. XXR4: .WORD SEMIS ; HEAD 202,^/<#/,240,BDIGS,DOCOL ; ***** <# .WORD PAD,HLD,STORE,SEMIS ; HEAD 202,#>,240,EDIGS,DOCOL ; ***** #> .WORD DROP,DROP,HLD,AT,PAD,OVER,SUB,SEMIS ; HEAD 204,SIGN,240,SIGN,DOCOL ; ***** SIGN ; MPH .WORD ROT,ZLESS,ZBRAN,XXR1-.,LIT,55,HOLD ; MPH 11/84 VVVVVVVVVV .WORD ZLESS,ZBRAN,XXR1-.,LIT,55,HOLD ; MPH 11/84 ^^^^^^^^^^ XXR1: .WORD SEMIS ; HEAD 201,#,243,DIG,DOCOL ; ***** # .WORD BASE,AT,MSMOD,ROT,LIT,11,OVER,LESS .WORD ZBRAN,XXR2-.,LIT,7,PLUS XXR2: .WORD LIT,60,PLUS,HOLD,SEMIS ; HEAD 202,#S,240,DIGS,DOCOL ; ***** #S XXR3: .WORD DIG,OVER,OVER,OR,ZEQU,ZBRAN,XXR3-.,SEMIS ; HEAD 203,D.R,322,DDOTR,DOCOL ; ***** D.R ; MPH .WORD TOR,SWAP,OVER,DABS,BDIGS,DIGS,SIGN,EDIGS ; MPH .WORD FROMR,OVER,SUB,SPACS,TYPE,SEMIS ; MPH 2/85 VVVVVVVVVV .WORD TOR,SWAP,OVER,DABS,BDIGS,DIGS,ROT .WORD SIGN,EDIGS,FROMR,OVER,SUB,SPACS,TYPE,SEMIS ; MPH 2/85 ^^^^^^^^^^ ; HEAD 202,.R,240,DOTR,DOCOL ; ***** .R .WORD TOR,STOD,FROMR,DDOTR,SEMIS ; HEAD 202,D.,240,DDOT,DOCOL ; ***** D. .WORD ZERO,DDOTR,SPACE,SEMIS ; HEAD 201,.,256,DOT,DOCOL ; ***** . .WORD STOD,DDOT,SEMIS ; HEAD 201,?,277,QUEST,DOCOL ; ***** ? .WORD AT,DOT,SEMIS ; HEAD 202,U.,240,UDOT,DOCOL ; ***** U. .WORD ZERO,DDOT,SEMIS ; ; UTILITY SECTION. ; ; HEAD 204,LIST,240,LIST,DOCOL ; ***** LIST ; ( N---. LIST GIVEN SCREEN.) .WORD DEC,CR,DUP,SCR,STORE,PDOTQ .BYTE 6 .ASCII /SCR # / .EVEN .WORD DOT,LIT,20,ZERO,XDO XXZ1: .WORD CR,I,THREE,DOTR,SPACE .WORD I,SCR,AT,DLINE,XLOOP,XXZ1-.,CR,SEMIS ; HEAD 205,INDEX,330,INDEX,DOCOL ; ***** INDEX ; LIST FIRST LINE OF A RANGE OF DISK SCREENS. .WORD CR,ONEP,SWAP,XDO XXZ2: .WORD CR,I,THREE,DOTR,SPACE,ZERO,I,DLINE ; MPH .WORD QTERM,ZBRAN,XXZ3-.,LEAVE ; MPH 10/84 VVVVVVVVVV .WORD QTERM,ZBRAN,XXZ3-.,PLEAV ; MPH OLD LEAVE RENAMED PLEAV ; MPH 10/84 ^^^^^^^^^^ XXZ3: .WORD XLOOP,XXZ2-.,SEMIS ; HEAD 205,TRIAD,304,TRIAD,DOCOL ; ***** TRIAD ; LIST DISK SCREENS THREE PER PAGE. .WORD LIT,14,EMIT ; FORM FEED .WORD THREE,SLASH,THREE,STAR,THREE .WORD OVER,PLUS,SWAP,XDO XXZ4: .WORD CR,I,LIST,XLOOP,XXZ4-.,CR,LIT,17,MESS,CR,SEMIS ; HEAD 205,VLIST,324,VLIST,DOCOL ; ***** VLIST .WORD LIT,200,OUT,STORE,CONT,AT,AT XXZ5: .WORD OUT,AT,LIT,100,GREAT,ZBRAN,XXZ6-. .WORD CR,ZERO,OUT,STORE XXZ6: .WORD DUP,IDDOT,SPACE,SPACE,PFA,LFA,AT .WORD DUP,ZEQU,QTERM,OR,ZBRAN,XXZ5-.,DROP,SEMIS ; .IFDF LINKS HEAD 205,VLINK,313,XVLINK,DOCON ; ***** VLINK ; THIS IS ONLY USED FOR LINKAGE FROM FORTH TO SUBROUTINES ; IN OTHER LANGUAGES. SEE USER'S GUIDE FOR DOCUMENTATION. .WORD VLINK .ENDC ; ; ; ; ; ; .PAGE ; **************************************************************** ; ; INSTALLATION-DEPENDENT SECTION (TERMINAL AND DISK I/O, AND TRAPS) ; ; **************************************************************** ; ; ; *************** ; ; RSX-11M TERMINAL I/O ; ; *************** ; .IFDF RSX11 ; .EVEN ; NOTE - FOR RSX-11 ON HEAVILY LOADED MACHINES, IT IS BETTER ; FOR 'KEY' TO READ A WHOLE LINE AT A TIME, AND UNPACK IT. ; ALSO, 'KEY' SHOULD EMIT A LINE FEED WHEN A CARRIAGE RETURN ; HAS BEEN READ. ; MPH 8/85 VVVVVVVVVV ; NOTE - KEY READS A WHOLE LINE ONLY IF LOADED=1. ; ; MPH 8/85 ^^^^^^^^^^ PEMIT: JSR R1,ITERM ; INITIALIZE RSX? ; INCREMENT 'OUT', UNLESS A CONTROL CHARACTER BEING OUTPUT. CMP (S),#40 ; TEST FOR CONTROL CHARACTER BLT 1$ INC 42(U) ; INCREMENT 'OUT' 1$: JSR R1,XCOUT ; OUTPUT A CHARACTER NEXT ; ; MPH 8/85 VVVVVVVVVV .IFDF LOADED ; .IFT ; MPH 8/85 ^^^^^^^^^^ PKEY: JSR R1,ITERM ; INITIALIZE RSX? TST INTERM ; ZERO MEANS READ NEW LINE BNE XCHAR XLINE: MOV #XBUFF,INTERM ; READ NEW LINE QIOW$C IO.RVB,4,4,,IOSTAT,, ADD #XBUFF,IOSTAT+2 ; TERMINATE LINE WITH CR MOVB #15,@IOSTAT+2 XCHAR: TST -(S) ; DECREMENT STACK POINTER MOVB @INTERM,(S) ; FOR THIS BYTE INSTRUCTION INC INTERM BIC #177600,(S) CMP (S),#15 ; IF CR IS BEING SENT, BNE XRETRN CLR INTERM ; THEN READ NEW LINE NEXT TIME. MOV #12,-(S) ; AND ALSO EMIT A LINE FEED JSR R1,XCOUT XRETRN: NEXT ; .IFF PKEY: JSR R1, ITERM ; INITIALIZE RSX? XCHAR: QIOW$C IO.RAL,4,4,,IOSTAT,, TST -(S) ; DECREMENT STACK POINTER MOVB XBUFF, (S) ; FOR THIS BYTE INSTRUCTION BIC #177600, (S) CMP (S), #15 ; CR? BNE XRETRN ; NO MOV #12, -(S) ; YES, ADD A LF JSR R1, XCOUT XRETRN: NEXT .ENDC ; MPH 8/85 ^^^^^^^^^^ ; ; MPH 2/85 VVVVVVVVVV ; .IFDF EMUL .IFT ; ; RSTS/E DOES NOT SUPPORT UNSOLICITED I/O ; AND AS A RESULT ?TERMINAL WILL NOT FUNCTION ; PROPERLY. THE BEST APPROXIMATION I COULD ; THINK OF WAS THE ^C TRAP SHOWN HERE. ; ; FOR DESCRIPTIONS SEE THE RSTS/E SYSTEM DIRECTIVES ; MANUAL PG 2-23 & 24. SEE ALSO SCCA$S IN SECT. 5.19 ; PG 5-46. ; ; AST1: EMT 26 ; RESET ^O TRAP MOV #-1,QFLAG ; MOVE TRUE TO QFLAG SCCA$S #AST1 ; RESET ^C TRAP RTI ; THE PROPER EXIT ROUTINE ; PQTER: JSR R1,ITERM ; INITIALIZE RSX? MOV QFLAG,-(S) CLR QFLAG NEXT ; .IFF ; DO THE FOLLOWING IN A PURE RSX CASE ; ; MPH 2/85 ^^^^^^^^^^ PQTER: JSR R1,ITERM ; INITIALIZE RSX? MOV QFLAG,-(S) CLR QFLAG NEXT ; PUT THE AST ROUTINE HERE AST1: MOV (RP)+,QFLAG ; SET UP FOR NEXT '?TERMINAL'; ; NOTE THAT 'RP' IS SYSTEM STACK. CMP QFLAG,#3 ; TEST FOR ^C BNE 1$ 1$: ASTX$S ; ; MPH 2/85 VVVVVVVVVV .ENDC ; EMUL ; MPH 2/85 ^^^^^^^^^^ ; PCR: JSR R1,ITERM ; INITIALIZE RSX? MOV #15,-(S) JSR R1,XCOUT MOV #12,-(S) JSR R1,XCOUT NEXT ; XCOUT: MOV (S)+,IOCHR ; MPH QIOW$C IO.WVB!TF.WAL,4,4,,IOSTAT,, ; MPH 11/84 VVVVVVVVVV ; TF.WAL GIVES AN UNDEFINED GLOBAL ERROR IN TKB. ; SEE RSX-11M/M- PLUS ; I/O DRIVERS REFERENCE MANUAL ; PAGE 2-8 QIOW$C IO.WAL,4,4,,IOSTAT,, ; MPH 11/84 ^^^^^^^^^^ RTS R1 ; ITERM: ; INITIALIZE RSX IF FIRST TIME THROUGH CMP INTERM,#-1 ; FIRST TIME TERMINAL I/O? BNE RSXRTS CLR INTERM ; YES ALUN$C 4,TI,0 ; ASSIGN LUN ; MPH 2/85 VVVVVVVVVV ; ; RSTS/E CAN NOT PROCESS UNSOLICITED I/O. ; THE BEST APPROXIMATION I COULD THINK OF WAS ; THE ^C TRAP. ; .IFDF EMUL .IFT SCCA$S #AST1 ; ^C TRAP ROUTINE ADDRESS TO #24 .IFF ; MPH 2/85 ^^^^^^^^^^ ; MPH QIOW$C IO.ATA,4,,,,, ; ATTACH - UNSOLICITED I/O ; MPH 11/84 VVVVVVVVVV ; I THINK THERE IS AN ERROR HERE. ; TOO MANY COMMAS. QIOW$C IO.ATA,4,,,, ; MPH 11/84 ^^^^^^^^^^ ; MPH 2/85 VVVVVVVVVV .ENDC ; MPH 2/85 ^^^^^^^^^^ SVTK$S #TRAPV,#6 ; SET UP FOR TRAPS RSXRTS:RTS R1 INTERM: .WORD -1 ; FLAG FOR FIRST TIME TERMINAL I/O. ; DO NOT REINITIALIZE 'INTERM' AT COLD START, LEST ASSIGNMENT DONE TWICE. IOCHR: .WORD 0 ; TEMPORARY AREA FOR 'KEY' AND 'EMIT' QFLAG: .WORD 0 ; FOR '?TERMINAL' XBUFF: .BLKB 82. ; TERMINAL BUFFER FOR RSX LINE I/O ; ; ; HEAD 203,BYE,305,BYE ; ***** BYE (LOG OFF) CLOSE$ #FDBIO ; CLOSE DISK I/O CLOSE$ #SFDBIO EXIT$S ; ; ; *************** ; ; RSX11-M DISK I/O ; ; *************** ; ; MPH 12/84 VVVVVVVVVV ; THIS SECTION IS THE WORK OF V. VINGE ; IT IS INTENDED FOR AN EDUCATIONAL APPLICATION TEACHING THE FORTH ; LANGUAGE. IN THIS APPLICATION THE FIRST TSIZE RECORDS ARE READ ONLY ; EXCEPT FOR ACCOUNT #TGRP,#TMEM WHICH HAS ALL PRIVILEGES. THE SECOND ; TSIZE RECORDS ARE IN THE STUDENT'S ACCOUNT WITH BOTH READ AND WRITE ; PRIVILEGES. ; ; MPH 12/84 ^^^^^^^^^^ ; ; HEAD 204,XI/O,240,XIO,DOCOL ; ***** XI/O (RSX) ; MPH 12/84 VVVVVVVVVV ; THIS VERSION OF XI/O CALLS TI/O (TEACHER I/O), ; SI/O (STUDENT I/O) DEPENDING ON THE SCREEN NUMBER. .WORD SWAP,DUP,LIT,TSIZE,GREAT,ZBRAN,XXV1-. .WORD OVER,LIT,TSIZE,GREAT,ZBRAN,XXV1-. .WORD SWAP,LIT,TSIZE,SUB,SWAP,SIO,BRAN,XXV2-. XXV1: .WORD TIO XXV2: .WORD SEMIS ; ; MPH 12/84 ^^^^^^^^^^ ; HEAD 204,TI/O,240,TIO ; ***** TI/O (RSX) ; PHYSICAL READ-WRITE ; ADDRESS BLOCK# FLAG ==> REPORT. READS OR WRITES A 512-BYTE BLOCK. ; FLAG 1=READ, 0=WRITE. REPORT '0'=GOOD I/O, '1'=I/O ERROR. ; IF REPORT IS '1', THEN NEXT ON STACK IS '1'=OPEN ERROR, ; '2'=READ ERROR, '3'=WRITE ERROR, '4'=WAIT ERROR, '5'=ARGUMENT ; ERROR (FLAG NOT '0' OR '1'). CLR DSKERR ; FOR I/O ERROR REPORT TST OPENF ; DISK FILE ALREADY OPENED? BNE 2$ ; MPH 12/84 VVVVVVVVVV GTSK$S #TSKDSC CMPB TSKDSC+G.TSGC,#TGRP BNE 3$ CMPB TSKDSC+G.TSPC,#TMEM BNE 3$ OPEN$M #FDBIO ; INSTRUCTOR OPEN READ/WRITE BR 4$ 3$: OPEN$R #FDBIO ; STUDENT OPEN READ ONLY 4$: ; OPEN$M #FDBIO BCC 2$ MOV #1,DSKERR ; ERROR IN OPEN BR ERRR 2$: MOV #1,OPENF ; INDICATE FILE IS OPEN CLR VIRBLK MOV 2(S),VIRBLK+2 ; SET UP VIRTUAL BLOCK NUMBER MOV 4(S),IOADDR ; SET UP I/O ADDRESS TST (S) ; WAS TOP OF STACK - READ OR WRITE? BEQ WRITE CMP (S),#1 BEQ READ MOV #5,DSKERR ; ERROR, FLAG NOT EITHER '0' OR '1' BR ERRR READ: READ$ #FDBIO,IOADDR,,#VIRBLK,#2 BCC WAIT MOV #2,DSKERR ; ERROR IN READ BR ERRR WRITE: WRITE$ #FDBIO,IOADDR,,#VIRBLK,#2 BCC WAIT MOV #3,DSKERR ; ERROR IN WRITE BR ERRR WAIT: WAIT$ BCC DONE MOV #4,DSKERR ; ERROR IN WAIT BR ERRR DONE: ADD #6,S CLR -(S) ; INDICATE GOOD I/O BR DONE2 ERRR: ADD #6,S MOV DSKERR,-(S) ; RETURN THE ERROR INDICATOR MOV #1,-(S) ; INDICATE ERROR IN I/O DONE2: NEXT FSRSZ$ 0 FDBIO: FDBDF$ FDRC$A FD.RWM FDBK$A ,512.,,2,IOSTAT FDOP$A 3,DESCR,,FO.MFY ; MPH 12/84 VVVVVVVVVV ; DESCR: .WORD DEVSZ,DEV .WORD DIRSZ,DIR .WORD FILSZ,FIL ; ; INITIALIZATION ; EDIT THE DEVICE, DIRECTORY, AND FILENAME ; TO SUIT YOUR NEEDS DEV: .ASCII /DB2:/ DEVSZ=.-DEV DIR: .ASCII /[19,116]/ DIRSZ=.-DIR FIL: .ASCII /TEACHER.DAT/ ;DESCR: .WORD 0,0 ; USE DEFAULT DEVICE ; .WORD 0,0 ; AND DIRECTORY. ; .WORD FILSZ,FIL ;FIL: .ASCII /FORTH.DAT/ ; MPH 12/84 ^^^^^^^^^^ FILSZ=.-FIL .EVEN ; OPENF: .WORD 0 ; FLAG FOR FIRST TIME DISK I/O ; DO NOT INITIALIZE 'OPENF' AT COLD START DSKERR: .WORD 0 ; SPACE FOR DISK ERROR MESSAGE IOADDR: .WORD 0 ; ADDRESS FOR DISK READ/WRITE IOSTAT: .BLKW 2 ; I/O STATUS REPORT VIRBLK: .BLKW 2 ; VIRTUAL BLOCK NUMBER ; ; MPH 12/84 VVVVVVVVVV ; TSKDSC: .BLKW 16. ;WHERE GTSK$S PUTS TASK DESC ; HEAD 204,SI/O,240,SIO ; ***** SI/O (RSX) ; STUDENT I/O ALMOST THE OLD JAMES XI/0 ; ; PHYSICAL READ-WRITE ; ADDRESS BLOCK# FLAG ==> REPORT. READS OR WRITES A 512-BYTE BLOCK. ; FLAG 1=READ, 0=WRITE. REPORT '0'=GOOD I/O, '1'=I/O ERROR. ; IF REPORT IS '1', THEN NEXT ON STACK IS '1'=OPEN ERROR, ; '2'=READ ERROR, '3'=WRITE ERROR, '4'=WAIT ERROR, '5'=ARGUMENT ; ERROR (FLAG NOT '0' OR '1'). CLR SDSKERR ; FOR I/O ERROR REPORT TST SOPENF ; DISK FILE ALREADY OPENED? BNE 2$ OPEN$M #SFDBIO BCC 2$ MOV #1,SDSKERR ; ERROR IN OPEN BR SERRR 2$: MOV #1,SOPENF ; INDICATE FILE IS OPEN CLR SVIRBLK MOV 2(S),SVIRBLK+2 ; SET UP VIRTUAL BLOCK NUMBER MOV 4(S),SIOADDR ; SET UP I/O ADDRESS TST (S) ; WAS TOP OF STACK - READ OR WRITE? BEQ SWRITE CMP (S),#1 BEQ SREAD MOV #5,SDSKERR ; ERROR, FLAG NOT EITHER '0' OR '1' BR SERRR SREAD: READ$ #SFDBIO,SIOADDR,,#SVIRBLK,#2 BCC SWAIT MOV #2,SDSKERR ; ERROR IN READ BR SERRR SWRITE: WRITE$ #SFDBIO,SIOADDR,,#SVIRBLK,#2 BCC SWAIT MOV #3,SDSKERR ; ERROR IN WRITE BR SERRR SWAIT: WAIT$ BCC SDONE MOV #4,SDSKERR ; ERROR IN WAIT BR SERRR SDONE: ADD #6,S CLR -(S) ; INDICATE GOOD I/O BR SDONE2 SERRR: ADD #6,S MOV SDSKERR,-(S) ; RETURN THE ERROR INDICATOR MOV #1,-(S) ; INDICATE ERROR IN I/O SDONE2: NEXT FSRSZ$ 0 SFDBIO: FDBDF$ FDRC$A FD.RWM FDBK$A ,512.,,2,SIOSTAT FDOP$A 2,SDESCR,,FO.MFY ; DIFFERENT LUN FROM ABOVE. ; ; INITIALIZATION ; EDIT THE NAME OF THE STUDENT FILE TO FIT YOUR NEEDS ; THIS CODE ASSUMES THIS FILE IS ON THE SYSTEM DISK. ; IF THIS LOCATION IS TO BE CHANGED RECODE LIKE XI/O ABOVE. SDESCR: .WORD 0,0 ; USE DEFAULT DEVICE .WORD 0,0 ; AND DIRECTORY. .WORD SFILSZ,SFIL SFIL: .ASCII /STUDENT.DAT/ SFILSZ=.-SFIL .EVEN ; SOPENF: .WORD 0 ; FLAG FOR FIRST TIME DISK I/O ; DO NOT INITIALIZE 'OPENF' AT COLD START SDSKERR: .WORD 0 ; SPACE FOR DISK ERROR MESSAGE SIOADDR: .WORD 0 ; ADDRESS FOR DISK READ/WRITE SIOSTAT: .BLKW 2 ; I/O STATUS REPORT SVIRBLK: .BLKW 2 ; VIRTUAL BLOCK NUMBER ; HEAD 212,BLOCK-READ,240,BREAD,DOCOL ; ***** BLOCK-READ ; ( ADDRESS BLOCK# ==> REPORT). REPORT: 0=GOOD READ, ELSE ERROR .WORD ONE,XIO,SEMIS ; HEAD 213,BLOCK-WRITE,305,BWRIT,DOCOL ; ***** BLOCK-WRITE ; ( ADDRESS BLOCK# ==> REPORT). REPORT: 0=GOOD WRITE, ELSE ERROR .WORD ZERO,XIO,SEMIS ; HEAD 203,I/O,317,IO,DOCOL ; ***** I/O ; READ OR WRITE 512-BYTE BLOCK, HANDLE ERRORS. ; ( ADDRESS BLOCK# FLAG(1=READ,0=WRITE) ==> ) .WORD DUP,ONE,EQUAL,ZBRAN,XXS1-.,DROP,BREAD .WORD ZBRAN,XXS2-.,CR,PDOTQ .BYTE 22 .ASCII /DISK READ ERROR # / .EVEN .WORD DOT,ABORT XXS2: .WORD BRAN,XXS3-. XXS1: .WORD ZEQU,ZBRAN,XXS4-.,BWRIT,ZBRAN,XXS5-. .WORD CR,PDOTQ .BYTE 23 .ASCII /DISK WRITE ERROR # / .EVEN .WORD DOT,ABORT XXS5: XXS4: XXS3: .WORD SEMIS ; HEAD 203,R/W,327,RW,DOCOL ; ***** R/W ; READ OR WRITE 1024-BYTE SCREEN. ( ADDRESS SCREEN# FLAG ==> ) ; NOTE THAT SCREEN N IS BLOCKS 2N-1 AND 2N. .WORD TOR,TWO,STAR,OVER,OVER,ONE,SUB,R,IO .WORD SWAP,LIT,512.,PLUS .WORD SWAP,FROMR,IO,SEMIS ; .ENDC ; ; *************** ; ; RT-11 TERMINAL I/O ; ; *************** ; .IFDF RT11 ITERM: CMP INTERM,#-1 BNE RTRTS CLR INTERM .RCTRLO ; RESET CNTL-O .TRPSET #TRAPBL,#TRAPZ RTRTS: RTS R1 ; PEMIT: JSR R1,ITERM ; INCREMENT 'OUT', UNLESS A CONTROL CHARACTER BEING OUTPUT. CMP (S),#40 ; TEST FOR CONTROL CHARACTER BLT 1$ INC 42(U) ; INCREMENT 'OUT' 1$: JSR R1,XCOUT NEXT ; ; MPH 8/85 VVVVVVVVVV .IFDF LOADED .IFF ; PKEY: JSR R1,ITERM MOV 44, R1 ; SAVE JSW BIS #10000,44 ; SET BIT 12 OF JSW ; RETURN CONTROL ONLY WHEN ; CHARACTER IS AVAILABLE INTST: .TTYIN BIC #177600,R0 ; CLEAR ALL BUT LOW 7 BITS CMP R0, #12 ; IGNORE LF BEQ INTST MOV R1, 44 ; RESTORE JSW MOV R0, -(S) .TTYOUT ; ECHO THE CHARACTER CMP R0, #15 ; CR? BNE 1$ ; NO MOV #12, R0 ; APPEND LF TO CR .TTYOUT ; 1$: NEXT ; .IFT ; ; MPH 8/85 ^^^^^^^^^^ PKEY: JSR R1,ITERM .TTYIN BIC #177600,R0 CMP R0,#12 ; IGNORE LINEFEED BEQ PKEY MOV R0,-(S) NEXT ; MPH 8/85 VVVVVVVVVV .ENDC ; MPH 8/85 ^^^^^^^^^^ ; PQTER: JSR R1,ITERM MOV 44,-(RP) ; SAVE JSW BIS #10100,44 ; SET BITS 6 AND 12 OF JSW .TTINR BCC 1$ ; IF CARRY SET, NO CHARACTER - SUPPLY ZERO CLR R0 1$: BIC #177600,R0 CMP R0,#12 ; IGNORE LINEFEED BNE 2$ CLR R0 2$: MOV R0,-(S) MOV (RP)+,44 ; RESTORE JSW NEXT ; PCR: JSR R1,ITERM MOV #15,-(S) JSR R1,XCOUT MOV #12,-(S) JSR R1,XCOUT NEXT ; XCOUT: MOV (S)+,R0 .TTYOUT RTS R1 ; INTERM: .WORD -1 ; FLAG FOR FIRST TIME TERMINAL I/O ; DO NOT INITIALIZE 'INTERM' AT COLD START IOCHR: .WORD 0 ; TEMPORARY AREA FOR 'KEY', 'EMIT' ; HEAD 203,BYE,305,BYE ; ***** BYE (RT) .EXIT ; ; ; *************** ; ; RT-11 DISK I/O ; ; *************** ; HEAD 204,XI/O,240,XIO ; ***** XI/O (RT) CLR DSKERR TST OPENF BNE RTOPEN MOV #1,OPENF ; INDICATE FILE IS OPEN ; NOW OPEN THE FILE .SETTOP #-2 MOV #RTSTAT,R1 .DSTATUS R1,#RTFILE BCC 1$ MOV #1,DSKERR BR RTRET 1$: TST 4(R1) ; HANDLER IN? BNE 2$ .FETCH HANDLR,#RTFILE BCC 2$ MOV #2,DSKERR BR RTRET 2$: .LOOKUP #LOOK1,#0,#RTFILE BCC RTOPEN MOV #3,DSKERR BR RTRET RTOPEN: ; FILE IS OPEN - NOW READ IT MOV 2(S),R1 ; BLOCK # DEC R1 ; BEGINS AT 1 IN FORTH MOV 4(S),IOADDR ; BUFFER ADDRESS TST (S) BEQ WRITE CMP (S),#1 BEQ READ MOV #5,DSKERR BR RTRET READ: .READW #RTBLK,#0,IOADDR,,R1 BCC 1$ MOV #6,DSKERR 1$: BR RTRET WRITE: .WRITW #RTBLK,#0,IOADDR,,R1 BCC 2$ MOV #7,DSKERR 2$: BR RTRET RTRET: ADD #6,S MOV DSKERR,-(S) TST DSKERR BEQ 1$ MOV #1,-(S) ; INDICATE ERROR OCCURRED 1$: NEXT ; ; INITIALIZATION ; THE FOLLOWING CODE ASSUMES THE FORTH SCREENS ARE ON ; DEVICE DK IN A FILE WITH NAME FORTH AND EXTENSION DAT. RTFILE: .RAD50 /DK FORTH DAT/ RTBLK: .BYTE 0,10 .WORD 0,0,256.,0 ; OPENF: .WORD 0 ; FLAG FOR FIRST TIME DISK I/O DSKERR: .WORD 0 ; SPACE FOR DISK ERROR MESSAGE IOADDR: .WORD 0 ; ADDRESS FOR DISK READ/WRITE RTSTAT: .BLKW 4 ; DISK I/O STATUS LOOK1: .BLKW 3 ; EMT ARGUMENT BLOCK TRAPBL: .BLKW 2 ; EMT ARGUMENT BLOCK ; ; HEAD 212,BLOCK-READ,240,BREAD,DOCOL ; ***** BLOCK-READ ; ( ADDRESS BLOCK# ==> REPORT). REPORT: 0=GOOD READ, ELSE ERROR .WORD ONE,XIO,SEMIS ; HEAD 213,BLOCK-WRITE,305,BWRIT,DOCOL ; ***** BLOCK-WRITE ; ( ADDRESS BLOCK# ==> REPORT). REPORT: 0=GOOD WRITE, ELSE ERROR .WORD ZERO,XIO,SEMIS ; HEAD 203,I/O,317,IO,DOCOL ; ***** I/O ; READ OR WRITE 512-BYTE BLOCK, HANDLE ERRORS. ; ( ADDRESS BLOCK# FLAG(1=READ,0=WRITE) ==> ) .WORD DUP,ONE,EQUAL,ZBRAN,XXS1-.,DROP,BREAD .WORD ZBRAN,XXS2-.,CR,PDOTQ .BYTE 22 .ASCII /DISK READ ERROR # / .EVEN .WORD DOT,ABORT XXS2: .WORD BRAN,XXS3-. XXS1: .WORD ZEQU,ZBRAN,XXS4-.,BWRIT,ZBRAN,XXS5-. .WORD CR,PDOTQ .BYTE 23 .ASCII /DISK WRITE ERROR # / .EVEN .WORD DOT,ABORT XXS5: XXS4: XXS3: .WORD SEMIS ; HEAD 203,R/W,327,RW,DOCOL ; ***** R/W ; READ OR WRITE 1024-BYTE SCREEN. ( ADDRESS SCREEN# FLAG ==> ) ; NOTE THAT SCREEN N IS BLOCKS 2N-1 AND 2N. .WORD TOR,TWO,STAR,OVER,OVER,ONE,SUB,R,IO .WORD SWAP,LIT,512.,PLUS .WORD SWAP,FROMR,IO,SEMIS ; ; .ENDC ; ; *************** ; ; STAND-ALONE TERMINAL I/O ; ; **************** ; .IFDF ALONE PEMIT: ; INCREMENT 'OUT', UNLESS A CONTROL CHARACTER BEING OUTPUT. CMP (S),#40 ; TEST FOR CONTROL CHARACTER BLT 1$ INC 42(U) ; INCREMENT 'OUT' 1$: TST @#177564 BEQ 1$ MOV (S)+,@#177566 NEXT ; PKEY: TSTB @#177560 BEQ PKEY CLR @#177560 MOVB @#177562,R1 BIC #177600,R1 CMP #177,R1 BNE 1$ MOV #10,R1 1$: MOV R1,-(S) NEXT ; PQTER: TSTB @#177560 BEQ 1$ MOV @#177562,-(S) BR 2$ 1$: CLR -(S) 2$: CLR @#177560 NEXT ; PCR: TST @#177564 BEQ PCR MOV #15,@#177566 1$: TST @#177564 BEQ 1$ MOV #12,@#177566 NEXT ; HEAD 203,BYE,305,BYE ; ***** BYE (ALONE) HALT ; ; *************** ; ; STAND-ALONE DISK I/O ; ; *************** ; RXCS=177170 ; CONTROL AND STATUS REGISTER RXDB=177172 ; DATA BUFFER REGISTER ; ; HEAD 204,NRTS,240,NRTS ; ***** NRTS ; ADDRN TRN SECN...ADDR1 TR1 SEC1 N -> FLAG ; READ N SECTORS. USES R0, R1, R2 ; THIS OPERATION IS IN CODE TO KEEP UP WITH DISK TIMING FOR ; STANDARD PDP-11 SECTOR SKEWING. MOV (S)+,R1 ; # OF SECTORS TO READ 1$: MOV #10,R2 ; RETRY COUNT 21$: MOV #7,R0 ; 'READ' COMMAND JSR PC,DRIV2 ; ADJUST R0 COMMAND ; IF SECOND DRIVE MOV R0,@#RXCS ; READ COMMAND 2$: BIT #200,@#RXCS ; WAIT FOR TRANSFER FLAG BEQ 2$ MOV (S),@#RXDB ; SECTOR # 3$: BIT #200,@#RXCS ; WAIT FOR TRANSFER FLAG BEQ 3$ MOV 2(S),@#RXDB ; TRACK # 4$: BIT #40,@#RXCS ; WAIT FOR DONE FLAG BEQ 4$ ; CHECK FOR ERROR TST @#RXCS BLT 20$ ; ERROR ; MOV #3,@#RXCS ; 'EMPTY' COMMAND ; EMPTY THE CONTROLLER'S BUFFER MOV 4(S),R0 ; ADDRESS TO RECEIVE DATA MOV #200,-(S) ; COUNT OF TIMES TO LOOP 6$: BIT #200,@#RXCS ; WAIT FOR TRANSFER FLAG BEQ 6$ MOVB @#RXDB,(R0)+ DEC (S) ; DECREMENT THE COUNT BNE 6$ TST (S)+ ; POP THE COUNT ; CHECK FOR ERROR TST @#RXCS BGE 7$ 20$: ; ERROR, SO RE-TRY MOV #40000,@#RXCS ; CLEAR ERROR STATUS 22$: BIT #40,@#RXCS BEQ 22$ DEC R2 ; RE-TRY COUNT BGT 21$ MOV #-1,-(S) NEXT ; ERROR EXIT 7$: ADD #6,S ; GOOD READ, SO POP THE 3 ARGS DEC R1 BNE 1$ ; LOOP UNLESS ALL SECTORS READ ; CLR -(S) ; GOOD-READ INDICATOR NEXT ; EXIT ; ; SUBROUTINE TO ADJUST COMMAND FOR SECOND DISK DRIVE ; NOTE - 'NWTS' ALSO USES THIS SUBROUTINE. ; NOTE USE OF R0, AND OF FORTH STACK. DRIV2: CMP 2(S),#114 ; TRACK > 76 ? BLE 10$ SUB #115,2(S) ; SUBTRACT 77 BIS #20,R0 ; SET UNIT-SELECT BIT 10$: RTS PC ; HEAD 204,NWTS,240,NWTS ; ***** NWTS ; ADDRN TRN SECN...ADDR1 TR1 SEC1 N -> FLAG ; WRITE N SECTORS. USES R0, R1, R2. MOV (S)+,R1 ; # OF SECTORS TO BE WRITTEN 1$: MOV #10,R2 ; RE-TRY COUNT 21$: MOV #1,@#RXCS ; 'FILL' COMMAND 2$: BIT #200,@#RXCS ; WAIT FOR TRANSFER FLAG BEQ 2$ ; NOW FILL THE BUFFER MOV 4(S),R0 MOV #200,-(S) ; COUNT 3$: BIT #200,@#RXCS ; WAIT FOR TRANSFER FLAG BEQ 3$ MOVB (R0)+,@#RXDB ; MOVE ONE BYTE DEC (S) BNE 3$ TST (S)+ ; POP STACK ; CHECK FOR ERROR TST @#RXCS BLT 20$ ; ERROR ; MOV #5,R0 ; 'WRITE' COMMAND JSR PC,DRIV2 ; ADJUST IF SECOND DRIVE MOV R0,@#RXCS ; 'WRITE' COMMAND 5$: BIT #200,@#RXCS ; WAIT FOR TRANSFER FLAG BEQ 5$ MOV (S),@#RXDB ; MOVE SECTOR # 6$: BIT #200,@#RXCS ; WAIT FOR TRANSFER FLAG BEQ 6$ MOV 2(S),@#RXDB ; MOVE TRACK # 7$: BIT #40,@#RXCS ; WAIT FOR DONE FLAG BEQ 7$ ; CHECK FOR ERROR TST @#RXCS BGE 10$ 20$: ; ERROR SO RE-TRY MOV #40000,@#RXCS ; CLEAR ERROR STATUS 22$: BIT #40,@#RXCS BEQ 22$ DEC R2 ; RE-TRY COUNT BGT 21$ MOV #-1,-(S) ; ERROR INDICATOR NEXT ; EXIT 10$: ADD #6,S ; GOOD WRITE, SO POP THE 3 ARGS DEC R1 BNE 1$ ; LOOP UNLESS ALL SECTORS WRITTEN ; CLR -(S) ; GOOD-WRITE INDICATOR NEXT ; HEAD 203,RTS,323,RTS,DOCOL ; ***** RTS ; ADDR TR SEC -> ; READ A SINGLE SECTOR. .WORD ONE,NRTS,ZBRAN,1$-.,PDOTQ .BYTE 26 .ASCII /DISK READ ERROR IN RTS/ .EVEN .WORD QUIT 1$: .WORD SEMIS ; HEAD 203,WTS,323,WTS,DOCOL ; ***** WTS ; ADDR TR SEC -> ; WRITE A SINGLE SECTOR. .WORD ONE,NWTS,ZBRAN,1$-.,PDOTQ .BYTE 30 .ASCII /DISK WRITE ERROR IN WTS / .EVEN .WORD QUIT 1$: .WORD SEMIS ; ; HEAD 205,SKEW1,261,SKEW1,DOCOL ; ***** SKEW1 ; SEQUENCE -> TRACK SECTOR ; HANDLE THE SECTOR SKEWING. ; NOTE - 'SEQUENCE #' IS ZERO-ORIGIN INDEX OF SECTOR (SKEWED). ; NOTE - 'SKEW1' DOES SKEWING OF ONLY ONE DRIVE; 'SKEW' GENERALIZES ; 'SKEW1' TO BOTH DRIVES. .WORD DUP,LIT,32,SLASH,SWAP .WORD OVER,LIT,6,STAR,OVER,DUP,PLUS,PLUS,SWAP .WORD LIT,32,MOD,LIT,15,SLASH,PLUS .WORD LIT,32,MOD,ONEP .WORD SWAP,ONEP,SWAP,SEMIS ; HEAD 206,S-SKIP,240,SSKIP,DOVAR ; ***** S-SKIP ; VARIABLE - NUMBER OF SECTORS SKIPPED AT BEGINNING OF DISK. ; DEFAULT IS 56 DECIMAL (SKIP AN RT-11 DIRECTORY). ALSO, TRACK ; ZERO IS SKIPPED, FOR COMPATIBILITY. .WORD 56. ; HEAD 206,S-USED,240,SUSED,DOVAR ; ***** S-USED ; VARIABLE - NUMBER OF SECTORS USED ON ON ONE DISK. ; NORMALLY, S-USED + S-SKIP = 1976. (2002. - 26. OF TR 0). .WORD 1920. ; HEAD 204,SKEW,240,SKEW,DOCOL ; ***** SKEW ; SEQUENCE# -> TRACK SECTOR .WORD DUP,ONEP,SUSED,AT,GREAT,ZBRAN,1$-. .WORD SUSED,AT,SUB,SSKIP,AT,PLUS,SKEW1 .WORD SWAP,LIT,77.,PLUS,SWAP .WORD BRAN,2$-. 1$: .WORD SSKIP,AT,PLUS,SKEW1 2$: .WORD SEMIS ; HEAD 206,NSETUP,240,NSET,DOCOL ; ***** NSETUP ; ADDR SEQUENCE# N -> ADDRN TRN SECN...ADDR1 TR1 SEC1 ; THIS PREPARES A WHOLE SCREEN (IF N=8) FOR 'NRTS' OR 'NWTS'. .WORD ROT,OVER,LIT,128.,STAR,PLUS,ROT,ROT .WORD OVER,PLUS,ONE,SUB,SWAP,ONE,SUB,SWAP .WORD XDO 2$: .WORD LIT,128.,SUB,DUP,I,SKEW,ROT .WORD LIT,-1,XPLOO,2$-. .WORD DROP,SEMIS ; HEAD 203,R/W,327,RW,DOCOL ; ***** R/W ; READ OR WRITE 1024-BYTE SCREEN. ; ADDR BLOCK# FLAG(R=1,W=0) -> .WORD TOR,ONE,SUB,LIT,8.,STAR,FROMR ; CHANGE THE SCREEN # TO FIRST SEQUENCE #. ; IF READ, SETUP AND READ 8 SECTORS .WORD ZBRAN,1$-.,LIT,8.,NSET,LIT,8.,NRTS .WORD ZBRAN,2$-.,PDOTQ .BYTE 20 .ASCII /DISK READ ERROR / .EVEN .WORD QUIT 2$: .WORD BRAN,3$-. ; SETUP AND WRITE 8 SECTORS 1$: .WORD LIT,8.,NSET,LIT,8.,NWTS .WORD ZBRAN,4$-.,PDOTQ .BYTE 20 .ASCII /DISK WRITE ERROR/ .EVEN .WORD QUIT 4$: 3$: .WORD SEMIS ; .ENDC ; ; *************** ; ; TRAP RECOVERY SECTION, RSX-11M ; ; *************** ; .IFNDF ALONE ; STAND-ALONE MUST HANDLE OWN INTERRUPTS. HEAD 205,TRAPS,323,TRAPS,DOCOL ; ***** TRAPS .WORD CR,PDOTQ .BYTE 14 .ASCII /TRAP-ERROR, / .EVEN .WORD DOT,SWAP,UDOT,UDOT,QUIT .ENDC ; .IFDF RSX11 TRAPV: .WORD TRAP0,TRAP1,TRAP2,TRAP3,TRAP4,TRAP5 TRAP0: CLR R1 ; TRAP # 0 BR TRAPZ TRAP1: MOV #1,R1 ; TRAP # 1 ADD #6,SP ; DROP MMU INFO BR TRAPZ TRAP2: MOV #2,R1 BR TRAPZ TRAP3: MOV #3,R1 BR TRAPZ TRAP4: MOV #4,R1 BR TRAPZ TRAP5: MOV #5,R1 BR TRAPZ ; TO RETURN FROM TRAP HANDLER, SET UP STACK, ETC. FOR FORTH 'TRAPS' ; DON'T USE RTT OR RTI. TRAPZ: MOV (SP)+,-(S) ; PC MOV (SP)+,-(S) ; PS MOV R1,-(S) ; TRAP # MOV #TRAPS+2,IP ; EXECUTE 'TRAPS' NEXT ; .ENDC ; **************** ; ; TRAP RECOVERY SECTION, RT-11 ; ; **************** .IFDF RT11 TRAPZ: BCS 1$ ; IF CARRY CLEAR, TRAP 4 MOV #4,R1 BR 2$ 1$: MOV #10,R1 2$: MOV (SP)+,-(S) ; PC MOV (SP),-(S) ; PS MOV R1,-(S) ; TRAP # MOV #3$,-(SP) ; SO RTI WILL RESTORE PC TO '3$' .TRPSET #TRAPBL,#TRAPZ ; RE-SET TRAPS RTI 3$: MOV #TRAPS+2,IP ; EXECUTE 'TRAPS' NEXT .ENDC ; ; .PAGE ; NOTE - '.W' ('DW') IS USED ONLY FOR TESTING - TO GET OCTAL OUTPUT ; WHEN '.' IS NOT WORKING DURING SYSTEM DEVELOPMENT. ; ; ; HEAD 202,.W,240,DW ; ***** .W ; MOV (S),XOUT ; ROL XOUT ; ROL XOUT ; MOV XOUT,IOCHR ; ROR XOUT ; BIC #177776,IOCHR ; ADD #60,IOCHR ; MOV IOCHR,-(S) ; JSR R1,XCOUT ; MOV #5,XCOUNT ;XLP: ROL XOUT ; ROL XOUT ; ROL XOUT ; ROL XOUT ; MOV XOUT,IOCHR ; ROR XOUT ; BIC #177770,IOCHR ; ADD #60,IOCHR ; MOV IOCHR,-(S) ; JSR R1,XCOUT ; DEC XCOUNT ; BNE XLP ; MOV #40,IOCHR ; MOV IOCHR,-(S) ; JSR R1,XCOUT ; NEXT ;XOUT: .WORD 0 ;XCOUT: .WORD 0 ; ; ; ; ; ; **************************************************************** ; ; THE FOLLOWING TWO DEFINITIONS ARE NOT PURE CODE, SO THEY WERE ; MOVED HERE, NEAR THE END OF THE DICTIONARY. ; ; **************************************************************** ; HEAD 305,<;CODE>,305,SEMIC,DOCOL ; ***** ;CODE ; CREATE NEW DATA TYPE WITH CODE ROUTINE WRITTEN IN ASSEMBLY. .WORD QCSP,COMP,PSCOD,LBRAC,SMUDG,SEMIS ; NOTE: LATER, THE ASSEMBLER WILL PATCH THIS DEFINITION. ; HEAD 305,FORTH,310,FORTH,DODOE ; ***** FORTH .WORD DOVOC .WORD 120201 ; DUMMY HEADER AT INTERSECTION .WORD TASK-10 XXVOC: .WORD 0 ; THE VOCABULARY LINK (FOR FUTURE USE) HEAD 204,TASK,240,TASK,DOCOL ; ***** TASK .WORD SEMIS ; ; ; ; .PAGE ; **************************************************************** ; ; STACKS AND BUFFERS ; ; **************************************************************** ; ; NOTE - 'UP', 'OPENF', 'INTERM', AND DISK BUFFERS ARE ; INITIALIZED AT COLD START, OR AT FIRST TIME THROUGH. .EVEN XDP: ; DICTIONARY STARTS HERE ; ; INITIALIZATION .BLKB 8000. ; FOR DICTIONARY AND COMP. STACK ; INCREASE THIS NUMBER TO USE A LARGER MEMORY SIZE. XS0: ; START OF COMPUTATION STACK .BLKW 2 ; IN CASE OF EMPTY STACK ; ; ; ; ; DSKBUF: ; ROOM FOR 3 1K DISK BUFFERS ; INITIALIZE BUFFERS' UPDATE BITS, AND TERMINATING NULLS, TO ZERO. ; NOTE - THESE BUFFERS ARE CLEARED AT COLD START, ANYWAY, ; BECAUSE A STAND-ALONE BOOT MAY NOT INITIALIZE HIGH MEMORY; ; AND ALSO SO THAT THE NUMBER OR LOCATION OF BUFFERS CAN BE ; CHANGED AT RUN TIME. .WORD 0 .BLKB 1024. .WORD 0 .WORD 0 .BLKB 1024. .WORD 0 .WORD 0 .BLKB 1024. .WORD 0 ENDBUF: ; CAUTION - 'ENDBUF' - 'DSKBUF' MUST BE EXACT MULTIPLE ; OF THE BUFFER LENGTH PLUS 4. ; ; ; ; ; ; 'XTIB', 'XR0', AND 'XUP' ARE ONLY USED IN BOOT-UP TABLE; ; THEREFORE THE AREAS DEFINED HERE CAN BE MOVEDAT RUN TIME. XTIB: .BLKW 42. ; TERMINAL INPUT BUFFER .BLKW 50. ; FOR RETURN STACK XR0=. XUP: .BLKW 100 ; ROOM FOR 100 USER VARIABLES ; ; .IFDF RT11 ; DISK HANDLER GOES HERE HANDLR: .WORD .+2 .ENDC ; ; ; NOTE - CHANGE THE FOLLOWING LINE TO '.END' IF LINKING TO OTHER LANGUAGES. .END ORIGIN EX ????