( LOAD SCREEN ) DECIMAL 1 warning ! ( get error messages, not numbers) ( 3 LOAD ( disk range check and misc. ) : THRU ( lo hi --- loads from screen lo thru screen hi) 1+ swap do i load loop ; ( cr ." Loading assembler" 10 15 THRU ) cr .( Loading editor... ) 2 LOAD 40 57 THRU ( THIS EDITOR IS THE WORK OF S. DANIEL. SEE "THE FORTH INC., LINE EDITOR" IN 2 LOAD ( MPH) 40 57 THRU ( Th FORTH DIMENSIONS, VOL 3, #3 PG 80 ) cr 7 emit ( Ring bell) ( DUMP AND CDUMP TWO MEMORY DUMP WORDS ) ( : DUMP ( ADDRESS NUMBER -- ) ( DUMP CONTENTS OF MEMORY ) OVER + SWAP DO CR I 6 .R SPACE I @ U. 2 +LOOP ; : CDUMP ( ADDRESS NUMBER -- ) ( DUMP CHARACTERS ) OVER + SWAP DO CR I DUP 6 .R SPACE C@ DUP 3 .R SPACE EMIT LOOP ; : (RANGE) ( n --- n ) DUP 1 < 6 ?ERROR DUP 80 > 6 ?ERROR ; : LIST (RANGE) LIST ; : LOAD (RANGE) LOAD ; : BINARY 2 BASE ! ; : WORDS VLIST ; : NUMBER ( --- n or d : redefined since FIG left only d ) NUMBER DPL @ 1+ 0= IF DROP THEN ; : INDEX (RANGE) INDEX ; ( ERROR, WARNING, AND OTHER MESSAGES - SCREENS 4 AND 5 ) EMPTY STACK STACK OR DICTIONARY FULL HAS INCORRECT ADDRESS MODE ISN'T UNIQUE DISC RANGE ( ERROR MESSAGES, CONTINUED ) COMPILATION ONLY, USE IN DEFINITION EXECUTION ONLY CONDITIONALS NOT PAIRED DEFINITION NOT FINISHED IN PROTECTED DICTIONARY USE ONLY WHEN LOADING DECLARE VOCABULARY ( ASSEMBLER) OCTAL VOCABULARY ASSEMBLER IMMEDIATE 0 VARIABLE OLDBASE : ENTERCODE [COMPILE] ASSEMBLER BASE @ OLDBASE ! OCTAL SP@ ; : CODE CREATE ENTERCODE ; ASSEMBLER DEFINITIONS ' ENTERCODE 2 - ' ;CODE 10 + ! ( PATCH ';CODE') : FIXMODE ( COMPLETE THE MODE PACKET) DUP -1 = IF DROP ELSE DUP 10 SWAP U< IF 67 ENDIF ENDIF ; : OP @ , ; : ORMODE ( MODE ADDR -> . SET MODE INTO INSTR.) SWAP OVER @ OR SWAP ! ; : ,OPERAND ( ?OPERAND MODE -> ) DUP 67 = OVER 77 = OR IF ( PC) SWAP HERE 2 + - SWAP ENDIF DUP 27 = OVER 37 = OR ( LITERAL) SWAP 177760 AND 60 = OR ( RELATIVE) IF , ENDIF ; : 1OP @ , FIXMODE DUP HERE 2 - ORMODE ,OPERAND ; DECIMAL ( ASSEMBLER, CONT.) OCTAL : SWAPOP ( -> . EXCHANGE OPERANDS OF 3-WORD INSTR, ADJ. PC-REL) HERE 2 - @ HERE 6 - @ 6700 AND 6700 = IF ( PC-REL) 2 + ENDIF HERE 4 - @ HERE 6 - @ 67 AND 67 = IF ( PC-REL) 2 - ENDIF HERE 2 - ! HERE 4 - ! ; : 2OP @ , FIXMODE DUP HERE 2 - DUP >R ORMODE ,OPERAND FIXMODE DUP 100 * R ORMODE ,OPERAND HERE R> - 6 = IF SWAPOP ENDIF ; : ROP @ , FIXMODE DUP HERE 2 - DUP >R ORMODE ,OPERAND DUP 7 SWAP U< IF ." ERR-REG-B " ENDIF 100 * R> ORMODE ; : BOP @ , HERE - DUP 376 > IF ." ERR-BR+ " . ENDIF DUP -400 < IF ." ERR-BR- " . ENDIF 2 / 377 AND HERE 2 - ORMODE ; DECIMAL ( ASSEMBLER - INSTRUCTION TABLE) OCTAL 010000 2OP MOV, 110000 2OP MOVB, 020000 2OP CMP, 120000 2OP CMPB, 060000 2OP ADD, 160000 2OP SUB, 030000 2OP BIT, 130000 2OP BITB, 050000 2OP BIS, 150000 2OP BISB, 040000 2OP BIC, 140000 2OP BICB, 005000 1OP CLR, 105000 1OP CLRB, 005100 1OP COM, 105100 1OP COMB, 005200 1OP INC, 105200 1OP INCB, 005300 1OP DEC, 105300 1OP DECB, 005400 1OP NEG, 105400 1OP NEGB, 005700 1OP TST, 105700 1OP TSTB, 006200 1OP ASR, 106200 1OP ASRB, 006300 1OP ASL, 106300 1OP ASLB, 006000 1OP ROR, 106000 1OP RORB, 006100 1OP ROL, 106100 1OP ROLB, 000300 1OP SWAB, 005500 1OP ADC, 105500 1OP ADCB, 005600 1OP SBC, 105600 1OP SBCB, 006700 1OP SXT, 000100 1OP JMP, 074000 ROP XOR, 004000 ROP JSR, : RTS, 200 OR , ; DECIMAL ( ASSEMBLER - CONT.) OCTAL 000400 BOP BR, 001000 BOP BNE, 001400 BOP BEQ, 100000 BOP BPL, 100400 BOP BMI, 102000 BOP BVC, 102400 BOP BVS, 103000 BOP BCC, 103400 BOP BCS, 002000 BOP BGE, 002400 BOP BLT, 003400 BOP BLE, 101000 BOP BHI, 101400 BOP BLOS, 103000 BOP BHIS, 103400 BOP BLO, 003000 BOP BGT, 000003 OP BPT, 000004 OP IOT, 000002 OP RTI, 000006 OP RTT, 000000 OP HALT, 000001 OP WAIT, 000005 OP RESET, 000241 OP CLC, 000242 OP CLV, 000244 OP CLZ, 000250 OP CLN, 000261 OP SEC, 000262 OP SEV, 000264 OP SEZ, 000270 OP SEN, 000277 OP SCC, 000257 OP CCC, 000240 OP NOP, 006400 OP MARK, : EMT, 104000 + , ; DECIMAL ( ASSEMBLER - REGISTERS, MODES, AND CONDITIONS) OCTAL : C CONSTANT ; 0 C R0 1 C R1 2 C R2 3 C R3 4 C R4 5 C R5 6 C SP 7 C PC 2 C W 3 C U 4 C IP 5 C S 6 C RP : RTST ( R MODE -> MODE) OVER DUP 7 > SWAP 0 < OR IF ." NOT A REGISTER: " OVER . ENDIF + -1 ; : )+ 20 RTST ; : -) 40 RTST ; : I) 60 RTST ; : @)+ 30 RTST ; : @-) 50 RTST ; : @I) 70 RTST ; : # 27 -1 ; : @# 37 -1 ; : () DUP 10 U< IF ( REGISTER DEFERRED) 10 + -1 ELSE ( RELATIVE DEFERRED) 77 -1 ENDIF ; ( NOTE - THE FOLLOWING CONDITIONALS REVERSED FOR 'IF,', ETC. ) 001000 C EQ 001400 C NE 100000 C MI 100400 C PL 102000 C VS 102400 C VC 103000 C CS 103400 C CC 002000 C LT 002400 C GE 003000 C LE 003400 C GT 101000 C LOS 101400 C HI 103000 C LO 103400 C HIS DECIMAL ( ASSEMBLER - STRUCTURED CONDITIONALS) OCTAL : IF, ( CONDITION -> ADDR ) HERE SWAP , ; : IPATCH ( ADDR ADDR -> . ) OVER - 2 / 1 - 377 AND SWAP DUP @ ROT OR SWAP ! ; : ENDIF, ( ADDR -> ) HERE IPATCH ; : THEN, ENDIF, ; : ELSE, ( ADDR -> ADDR ) 00400 , HERE IPATCH HERE 2 - ; : BEGIN, ( -> ADDR ) HERE ; : WHILE, ( CONDITION -> ADDR ) HERE SWAP , ; : REPEAT, ( ADDR ADDR -> ) HERE 400 , ROT IPATCH HERE IPATCH ; : UNTIL, ( ADDR CONDITION -> ) , HERE 2 - SWAP IPATCH ; : C; CURRENT @ CONTEXT ! OLDBASE @ BASE ! SP@ 2+ = IF SMUDGE ELSE ." CODE ERROR, STACK DEPTH CHANGED " ENDIF ; : NEXT, IP )+ W MOV, W @)+ JMP, ; FORTH DEFINITIONS DECIMAL ( ASSEMBLER - EXAMPLES) CODE TEST1 33006 # 33000 MOV, NEXT, C; CODE TEST2 555 # 33000 () MOV, NEXT, C; CODE TESTDUP S () S -) MOV, NEXT, C; CODE TEST0 R0 S -) MOV, NEXT, C; CODE TESTBYTE 33006 R1 MOVB, R1 S -) MOV, NEXT, C; CODE TEST3 33000 # R1 MOV, 444 # 20 R1 I) MOV, NEXT, C; CODE TEST-DUP S () TST, NE IF, S () S -) MOV, ENDIF, NEXT, C; CODE TESTLP1 15 # R1 MOV, BEGIN, R1 DEC, GT WHILE, R1 S -) MOV, REPEAT, NEXT, C; CODE TESTLP2 15 # R1 MOV, BEGIN, R1 S -) MOV, R1 DEC, EQ UNTIL, NEXT, C; : TESTVARIABLE CONSTANT ;CODE W S -) MOV, NEXT, C; ( DOUBLE NUMBER WORDS ) DECIMAL : 2DUP ( DUPLICATE A DOUBLE NUMBER ) OVER OVER ; : 2DROP ( DROP A DOUBLE NUMBER ) DROP DROP ; : 2SWAP ( SWAP THE TOP TWO DOUBLE NUMBERS ) 3 ROLL 3 ROLL ; ( MEMORY DUMP WORDS ) DECIMAL : UDUMP ( ADDR, COUNT -- ) OVER + SWAP DO CR I DUP U. @ U. 2 +LOOP ; : .S ( PRINT THE STACK CONTENTS ) ( -- ) DEPTH ?DUP IF ( IF THERE IS SOMETHING THERE) 1 DO CR S0 @ I DUP . 2 * - ? LOOP CR ELSE CR ." EMPTY STACK" THEN ; : START_HERE ; 24 LOAD ( LOWER LEVEL WORDS) : MDO ( --ADDR) ( JUST SAVE SOME ROOM IN THE DICTIONARY) COMPILE (MDO) HERE 0 , ; IMMEDIATE : SOMETHING ( JUST SOMETHING INSIDE) CR ." INSIDE" ; : MLOOP ( ADDR -- ) COMPILE (LOOP) DUP 2+ BACK HERE SWAP ! ; IMMEDIATE : (MDO) ( LIMIT,INDEX -- ) ( OLD DO CONSTRUCT ) R> U. ( DROP THAT ADDR) SWAP >R >R ; ( THIS LOOKS CLOSE IT DOES DROP THE CORRECT ADDR) : LIT_TEST ( SEE IF I UNDERSTAND LIT ) LIT 0 . ; : (MLOOP) ( OLD LOOP CONSTRUCT) (LOOP) ; : NUM1 CR ." THIS IS NUMBER ONE." ; : NUM2 CR ." THIS IS NUMBER TWO." ; : NUM3 CR ." THIS IS NUMBER THREE." ; : RTST NUM1 R@ . NUM2 NUM3 ; : RTST1 NUM1 R> DROP NUM2 NUM3 ; ( (MATCH) ( AND BLANK 810715 SHD 31AUG82 VSV) DECIMAL : (MATCH) ( addr-3 addr-2 count-1 --- flag) ?dup if over + swap do dup c@ i c@ - if 0= leave else 1+ then loop else drop 0= then ; : BLANK BLANKS ; ( MATCH 810715 SHD 31AUG82 VSV) decimal : MATCH ( cursor adr-4, bytes left-3 string adr-2) ( string count-1 --- flag-2, cursor offset-1) >r >r over over r> r> 3 roll 3 roll over + swap ( caddr-6, bleft-5, $addr-4, $len-3, caddr+bleft-2, caddr-1) do over over i swap (MATCH) if >r drop drop r> - i swap - 0 swap 0 0 leave ( caddr, bleft , $addr, $len or 0, offset, 0, 0) then loop drop drop ( caddr-2, bleft-1 or 0-2, offset-1) swap 0= swap ; ( polyFORTH compatible line editor 810715 SHD) hex ( This editor was taken from the one written by S. H. Daniel of System Development Corporation in FORTH Dimensions III/3. It is written in Starting FORTH, and is in the public domain. This notice should be included in copies. Note that b/scr isn't in the Starting FORTH system. It should be taken to be 1 in Starting FORTH.) forth definitions : TEXT ( accept following text to PAD) here c/l 1+ blank word pad c/l 1+ cmove ; : LINE ( relative to scr , leave address of line) dup fff0 and if ." Not on current editing screen" quit then scr @ (line) drop ; decimal ( #LOCATE 810707 SHD 820831 VSV) hex vocabulary EDITOR immediate EDITOR definitions : #LOCATE ( --- cursor offset-2, line-1) r# @ c/l /mod ; decimal ( #LEAD #LAG -MOVE BUF-MOVE 810707 SHD 820831 VSV) hex : #LEAD ( --- line address-2, offest to cursor-1) #LOCATE LINE swap ; : #LAG ( --- cursor adr-2, count after cursor-1) #LEAD dup >r + c/l r> - ; : -MOVE ( move from adr-2, to line-1 --- ) LINE c/l cmove update ; : BUF-MOVE ( move text to buffer-1, if any ---) pad 1+ c@ if pad swap c/l 1+ cmove else drop then ; decimal ( >LINE# FIND-BUF INSERT-BUF 810707 SHD 820831 VSV) hex : >LINE# ( convert current cursor positon to line#) #LOCATE swap drop ; : FIND-BUF ( buffer used for all searches) pad 50 + ; : INSERT-BUF ( buffer used for all insertions) FIND-BUF 50 + ; decimal ( (HOLD- (KILL- (SPREAD- X 810707 SHD 820831 VSV) hex : (HOLD) ( move line-1 from block to insert buffer) LINE INSERT-BUF 1+ c/l dup INSERT-BUF c! cmove ; : (KILL) ( erase line-1 with blanks) LINE c/l blank update ; : (SPREAD) ( spread, making line# blank) >LINE# dup 1 - 0e do i LINE i 1+ -MOVE -1 +loop (KILL) ; : X ( delete line# from block, put in insert buffer) >LINE# dup (HOLD) 0f dup rot do i 1+ LINE i -MOVE loop (KILL) ; decimal ( DISPLAY-CURSOR T L 810715 SHD 820831 VSV) hex : DISPLAY-CURSOR ( --- ) cr space #LEAD type 5e emit #LAG type #LOCATE . drop ; : T ( type line#-1) c/l * r# ! DISPLAY-CURSOR ; : L ( list current screen) scr @ list ; decimal ( N B (TOP- SEEK-ERROR 810707 SHD 820831 VSV) hex : N ( select next sequential screen) 1 scr +! ; : B ( select previous sequential screen) -1 scr +! ; : (TOP) ( reset cursor to top of block) 0 r# ! ; : SEEK-ERROR ( output error msg if no match) (TOP) FIND-BUF here c/l 1+ cmove here count type ." None" quit ; decimal ( (R- P 810707 SHD 820831 VSV) hex : (R) ( replace current line with insert buffer) >LINE# INSERT-BUF 1+ swap -MOVE ; : P ( following text in insert buffer and line) 5e text INSERT-BUF BUF-MOVE (R) ; decimal ( WIPE 1LINE 810715 SHD 820831 VSV) hex ( Brodie has WIPE in FORTH vocabulary.) : WIPE ( clear the current screen) 10 0 do i (KILL) loop ; : 1LINE ( scan current line for match with FIND buffer) ( update cursor, return boolean) #LAG FIND-BUF count match r# +! ; decimal ( (SEEK- (DELETE- 810715 SHD 820831 VSV) hex : (SEEK) ( FIND buffer match over full screen, else error) begin 3ff r# @ < if SEEK-ERROR then 1LINE until ; : (DELETE) ( backwards at cursor by count-1) >r #LAG + r@ - ( save blank fill location) #LAG r@ negate r# +! ( back up cursor) #LEAD + swap cmove r> blank update ; ( fill from end of text) decimal ( (F- F (E- E 810715 SHD 820831 VSV) hex : (F) ( find occurance of following text) 5e text FIND-BUF BUF-MOVE (SEEK) ; : F ( find and display following text) (F) DISPLAY-CURSOR ; : (E) ( erase backwards from cursor) FIND-BUF c@ (DELETE) ; : E ( erase and display line) (E) DISPLAY-CURSOR ; decimal ( D TILL 810715 SHD 820831 VSV) hex : D ( find, delete and display following text) (F) E ; : TILL ( delete from cusor to text end ) #LEAD + 5e text FIND-BUF BUF-MOVE 1LINE 0= if SEEK-ERROR then #LEAD + swap - (DELETE) DISPLAY-CURSOR ; decimal ( COUNTER BUMP 810707 SHD 820831 VSV) hex variable COUNTER : BUMP ( the line number and handle paging) 1 COUNTER +! COUNTER @ 38 > if 0 COUNTER ! cr cr 0f message 0c emit then ; decimal ( S 810715 SHD 820831 VSV) hex : S ( from current to screen-1 for string) 0c emit 5e text 0 COUNTER ! FIND-BUF BUF-MOVE scr @ dup >r do i scr ! (TOP) begin 1LINE if DISPLAY-CURSOR scr ? BUMP then 3ff r# @ < until loop r> scr ! ; decimal ( I U 810715 SHD 820831 VSV) hex : I ( insert text with line) 5e text ( load insert buffer with text) INSERT-BUF BUF-MOVE ( if any) INSERT-BUF count #LAG rot over min >r r@ R# +! ( bump cursor) r@ - >r ( characters to save) dup here r@ cmove ( from old cursor to here ) here #LEAD + r> cmove ( here to cursor location) r> cmove update ( pad to old cursor) DISPLAY-CURSOR ; ( look at new line) : U ( insert following text under current line) c/l r# +! (SPREAD) P ; decimal ( R M 810715 SHD 821101 VSV) hex : R ( replace found text with insert buffer) (E) I ; : M ( move from current line on current screen) scr @ >r ( to screen-2, under line-1) r# @ >r ( save original screen and cursor location) >LINE# (HOLD) ( move current line to insert buffer) swap scr ! ( set new screen #) 1+ c/l * r# ! ( text is stored under requested line) (SPREAD) (R) ( store insert buffer in new screen) r> c/l + r# ! ( set original cursor to next line) r> scr ! ; ( restore original screen) forth definitions decimal ( TEMP FIX TO GET BACK BRODIE'S VERSION OF TEXT:) : TEXT pad 72 32 fill word count pad swap cmove> ; ( GENERAL FILE UTILITIES ) DECIMAL ( THE ADDRESS OF THE DRIVE IS STORED IN THE FOUR CHARACTERS BEGINNING AT ' UI/O 318 +. THIS IS FOLLOWED BY THE PROJ AND PROG NUMBERS IN THE FORMAT [ 19,116] AND IN TURN FOLLOWED BY THE FILENAME AND EXTENSION AS FILENM.EXT. ) ' UI/O 318 + CONSTANT STRINGADDRESS : GETFILENAME ( ==> ) ( PUT THE ASCII STRING DB0:[ 19,116]NEWFIL.DAT IN MEMORY LOCATIONS IN UI/O ) CR ." ENTER FILE INFORMATION IN THE FORM " CR ." DB0:[ 19,116]NEWFIL.DAT" CR ." THIS FORM MUST AGREE IN NUMBER OF CHARACTERS." CR STRINGADDRESS 23 EXPECT ; ( DUMP_BUFFER DUMP 1024 WORDS IN HEX MPH 3/85) VARIABLE CHECKSUM : DUMP_BUFFER ( BUFFER ADDRESS -- BUFFER ADDRESS ) 0 CHECKSUM ! 1024 OVER + OVER HEX DO CR I @ DUP CHECKSUM +! 5 .R 2 +LOOP CR CHECKSUM @ 5 .R CR DECIMAL ; : GET_BUFFER ( BUFFER ADDRESS -- BUFFER ADDRESS ) 0 CHECKSUM ! 10 OVER + OVER HEX DO QUERY TIB @ NUMBER DROP DUP CHECKSUM +! I ! 2 +LOOP QUERY TIB @ NUMBER DROP CHECKSUM @ - ( SHOULD BE ZERO) IF ." CHECKSUM ERROR" ELSE ." AS IT SHOULD" THEN DECIMAL ; ( CHANGE THESE TO USE DOUBLE NUMBERS ) ( A NEW SCREEN DUMP UTILITY 11/85 MPH ) : START_SIGNAL ( <>-<> ) 58 EMIT 59 EMIT ( COLON SEMICOLON ) ; : TYPE_SCREEN ( --<> ) BLOCK 1024 TYPE ; : DUMP_SCREEN ( --<> ) BEGIN DUP TYPE_SCREEN 0 EMIT KEY 49 ( 1) = UNTIL DROP ; : SEND_UM ( --<> ) DO START_SIGNAL I DUMP_SCREEN LOOP ; ( JUST SOME F83 TESTING) OCTAL : TST SWAP 100000 + DUP CR ." 8000H + LIMIT = " . OCTAL CR - ." INDEX SCAN RANGE = " . CR ; ( GENERAL FILE UTILITIES RT11 ASCII_TO_RAD50 ) OCTAL : ASCII_TO_RAD50 ( ASCII CHAR->RAD50 CHAR ) DUP BL = IF 0 ELSE DUP 44 ( $) = IF 33 ELSE DUP 56 ( .) = IF 34 ELSE DUP 100 > ( >=A) OVER 133 < ( <= Z) AND IF DUP 100 - ELSE DUP 57 > ( >=0) OVER 72 < ( <=9) AND IF DUP 22 - ELSE CR ." ERROR !!!!!" CR EMIT ." IS NOT A RAD50 CHARACTER." QUIT THEN THEN THEN THEN THEN SWAP DROP ; DECIMAL ( CONVERT ASCII STRING TO RAD50 STRING ) OCTAL 0 CONSTANT RSTRING 0 CONSTANT ASTRING ( ADDRESSES) : CONVERT ( ASCII STRING ADDRESS,RAD50 STRING ADDRESS->) ' RSTRING ! ' ASTRING ! BEGIN ASTRING C@ ?DUP WHILE ' ASTRING 1 +! ASCII_TO_RAD50 [ 50 50 * ] * RSTRING ! ( OPTIMIST - PART 1 ) TIB CONSTANT S0 : 1ST-OPTIMIST ; : NO ." SOME " ; : NOT ; : NONE ." ALL " ; : NEVER ." ALWAYS " ; : NOTHING ." SOMETHING " ; : CAN'T ." CAN " ; : DON'T ." DO " ; : .PROMPT ." WHAT'S HAPPENIN'? " ; : .REPLY ." ACTUALLY, " ; ( OPTIMIST - PART 2 ) : ?-NULL ( --- <>0 IF INPUT NOT NULL ELSE 0 ) TIB @ >IN @ + C@ ; : .WORD HERE COUNT TYPE SPACE ; : DO-WORD ( PFA --- ) DUP ['] 1ST-OPTIMIST U< IF DROP .WORD ELSE EXECUTE THEN ; : 1LINE ( PROCESS ONE LINE OF INPUT ) .REPLY BEGIN ?-NULL WHILE -FIND IF DROP DO-WORD ELSE .WORD THEN REPEAT ; : OPTIMIST BEGIN CR .PROMPT QUERY ?-NULL WHILE CR 1LINE REPEAT ;