( INDEX TO SCREENS CONTAINED IN FORTH.DAT 04DEC81PDC THIS SCREEN IS MEANT AS AN INDEX TO THE CURRENT CAPABILITIES WITHIN THE SCREENS OF 'FORTH'. YOU SHOULD ALWAYS LOAD THE SCREEN EDITOR BY THE INSTRUCTIONS SHOWN BELOW. THE PDP-11 ASSEMBLER CAN BE LOADED BY TYPING '10 LOAD' THE STRING PACKAGE. CAN BE LOADED BY TYPING '19 LOAD' THE SCREEN EDITOR IS AUTOMATICALLY LOADED IF YOU TYPE '1 LOAD' THE FORTH DISASSEMBLER CAN BE LOADED BY TYPING '143 LOAD' THE DISASSEMBLER IS CALLED BY TYPING 'DIS X' X=FORTH COMMAND ) DECIMAL 1 WARNING ! ( GET MESSAGES NOT STATEMENT NUMBERS ) 79 LOAD 91 LOAD ( LOAD THE SCREEN EDITOR ) ( ) ( ERROR, WARNING, AND OTHER MESSAGES - SCREENS 4 AND 5 ) EMPTY STACK STACK OR DICTIONARY FULL HAS INCORRECT ADDRESS MODE ISN'T UNIQUE DISC RANGE FORTH INTEREST GROUP MAY 1979 EFF 03DEC81PDC ( ASSEMBLER FOR PDP-11 03DEC81PDC) 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. 03DEC81PDC) 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 A ND HERE 2 - ORMODE ; DECIMAL --> ( ASSEMBLER - INSTRUCTION TABLE 03DEC81PDC) 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'D 03DEC81PDC) 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 03DEC81PDC) 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 03DEC81PDC) 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; ( STRING ROUTINES FOR FORTH 03DEC81PDCNOTE: STRING-STACK PTR, $SP, IS 300 BYTES FROM STACK ORIGIN) DECIMAL 300 VARIABLE STACKSIZE S0 @ STACKSIZE @ - VARIABLE $SP : $CLEAR ( -> ) S0 @ STACKSIZE @ - $SP ! ; $CLEAR : $LEN ( -> LENGTH . LENGTH OF TOP OF $STACK) $SP @ DUP S0 @ STACKSIZE @ - < 0= IF ." $STACK EMPTY" QUIT ELSE @ EN DIF ; : $DROP ( ->. DROP FROM $STACK) $LEN 2+ =CELLS $SP +! ; : $COUNT ( ADDR -> ADDR LENGTH) DUP 2+ SWAP @ ; : $. ( ->. PRINT STRING) $SP @ $COUNT -TRAILING TYPE $DROP ; : $?OVER ( N-> . ) HERE 256 + + $SP @ < 0= IF ." WOULD CAUSE $OVERFLOW" QUIT ENDIF ; : $@TEXT ( ADDR CNT ->. MOVE TEXT INTO $STACK) DUP 2+ =CELLS DUP $?OVER MINUS $SP +! $SP @ ! $SP @ $COUNT CMOVE ; : $@ ( FROM-ADDR -> . STRING INTO $STACK) $COUNT $@T EXT ; : (") R COUNT DUP 1+ =CELLS R> + >R $@TEXT ; --> ( STRINGS - CONTINUED 03DEC81PDC) : $NULL ( CREATE NULL STRING) -2 $SP +! 0 $SP @ ! ; : " ( ->. STRING TO $STACK - COMPILE OR EXECUTE) STATE @ IF COMPILE (") 34 WORD HERE C@ 1+ =CELLS ALLOT ELSE 34 WORD HERE COUNT $@TEXT ENDIF ; IMMEDIATE : $! ( TO-ADDR -> . MOVE STRING FROM $STACK TO MEMO RY.) $SP @ SWAP $LEN 2+ CMOVE $DROP ; : $DIM ( LEN -> . CREATES STRING VARIABLE OF GIVEN LENGTH.) 0 CONSTANT HERE HERE 2 - ! 2+ =CELLS ALLOT ; : $VARIABLE ( -> . CREATES $VAR FROM $STACK TOP.) $LEN $DIM $SP @ HERE $LEN 2+ =CELLS - $LEN 2+ CMOVE $DROP ; : $DUP ( -> ) $SP @ $@ ; : $SEG ( BEGIN END -> ) OVER - 1+ SWAP 1 - $SP @ 2+ + SWAP $@TEXT ; : $STR ( N -> ) S->D SWAP OVER DABS <# #S SIGN #> $@TEXT ; --> ( STRINGS - CONTINUED 03DEC81PDC) : $VAL ( -> N . POSITIVE ONLY) HERE 33 32 FILL $SP @ 2+ HERE $LEN CMOVE 0 S->D HERE 1 - (NUMBER) DROP $DROP DROP ; : $SECOND $LEN =CELLS 2+ $SP @ + DUP S0 @ STACKSIZE @ - < 0= IF ." ERROR, NO SECOND STRING" QUIT ENDIF ; : $OVER $SECOND $@ ; : MOVEW ( FROM TO NBYTES -> . LIKE 'CMOVE' BUT FROM HIGH END) 2 - -2 SWAP DO OVER I + @ OVER I + ! -2 +LOOP DROP DROP ; : $SWAP ( -> ) $OVER $SP @ ( FROM) DUP $LEN =CELLS 2+ + ( TO) $LEN =CELLS 2+ $SECOND @ =CELLS 2+ + ( # OF BYTES) MOVEW $LEN =CELLS 2+ $SP +! ; --> ( STRINGS - CONTINUED 03DEC81PDC) 0 VARIABLE TEMP : $COMP ( -> NEG OR 0 OR POS. COMPARE STRINGS) 0 TEMP ! $SECOND 2+ $SP @ 2+ ( STRING TEXT ADDRESSES) $LEN $SECOND @ MIN ( # CHARACTERS TO COMPARE) 0 DO OVER I + C@ OVER I + C@ - -DUP IF LEAVE TEMP ! ENDIF LOOP DROP DROP TEMP @ $DROP $DROP ; : $< ( -> BOOL ) $COMP 0< ; : $= ( -> BOOL ) $COMP 0= ; : $> ( -> BOOL ) $COMP 0 > ; : $+-EVEN ( -> ) $LEN $SWAP $SP @ ( FROM) DUP 2+ $LEN =CELLS 2+ ( #) MOVEW 2 $SP +! $LEN + $SP @ ! ; : $+ ( -> . CONCATENATE ) $LEN $SECOND @ ( SAVE LENGTHS) $+-EVEN DUP 1 AND IF $SP @ 2+ + OVER SWAP DUP 1+ SWAP ROT CMOVE 1 AND IF $SP @ DUP 2+ $LEN 2+ MOV EW 2 $SP +! ENDIF ELSE DROP DROP ENDIF ; ( TRIG LOOKUP ROUTINES - WITH SINE *10000 TABLE) : TABLE SWAP 2 * + @ ; 10000 9998 9994 9986 9976 9962 9945 9925 9903 9877 9848 9816 9781 9744 9703 9659 9613 9563 9511 9455 9397 9336 9272 9205 9135 9063 8988 8910 8829 8746 8660 8572 8480 8387 8290 8192 8090 7986 7880 7771 7660 7547 7431 7314 7193 7071 6947 6820 6691 6561 6428 6293 6157 6018 5878 5736 5592 5446 5299 5150 5000 4848 4695 4540 4384 4226 4067 3907 3746 3584 3420 3256 3090 2924 2756 2588 2419 2250 2079 1908 1736 1564 1392 1219 1045 0872 0698 0523 0349 0175 0000 91 TABLE SINTABLE : S180 DUP 90 > IF 180 SWAP - ENDIF SINTABLE ; : SIN ( N -> SIN) 360 MOD DUP 0< IF 360 + ENDIF DUP 180 > IF 180 - S180 MINUS ELSE S180 E NDIF ; : COS ( N -> COS) 90 + SIN ; ( FORTRAN LINKAGE, RSX) CODE ACALL ( ARGS... N ADDR -> . CALL FORTRAN, ETC.) S )+ R2 MOV, ( SAVE ENTRY ADDRESS IN REGISTER) R3 RP -) MOV, R4 RP -) MOV, R5 RP -) MOV, ( SAVE R3,R4,R5) S R5 MOV, ( THE STACK WILL BE THE ARG. LIST) PC R2 () JSR, ( LINK THROUGH R2) RP )+ R5 MOV, RP )+ R4 MO V, RP )+ R3 MOV, ( RESTR R3,R4,R5) S )+ R2 MOV, R2 R2 ADD, R2 S ADD, ( DROP THE ARGS) NEXT, C; ( THIS IS AN EXAMPLE - WRITE LINES ON AN RSX FILE) 0 VARIABLE NFORT : FILECALL 2 VLINK @ ACALL ; : OPEN 1 NFORT ! 0 NFORT FILECALL ; : CLOSE 3 NFORT ! 0 NFORT FILECALL ; : WRITE ( ADDR ->. WRITE A LINE) 2 NFORT ! NFORT FILECALL ; ( RT-11 SYSTEM-CALL EXAMPLE - DATE) CODE DATE 12 400 * # R0 MOV, 374 EMT, R0 S -) MOV, NEXT, C; : YEAR ( -> N ) DATE 31 AND 72 + ; : DAY ( -> N ) DATE 32 / 31 AND ; : MONTH ( -> N) DATE 1024 / 15 AND ; ( RSX-11M SYSTEM-CALL EXAMPLE - DATE) DECIMAL 0 VARIABLE TBUFF 14 ALLOT CODE TIME TBUFF # SP -) MOV, 2 400 * 75 + # SP -) MOV, 377 EMT, NEXT, C; : YEAR ( -> N ) TIME TBUFF @ ; : MONTH ( -> N ) TIME TBUFF 2+ @ ; : DAY ( -> N ) TIME TBUFF 4 + @ ; : HOUR ( -> N ) TIME TBUFF 6 + @ ; : MINUTE ( -> N ) TIME TBUFF 8 + @ ; : SECOND ( -> N ) TIME TBUFF 10 + @ ; : TICK ( -> N ) TIME TBUFF 12 + @ ; : TICKS/SECOND ( -> N ) TIME TBUFF 14 + @ ; ( RSX-11M SYSTEM-CALL EXAMPLE - TERMINAL I/O) : PUSH ASSEMBLER SP -) MOV, FORTH ; 0 VARIABLE INBUF 78 ALLOT 0 VARIABLE IOSTAT 2 ALLOT CODE INPUT 0 # PUSH 0 # PUSH 0 # PUSH 0 # PUSH 120 # PUS H INBUF # PUSH 0 # PUSH IOSTAT # PUSH 4 # PUSH 4 # PUSH 10400 # PUSH 6003 # PUSH 377 EMT, NEXT, C; ( EXAMPLES - RANDOM #S, VIRTUAL ARRAY, RECURSIVE CALL) ( RANDOM NUMBER GENERATOR. CAUTION - EVERY 128TH RELATED.) 1001 VARIABLE RSEED : URAND ( -> N, UNSIGNED 0-65K) RSEED @ 2725 U* 13947 S->D D+ DROP DUP RSEED ! ; : RAND ( N -> M, 0 TO N-1) U RAND U* SWAP DROP ; ( 'VARRAY' CREATES A VIRTUAL ARRAY ON DISK SCREENS.) : VARRAY ( LRECL #RECS STARTSCREEN -> ) >R DUP R 2 + @ < 0= OVER 0< OR IF ." ERROR, V-ARRAY RANGE " . R> DROP ELSE R 6 + @ /MOD R @ + BLOCK SWAP R> 4 + @ * + THEN ; : MYSELF ( RECURSIVE CALL) LATEST PFA CFA , ; IMMEDIATE ( NOTE CONCERNING SCREENS 50 - 56 ) SCREENS 50 - 56 ARE NOT USED IN THE CURRENT SYSTEM. THEY ARE LEFT OVER FROM DEVELOPMENT OF THE STAND-ALONE VERSION'S DISKETTE HANDLER. THOUGH NOT PRODUCTIZED OR FULLY DOCUMENTED, THEY WERE LEFT ON THE DISKETTE FOR POSSIBLE STUDY BY ADVANCED USERS. OF COURSE THEY CAN BE ERASED, AND THE SPACE RE-USED. ( FLOPPY DRIVER - MACROS) ASSEMBLER DEFINITIONS OCTAL ( SET UP MACROS) : WAITT, ( ->. MACRO - WAIT FOR 'TRANSFER' FLAG) BEGIN, RXCS 200 # BIT, NE UNTIL, ; : WAITD, ( ->. MACRO - WAIT FOR 'DONE' FLAG) BEGIN, RXCS 40 # BIT, NE UNTIL, ; : EMPTY, ( ADDR ->. USES R0. EMPTY CONTROLLER'S BUFFER) S )+ R0 MOV, ( ADDRESS) 200 # S -) MOV, ( COUNT) BEGIN, WAITT, RXDB R0 )+ MOVB, ( MOVE 1 BYTE) S () DEC, EQ UNTIL, S )+ TST, ( POP) ; : FILL, ( ADDR ->. USES R0. FILL CONTROLLER'S BUFFER) S )+ R0 MOV, ( ADDRESS) 200 # S -) MOV, ( COUNT) BEGIN, WAITT, R0 )+ RXDB MOVB, ( MOVE 1 BYTE) S () DEC, EQ UNTIL, S )+ TST, ( POP) ; FORTH DEFINITIONS DECIMAL 55 LOAD 51 LOAD 52 LOAD 53 LOAD 54 LOAD ( FLOPPY DRIVER, NRTS) CODE NRTS ( ADDRN TRN SECN ... ADDR1 TR1 SEC1 N -> FLAG.) ( USES R0, R1. READ N SECTORS.) S )+ R1 MOV, ( # OF SECTORS TO READ) BEGIN, 7 # R0 MOV, PC ' DRIVE2? JSR, ( A DJUST ) R0 RXCS MOV, WAITT, ( 'READ' COMMAND) S )+ RXDB MOV, WAITT, ( MOVE SECTOR #) S )+ RXDB MOV, WAITD, ( MOVE TRACK #) ERRTST, 3 # RXCS MOV, ( 'EMPTY' COMMAND) EMPTY, ERRTST, R1 DEC, EQ UNTIL, S -) CLR, ( FLAG, 0=GOOD READ) NEXT, C; : RTS ( ADDR TR SEC -> FLAG) 1 NRTS IF ." DISK READ ERROR IN RTS" QUIT THEN ; ( FLOPPY DRIVER - NWTS) CODE NWTS ( ADDRN TRN SECN ... ADDR1 TR1 SEC1 N -> FLAG.) ( USES R0, R1. WRITE N SECTORS) S )+ R1 MOV, ( # OF SECTORS TO BE WRITTEN) BEGIN, 1 # RXCS MOV, WAITT, ( 'FILL' COMMAND) 4 S I) S -) MOV, ( PUSH COPY OF ADDRESS) FILL, ERRTST, 5 # R0 MOV, PC ' DRIVE2? JSR, ( ADJUST) R0 RXCS MOV, WAITT, ( 'WRITE' COMMAND) S )+ RXDB MOV, WAITT, ( MOVE SECTOR #) S )+ RXDB MOV, WAITD, ( MOVE TRACK #) ERRTST, S )+ TST, ( POP ADDRESS) R1 DEC, EQ UNTIL, S -) CLR, ( FLAG, 0 = GOOD WRITE) NEXT, C; : WTS ( ADDR TR SEC -> FLAG) 1 NWTS IF ." DISK WRITE ERROR IN WTS" QUIT THEN ; ( FLOPPY DRIVER - SKEW, NSETUP) OCTAL ( NOTE - THE 'SEQUENCE #' IS 0-ORIGIN SECTOR SEQUENCE, SKEWED) : SKEW1 ( SEQUENCE# -> TRACK SECTOR) ( TR=S/32+1; SEC=<6+2S+/15>MO D 32 + 1 ) DUP 32 / SWAP OVER 6 * OVER 2 * + SWAP 32 MOD 15 / + 32 MOD 1+ SWAP 1+ SWAP ; DECIMAL 56 LOAD : NSETUP ( ADDR SEQ# N -> ADDRN TRN SECN ... ADDR1 TR1 SEC1) OVER 1975 > IF SWAP 56 + SWAP THEN ( 1920 VS 2002 PER DISK) ROT OVER 128 * + ROT ROT ( INCREMENT ADDRESS TO PAST AREA) OVER + 1 - SWAP 1 - SWAP ( SET UP FOR +LOOP ON SEQ#) DO 128 - ( ADJUST THE ADDRESS) DUP ( COPY ADDRESS) I SKEW ( COMPUTE TRACK & SECTOR) ROT ( BRING COPY OF ADDRESS TO STACK TOP) -1 +LOOP DROP ( EXTRA ADDRESS) ; ( FLOPPY - TR/W) : ?READERR ( FLAG ->) IF ." DISK READ ERROR" QUIT ENDIF ; : ?WRITERR ( FLAG ->) IF ." DISK WRITE ERROR" QUIT ENDIF ; : TR/W ( ADDR BLOCK# R=1,W=0 ->) >R 6 + 8 * R> ( CHANGE SCREEN # TO FIRST SEQ #) IF 8 NSETUP 8 NRTS ?READERR ELSE 8 NSETUP 8 NWTS ?WRITERR THEN ; ' TR/W 2 - ' BUFFER 44 + ! ' TR/W 2 - ' BLOCK 50 + ! ' TR/W 2 - ' FLUSH 36 + ! ( FLOPPY - ERROR TEST. LOAD AFTER 50.) ASSEMBLER DEFINITIONS OCTAL : ERRTST, ( MACRO - IF ERROR, -> -1 AND EXIT) RXCS TST, LT IF, -1 # S -) MOV, NEXT, THEN, ; FORTH DEFINITIONS DECIMAL CODE DRIVE2? ( ->. SUBROUTINE - ADJUST R0, TRACK IF SECOND DR) 2 S I) 114 # CMP, ( TRACK > 76 ? ) HI IF, 115 # 2 S I) SUB, ( SUBTRACT 77) 20 # R0 BIS, ( SET UNIT-SELECT BIT) THEN, PC RTS, C; ( FLOPPY - APPENDAGE OF 53) : SKEW ( LIKE BEFORE, ONLY HANDLE 2ND DRIVE) DUP 1975 > IF 1976 - SKEW1 SWAP 77 + SWAP ELSE SKEW1 THEN ; ( EDITOR COMMAND DEFINITIONS 03DEC81PDC) --> THIS EDITOR WAS TAKEN FROM 'DOCTOR DOBB'S JOURNAL' ISSUE 59, DATED SEPT. 1981 AND WAS TYPED IN BY TERRY BOSSERT O F RMS. THE FORTH EDITOR IS EASY TO LEARN AND TO USE. IT CONSISTS OF CONTROL KEY COMMANDS THAT ALLOW CURSOR MOVEMENT AND TEXT ENTRY AND DELETION SO THAT EDITING CAN BE DONE QUICKLY AND SMOOTHLY. CURSOR MOVEMENT YOU CAN PLACE THE CURSOR ANYWHERE ON THE SCREEN BY USING A FEW EDITING COMMANDS. THE FOLLOWING TABLE DESCRIBES THE COMMANDS THAT ARE RELEVANT TO CURSOR MOVEMENT. ( CURSOR MOVEMENT COMMANDS 03DEC81PDC) --> COMMAND FUNCTION DESCRIPTION ^E CURSOR UP MOVES THE CURSOR UP TO THE SAME A LINE POSITION IN THE PRECEDING LINE. ^X CURSOR DOWN MOVES THE CURSOR DOWN TO THE A LINE SAME POSITION IN THE NEXT LINE. *^R CURSOR UP MOVES CURSOR UP TO THE SAME FOUR LINES POSITION FOUR LINES UP. *^C CURSOR DOWN MOVES CURSOR TO THE SAME FOUR LINES POSITION FOUR LINES DOWN. ( CURSOR MOVEMENT COMMANDS 03DEC81PDC) --> ^S CURSOR LEFT MOVES CURSOR TO THE ^H ONE CHARACTER PREVIOUS CHARACTER OR DELETE SPACE. ^D CURSOR RIGHT MOVES CURSOR TO THE NEXT ONE CHARACTER CHARACTER OR SPACE. ^F CURSOR RIGHT MOVES CURSOR FORWARD TO THE A WORD FIRST LETT ER OF THE NEXT WORD GOING TO THE BEGINNING OF THE NEXT LINE IF AT THE END OF THE CURRENT LINE. ( CURSOR MOVEMENT COMMANDS 03DEC81PDC) --> ^A CURSOR LEFT MOVES CURSOR BACK TO THE FIRST A WORD LETTER O F THE PREVIOUS WORD GOING TO THE END OF THE PREVIOUS LINE IF AT THE BEGINNING OF THE CURRENT LINE ^I TAB MOVES THE CURSOR TO THE NEXT TABTAB STOP ON THE LINE GOING TO THE NEXT LINE IF AT THE END OF THE CURREN T LINE. * THE POSITION OF THE CURSOR WILL DIFFER DEPENDING ON THE NUMBEROF INTERVENING LINES BETWEEN THE TOP AND BOTTOM OF THE SCREEN. IF YOU ENTER ^R WHEN THE CURSOR IS LESS THAN 4 LINES DOWN FROM THE TOP OF THE SCREEN, THE CURSOR WILL MOVE TO THE FIRST LINE. ( CURSOR HINTS 03DEC81PDC) --> SIMILARLY, IF THE CURSOR IS LESS THAN 4 LINES UP FROM THE BOTTOMOF THE SCREEN, ^C MOVES THE CURSOR T O THE LAST LINE. USING THESE COMMANDS SINGLY OR IN COMBINATIONS, YOU CAN MOVE THE CURSOR WHEREVER YOU WANT IT. IF, FOR INSTANCE, YOU WANT TO MOVE THE CURSOR TO THE END OF THE CURRENT LINE, YOU ENTER THE FOLLOWING COMBINATION: CARRIAGE RETURN ^A WHEN THE CURSOR IS ANYWHERE IN THE LAST LINE, YOU CAN MOVE IT TO THE BEGINNING OF THAT LINE BY ENTERING A CARRIAGE RET. ( TEXT ENTRY AND DELETION 03DEC81PDC) --> WITH SPECIAL EDITING COMMANDS, YOU CAN ENTER ADDITIONAL TEXT OR TAKE OUT EXISTING TEXT IN YOU R FORTH SCREENS. THE FOLLOWING TABLES DESCRIBE THE COMMANDS THAT ARE RELEVANT TO TEXT ENTRY AND DELETION. TEXT ENTRY COMMANDS FUNCTIONS DESCRIPTION *^V INSERTION TYPES OVER CHARACTERS WHEN OFF OFF/ON AND INSERTS CHARACTERS WHEN ON. WHEN ON, 'INSERT ON' APPEARS IN THE TOP (STATUS) LINE. ^V IS A TOGGLE THAT TURNS INSERT OFF. ( SPREADING LINES 03DEC81PDC) --> WHEN IT IS ON AND WHEN IT IS OFF. ^N INSERT INSERTS A CARRIAGE RETURN AT THE CARRAIGE CURSOR POSITION, AND LEAVES RETURN CURSOR UNMOVED. ALL TEXT TO THE RIGHT OF AND BELOW CURSOR MOVES DOWN ONE LINE, BUT ONLY IF THE LAST LINE IS BLANK. TEXT IN LAST LINE CAUSES ERROR. * A CARRIAGE RETURN HAS TH E SAME EFFECT ON THE TEXT WHETHER ^V (INSERT MODE) IS ON OR OFF. IN OTHER WORDS, PRESSING CARRAIGE RETURN WHILE INSERT IS ON WILL NOT RESULT IN INSERTING A CARRIAGE RETURN. ( TEXT DELETION 03DEC81PDC) --> COMMAND FUNCTION DESCRIPTION ^G DELETE DELETES THE CHARACTER UNDER CHARACTER THE CURSOR AND MOVES EVERYTHING RIGHT TO THE RIGHT OF IT ONE CHAR. ^T DELETE DELETES WORD CONTAINING THE WORD CURSOR, SPECIFICALLY THE RIGHT CHARACTER UNDER THE CURSOR AND THE CHARACTERS TO THE RIGHT OF IT TO THE END OF THE WORD. ( DELETING TEXT 03DEC81PDC) --> ^B DELETE LINE DELETES THE TEXT IN THE CURRENT CONTENTS LINE WITHOUT DELETING THE LINE (LEAVES A BLANK LINE) ^Y DELETE LINE DELETES THE CURRENT LINE AND MOVES THE LINES UNDER IT UP THEREBY SHRINKING THE SCREEN. ^K DELETE DELETES THE ENTIRE CONTENTS OF (KILL) THE CURRENT SCREEN. SCREEN ( EXITING FROM THE EDITOR 03DEC81PDC) --> ^Z ABANDON EXITS FROM THE EDITOR. THE SCREEN BLOCK IS NOT MARKED AS UPDATED. HENCE, TYPING 'EMPTY-BUFFERS' AT THIS POINT WILL ALLOW YOU TO RETRIEVE THE CONTENTS OF THE SCREEN AS IT WAS BEFORE ANY EDITING TOOK PLACE. IF YOU RE-ENTER THE EDITOR BEFORE TYPING 'EMPTY-BUFFERS', YOU WILL GET THE EDITED VERSION OF THE SCREEN. ( EXITING FROM THE EDITOR & REFRESH TERMINAL 03DEC81PDC) --> ESC EXIT EXITS THE EDITOR AND WRITES THE EDIT OR SCREEN BACK TO DISK IF IT WAS MODIFIED. THE USED ID IS AUTO- MATICALLY INSERTED IN THE RIGHT- MOST 10 CHARACTERS OF LINE 0. ^Q REFRESH WILL REFRESH THE TERMINAL SCREEN. THE TERMINAL CURRENT CURSOR POSITION WILL BE LOST. ( \ COMMMENT TO END OF THE LINE 03DEC81PDC) : \ IN @ C/L / 1+ C/L * IN ! ; IMMEDIATE --> \ (S (P DOCUMENTATION WORDS 19NOV81TMB : (S 41 WORD ; IMMEDIATE ( (S IS USED FOR STACK COMMENTS. A UTILITY MAY BE WRITTEN LATER TO EXTRACT THESE ) : (P 41 WORD ; IMMEDIATE ( (P IS USED FOR DESCRIPTIVE COMMENTS. A UTILITY MAY BE WRITTEN LATER TO EXTRACT THESE ) --> \ DEPTH RETURN DEPTH OF STACK 19NOV81TMB : DEPTH SP@ S0 @ SWAP - 2 / 0 MAX ; (P RETURNS THE CURRENT DEPTH OF THE STACK. THIS WORD MAY NEED TO BE REDEFINED WHEN RUNNING ON OTHER SYSTEMS, AS IT USES A COMPUTER DEPENDENT WORD CALLED SO, WHICH CONTAINS THE STARTING ADDRESS OF THE STACK. ) --> \ L INTELLIGENT SCREEN LISTS 19NOV81PDC : L (S [N] ---) DEPTH IF \ IS THERE ANYTHING THERE ? DUP SCR ! \ YES, REMEMBER IT ELSE SCR @ \ NO, RETRIEVE LAST ONE ENDIF LIST ; \ AND LIST IT (P L WILL LIST THE SPECIFIED SCREEN AND REMEMBER WHAT NUMBER IT WAS. IF THE DEPTH OF THE STACK IS ZERO, IT WILL LIST THE LAST SCREEN PREVIOUS LISTED. IT MAKES USE OF THE VARIABLE SCR. ) --> \ 2DROP 2* BEEP 19NOV81TMB : 2DROP DROP DROP ; (P 2DROP DROPS 2 ITEMS OFF OF THE PARAMETER STACK. ) : 2* DUP + ; (P 2* SIMPLY DOUBLES THE ITEM ON THE TOP OF THE STACK ) : BEEP 7 EMIT ; (P RING THE BELL ON THE TERMINAL. USUALLY AFTER AN ERROR ) --> \ BOUNDS DO LOOP SETUP 19NOV81TMB : BOUNDS OVER + SWAP ; (P BOUNDS IS A COMMON DO LOOP SETUP WORD. IT ASSUMES THERE IS AN ADDRESS AND A LENGTH ON THE STACK. BOUNDS CONVERTS THIS INTO A HIGH ADDRESS AND A LOW ADDRESS. THE I INDEX OF A DO LOOP WILL THEN RUN THROUGH THIS RANGE OF VALUES WHILE EXECUTING ) : 2DUP OVER OVER ; --> \ BMOVE HIGH LEVEL 19NOV81TMB\ : BMOVE -DUP IF >R R + 1 - SWAP 1 - R> BOUNDS SWAP DO I C@ OVER C! 1 - -1 +LOOP DROP ELSE 2DROP ENDIF ; (P BMOVE IS IDENTICAL TO CMOVE EXCEPT IT MOVES CHARACTERS IN THE OTHER DIRECTION. ) --> \ MOVE WORKS IN EITHER DIRECTION 19NOV81TMB : MOVE ROT ROT 2DUP U< IF ROT BMOVE ELSE ROT CMOVE ENDIF ; (P MOVE WILL MVOE LEN BYTES FROM ADDRESS FROM TO ADDRESS TO AND WILL NOT OVERLAP THEM, NO MATTER WHAT THE RELATIVE VALUES OF FROM TO AND LEN ARE. MOVE SHOULD ALWAYS BE USED WHENEVER THERE IS DANGER OF OVERLAPPING FIELDS ) --> \ 1- 2- DECREMENT 23NOV81TMB : 1- (S N --- N-1 ) 1 - ; : 2- (S N --- N-2 ) 2 - ; --> \ >= <> <= U> CONDITIONALS 23NOV81TMB : >= (S N1 N2 --- BOOL ) < 0= ; : <> (S N1 N2 --- BOOL ) = 0= ; : <= (S N1 N2 --- BOOL ) > 0= ; : U> (S N1 N2 --- BOOL ) SWAP U< ; --> \ RE-FORTH RE-ENTER FORTH FOR 1 LINE 24NOV81PDC : RE-FORTH (S --- ??? ) IN @ >R \ SAVE INPUT BUFFER POINTER BLK @ >R \ SAVE BLOCK NUMBER 0 IN ! 0 BLK ! \ RESET FOR TERMINAL INPUT QUERY INTERPRET \ GET 1 LINE FROM TERMINAL R> BLK ! \ RESTORE BLOCK NUMBER R> IN ! ; \ RESTORE INPUT BUFFER POINTER (P RE-FORTH REENTERS THE FORTH INTERPRETER FROM THE TERMINAL AND ALLOWS THE USER TO ENTER 1 LINE OF VALID FORTH COMMANDS. THIS IS A SIMPLE WAY TO PROMPT FOR TERMINAL MESSAGES WHILE IN THE MIDDLE OF LOADING. ) --> \ ?DUP SAME AS -DUP FOR FORTH-79 & SCREENMOVE 04DEC81PDC : ?DUP (S N-- [N] N ) -DUP ; (P DUPLICATES THE TOP OF THE STACK IF THE TOP OF THE STACK IS NOZERO. IF THE TOP IS ZERO, THEN IT IS NOT DUPLICATED. THIS IS DEFINED PRIMARILY FOR FORTH-79 COMP. ) : SCREENMOVE \ FROM TO -> FLUSH SWAP BLOCK SWAP BL OCK UPDATE 1024 CMOVE ; (P THIS COMMAND WILL MOVE SCREENS BETWEEN THOSE NUMBERS SPECIFIED. NOTICE THE DIRECTION IS ORININATING SCREEN, DESTINITION SCREEN. ) \ CASE: 23NOV81TMB : CASE: (S N --- ) SWAP 2* + @ EXECUTE ; (P CASE: IS A POOR MAN'S CASE STATEMENT. AT COMPILE TIME, IT SIMPLY COMPILES CODE FIELD ADDRESS AS DOES : AT RUN TIME, IT EXPECTS AN INDEX ON TH E STACK, AND SIMPLY INDEXES INTO THE DEFINED WORDS AND EXECUTES IT. ) --> \ -TIDY 23NOV81TMB : -TIDY (S ADDR LE N --- ) BOUNDS DO \ RUN THROUGH THE STRING I C@ BL < IF \ IS IT A CONTROL CHAR? BL I C! \ YES, REPLACE IT WITH A BLANK ENDIF LOOP ; (P -TIDY REPLACES ALL CONTROL CHARACTERS IN A SPECIFIED RANGE WITH BLANKS ) : BOB 200 1 DO . LOOP ; --> \ VARIABLE AND CONSTANT DEFINITIONS 23NOV81TMB VOCABULARY EDITOR IMMEDIATE EDITOR DEFINITIONS 0 VARIABLE &MODE \ CURRENT MODE OVERSTRIKE OR INSERT 0 VARIABLE &CURSOR \ CURSOR POSITION 0 VARIABLE &OLD-MODE \ PREVIOUS MODE 0 VARIABLE &UPDATE \ UPDATE FLAG 0 VARIABLE &BUF-ADR \ ADDRESS OF CURRENT BUFFER 0 VARIABLE &E-ID \ DATE AND USER ID LAST MODIFIED 12 ALLOT &E-ID 14 BLANKS \ INITIALIZE TO BLANKS 5 CONSTANT %X- OFF \ X OFFSET FOR CURSOR POSITIONING 2 CONSTANT %Y-OFF \ Y OFFSET FOR CURSOR POSITIONING B/SCR B/BUF * CONSTANT C/SCR \ CHARACTER PER SCREEN C/SCR C/L / CONSTANT L/SCR \ LINES PER SCREEN --> \ CURSOR POSITIONING VECTORS 23NOV81TMB 0 VARIABLE ' CRTXY \ CFA OF ROUTINE THAT MOVES CURSOR 0 VARIABLE 'CRTCLR-SCR \ CFA OF ROUTINE THAT CLEARS SCREEN 0 VARIABLE 'CLEAR-TO-EOL \ CFA OF ROUTINE THAT CLEARS TO EOL : CRTXY 'CRTXY @ EXECUTE ; : CRTCLR-SCR 'CRTCLR- SCR @ EXECUTE ; : CLEAR-TO-EOL 'CLEAR-TO-EOL @ EXECUTE ; --> \ DESCRIPTION OF CURSOR COMMANDS 23NOV81TMB--> THE CRTX Y COMMAND MUST POSITION THE CURSOR AT THE X AND Y CO-ORDINATES GIVEN ON THE STACK. IF YOUR TERMINAL DOES NOT SUPPORT CURSOR POSITIONING, GIVE UP. THE CRTCLR-SCR SHOULD CLEAR THE ENTIRE SCREEN AND HOME THE CURSOR. IF SUCH A COMMAND IS NOT AVAILABLE, OUTPUT A SUFFICIENT NUMBER OF LINE-FEEDS TO CLEAR THE SCREEN VIA SCROLLING, AND THENCALL CRTXY WITH 0 0. THE CRTCLR-EOL COMMAND SHOULD CLEAR THE LINE FROM ITS CURRENT LOCATION TO THE END OF THE LINE. THE FOLLOWING WILL ALWAYS WORK, BUT IF YOUR TERMINAL SUPPORTS SOMETHING MORE SOPHISTICATEDYOU SHOULD USE IT. \ DESCRIPTION OF CURSOR POSITIONING COMMANDS 23NOV81TMB--> NOTE!! THE CLEAR-TO-EOL COMMAND IS ALWAYS CALLED WITH THE CURSOR POSITIONED AT THE CORRECT PLACE ON THE SCREEN. HENCE IF YOUR TERMINAL SUPPORTS A CLEAR TO END OF LINE COMMAND, THE POSITION PASSED CAN BE SIMPLY DROPPED AND THE TERMINAL COMMAND ISSUED. IF THE TERMINAL DOES NOT SUPPORT SUCH A CO MMAND, YOU MUST BLANK OUT THE REMAINDER OF THE LINE BASED ON THE CURSOR POSITION THAT WAS PASSED. \ DESCRIPTION OF CURSOR POSITIONING COMMANDS 23NOV81TMB--> IF YOU WOULD LIKE TO SEE HOW SOME SAMPLE CURSOR POSITIONING ROUTINES WERE WRITTEN, TAKE A LOOK AT SCREENS 90-91. NOTE THAT YOU MAY WRITE YOUR OWN ROUTINES EVEN AFTER THE COMPLETE EDITOR HAS BEEN LOADED. ALL YOU NEED DO IS PATCH THE EXECUTE VECTORS FOR YOUR PARTICULAR TERMINAL. GOOD LUCK. \ CURPOS +CURPOS MOVE-CURSOR 23NOV81TMB: CURPOS (S --- POS ) &CURSOR @ ; \ RETURN CURRENT CURSOR POSITION : +CURPOS (S N --- ) &CURSOR +! CURPOS 0 MAX \ AND DO BOUNDS CHECKING [ C/SCR 1- ] LITERAL \ CHAR PER SCREEN - 1 MIN &CURSOR ! ; \ ALWAY VALID : MOVE-CURSOR (S N --- ) +CURPOS \ MOVE THE CURSOR CURPOS C/L /MOD \ RAW X Y %Y-OFF + SWAP \ ADD IN Y OFFSET %X-OFF + SWAP \ ADD IN X OFFSET CRTXY ; --> \ ADD MOVE THERE \ BUF-ADR BUFPOS 23NOV81TMB : BUF-ADR (S POS --- ADDR ) &BUF-ADR @ + ; (P BUF-ADR CONVERTS THE CURSOR POSITION IT IS CALLED WITH TO THE ADDRESS WITHIN THE DISK BUFFER WHICH CORRESPONDS TO THAT POSITION ) : BUFPOS (S --- ADDR ) CURPOS BUF-ADR ; (P BUFPOS RETURNS THE ADDRESS IN THE DISK BUFFER OF THE CURRENT CHARACTER ) --> \ E-UPDATE 24NOV81TMB : E-UPDATE (S --- ) 1 &UPDATE ! ; \ SET UPDATE FLAG (P E-UPDATE IS CALLED WHENEVER THE CONTENTS OF THE BUFFER HAS CHANGED. IT SETS AN THE UPDATE FLAG. ) --> \ BUF-MOVE 24NOV81TMB : BUF-MOVE (S FROM TO LEN --- ) ROT BUF-ADR ROT BUF-ADR ROT MOVE E-UPDATE ; (P BUF-MOVE PERFORMS A MOVE OPERATION ON THE CHARACTERS IN THE DISK BUFFER CORRESPONDING TO THE GIVEN CURSOR POSITIONS. ) --> \ ?PRINTABLE 30NOV81PDC : ?PRINTABLE (S CHAR --- BOOL ) DUP 32 < SWAP 126 > OR 0= ; (P ?PRINTABLE RETURNS A TRUE FLAG IF THE CHARACTER IS PRINTABLE. OTHERWISE IT RETURNS A FALSE FLAG ) --> \ >LINE# LINE#> CONVERT LINE NO. TO/FROM 03DEC81PDC : >LINE# (S POS --- LINE# ) C/L / ; (P CONVERTS A CHARACTER POSITION TO A LINE NUMBER ) : LINE#> (S LINE# --- POS ) C/L * ; (P CONVERTS A LINE NUMBER TO A CHARACT ER POSITION ) --> \ CHARS-TO-EOL TMB30NOV81 : CHARS-TO-EOL (S POS --- N ) C/L MOD C/L SWAP - ; (P CHARS-TO-EOL RETURNS THE NUMBER OF CHARACTERS LEFT ON THE LINE GIVEN THE CURRENT CHARACTER POSITION ) --> \ DISPLAY-TO-EOL TMB30NOV81 : DISPLAY-TO-EOL (S POS --- ) DUP BUF-ADR \ GET ADDRESS IN BUFFER OVER CHARS-TO-EOL \ REST OF LINE -TRAILING \ IGNORE BLANKS ROT OVER + >R \ SAVE RESULTANT CURSOR POSITION TYPE \ DISPLAY WHATS THERE R> CLEAR-TO-EOL ; \ AND REMOVE THE REST (P DISPLAY-TO-EOL DISPLAYS THE REST OF THE LINE STARTING FROM THE CURRENT CURSOR POSITION. IT ASSUMES THAT THE TERMINAL CURSOR IS PROPERLY POSITIONED BEFORE IT EXECUTES. ) --> \ ?EMPTY-LINE TMB30NOV81 : ?EMPTY-LINE (S LINE# --- BOOL ) LINE#> BUF-ADR C/L \ ADDR LEN -TRAILING \ REMOVE TRAILING BLANKS SWAP DROP 0= ; \ REPORT SUCCESS IF ALL BLANKS (P ?EMPTY-LINE RETURNS TRUE IF THE SPECIFIED LINE NUMBER IS COMPLETELY BLANK. OTHERWIS E IT RETURNS FALSE. ) --> \ DISPLAY-TO-EOS TMB30NOV81 : DISPLAY-TO-EOS (S LINE# --- ) CURPOS SWAP \ SAVE CURRENT CURSOR POSITION L/SCR SWAP DO \ RUN THROUGH REST OF SCREEN I LINE#> DUP &CURSOR ! \ SET CURSOR POSITION 0 MOVE-CURSOR DISPLAY-TO-EOL \ AND DISPLAY LINE FROM THERE LOOP &CURSOR ! \ RESTORE CURSOR POSITION 0 MOVE-CURSOR ; (P DISPLAY THE ENTIRE SCREEN FROM THE GIVEN LINE NUMBER TO THE END OF THE SCREEN. THIS IS USED WHEN A LINE IS INSERTED OR DELETED FROM THE MIDDLE OF THE SCREEN ) --> \ EXPAND TMB30NOV81 : EXPAND (S POS --- ) DUP DUP \ P P P C/L + \ P FROM TO C/SCR OVER - \ P FROM TO LEN BUF-MOVE \ TEXT MOVED IN BUFFER BUF-ADR C/L BLANKS \ INSERT BLANK LINE E-UPDATE ; (P EXPAND MOVES ALL OF THE LINES DOWN BY ONE AND INSERTS A BLANK LINE AT THE SPECIFIED POSITION. ) --> \ SHRINK TMB30NOV81 : SHRINK (S POS --- ) DUP \ POS POS C/L + SWAP \ FROM TO OVER C/SCR SWAP - \ FROM TO LEN BUF-MOVE \ MOVE IT [ L/SCR 1- ] LITERAL \ INSERT A BLANK LINE LINE#> BUF-ADR C/L BLANKS \ AT THE BOTTOM OF THE SCREEN E-UPDATE ; (P SHRINK DELETES THE SPECIFIED LINE IN THE DISK BUFFER AND REPLACES THE LAST LINE OF THE SCREEN WITH A BLANK LINE ) --> \ INSERT-LINE TMB30NOV81 : INSERT-LINE (S POS --- ) [ L/SCR 1- ] LITERAL \ LAST LINE NUMBER ?EMPTY-LINE IF \ IS IT EMPTY? DUP EXPAND \ YES, EXPAND THE BUFFER >LINE# DISPLAY-TO-EOS \ AND REDISPLAY THE SCREEN ELSE BEEP \ NO, WARN USER ENDIF ; (P INSERT-LINE CHECKS TO SEE THAT THERE IS NO TEXT ON THE LAST LINE OF THE SCREEN. IF THERE IS NONE, IT EXPANDS THE SCREEN AT THE GIVEN CURSOR POSITION AND RE-DISPLAYS THE ALTERED SCREEN ) --> \ DELETE-LINE TMB30NOV81 : DELETE-LINE (S POS --- ) >LINE# DUP LINE#> SHRINK DISPLAY-TO-EOS ; (P DELETE-LINE REMOVE THE LINE THE CURSOR IS ON AND RE-DISPLAYS THE RESULTING SCREEN ) --> \ INS-CHAR TMB30NOV81 : INS-CHAR (S CHAR POS --- ) DUP DUP 1+ \ CHAR POS FROM TO OVER CHARS-TO-EOL 1- \ CHAR POS FROM TO LEN BUF-MOVE \ MOVE IT BUF-ADR C! ; \ AND STICK IN CHAR (P INS-CHAR INSERTS THE GIVEN CHARACTER INTO THE DISK BUFFER. NO TE THAT CHARACTERS FALLING OFF THE RIGHT END OF THE LINE ARE LOST IF CAUTION IS NOT USED. ) --> \ DEL-CHAR TMB30NOV81 : DEL-CHAR (S POS --- ) DUP DUP 1+ SWAP \ POS FROM TO OVER CHARS-TO-EOL \ POS FROM TO LEN BUF-MOVE \ MOVE IT DUP CHARS-TO-EOL + 1- \ POSITION AT EOL BUF-ADR BL SWAP C! ; \ AND STICK IN A BLANK (P DEL-CHAR DELETES THE CHARACTER AT THE SPECIFIED CURSOR POSITION ) --> \ ARROW COMMANDS TMB30N OV81 : R-ARROW (S --- ) 1 +CURPOS ; \ MOVE RIGHT BY ONE : L-ARROW (S --- ) -1 +CURPOS ; \ MOVE LEFT BY ONE : U-ARROW (S --- ) C/L MINUS +CURPOS ; \ MOVE UP BY ONE : D-ARROW (S --- ) C/L +CURPOS ; \ MOVE DOWN BY ONE --> \ I-LINE D-LINE D-CHAR INSERT-MODE TM B30NOV81 : I-LINE (S --- ) CURPOS INSERT-LINE ; : D-LINE (S --- ) CURPOS DELETE-LINE ; : D-CHAR (S --- ) CURPOS DEL-CHAR CURPOS DISPLAY-TO-EOL ; : INSERT-MODE &MODE 1 TOGGLE ; --> \ RETURN EXIT-EDIT 03DEC81PDC : RETURN (S --- ) CURPOS >LINE# \ GET LINE NUMBER OF CURRENT LINE 1+ \ INCREMENT BY ONE [ L/SCR 1- ] LITERAL MIN \ DON'T MOVE BELOW BOTTOM LINE#> &CURSOR ! ; \ AND MOVE THERE (P RETURN IS EXECUTED WHENEVER THE CARRIAGE RETURN KEY IS PRESSED. IT MOVES THE CURSOR TO THE BEGINNING OF THE NEXT LINE. IF THE CURSOR IS AT THE BOTTOM OF THE SCREEN, IT REMAINS THERE. ) : EXIT-EDIT (S --- ) CR R> DROP R> DROP R> DROP R> DROP R> DROP -BKEY DROP ; (P GET OUT OF THE EDITOR FOR OTHER THINGS ) --> \ EXIT-UPDATE 19NOV81PDC : EXIT-UPDATE CRTCLR-SCR \ CLEAR THE CRT SCREEN CR CR \ SKIP DOWN 2 LINES SCR @ . \ TELL USER THE SCREEN NUMBER &UPDATE @ IF \ HAS SCREEN BEEN MODIFIED ? &E-ID \ YES, GET THE USER ID [ C/L 10 - ] LITERAL \ GET THE 'MOVE TO' ADDRESS BUF-ADR 10 CMOVE \ PUT USER ID IN SCREEN POSITION ." MODIFIED " UPDATE FLUSH \ TELL THE USER SCREEN WAS UPDATE ELSE ." UNMODIFIED " ENDIF \ OTHERWISE, SCREEN NOT CHANGED EXIT-EDIT ; \ BLAST OUT OF THE EDITOR (P EXIT-EDIT LEAVES THE EDITOR AND RETURNS TO FORTH. IF THE SCREEN WAS CHANGED, THE USER ID IS PUT IN CORNER ) --> \ EXIT-SCRATCH 19NOV81PDC : EXIT-SCRATCH (S --- ) CRTCLR-SCR \ CLEAR THE CRT SCREEN CR CR \ SKIP DOWN 2 LINES SCR ? \ TELL THE USER THE SCREEN NUMBER ." ABANDONED " \ AND THE SCREEN WAS LEFT UNCHANGED EXIT-EDIT ; \ BLAST OUT OF THE EDITOR (P EXIT-SCRATCH WILL LEAVE THE EDITOR ) --> \ E-TAB TMB30NOV81 : E-TAB (S --- ) 8 CURPOS 8 MOD - +CURPOS ; (P MOVE THE CURSOR TO THE NEXT TAB STOP. TABS ARE CURRENTLY DEFINED AS BEING 8 APART, CAN BE RE-DEFINED SIMPLY ALTERING E-TAB ) --> \ SCAN+= TMB30NOV81 : SCAN+= (S CHAR ADR1 ADR2 --- N ) 2DUP = IF \ RETURN ZERO IF THERE DROP 2DROP 0 \ IS NOTHING TO SEARCH ELSE 0 ROT ROT DO \ OTHERWISE RUN THROUGH MEMORY OVER I C@ = IF \ FROM LOW TO HIGH LEAVE \ LO OKING FOR THE SPECIFIED CHAR. ELSE 1+ ENDIF LOOP SWAP DROP \ RETURN RESULT ENDIF ; (P SCANS THROUGH MEMORY STARTING AT ADR2 TO ADR1 AND INCREMENTING BY +1 LOOKING FOR THE SPECIFIED CHARACTER. RETURNS THE NUMBER OF CHARACTERS SCANNED UNTIL SUCCESS ) --> \ SCAN+<> TMB30NOV81 : SCAN+<> (S CHAR ADR1 ADR2 --- N ) 2DUP = IF \ RETURNS ZERO IF THERE DROP 2DROP 0 \ IS NOTHING TO SEARCH ELSE 0 ROT ROT DO \ OTHERWISE RUN THROUGH MEMORY OVER I C@ <> IF \ FROM LOW TO HIGH LEAVE \ UNTIL ANY CHARACTER BUT THE ELSE 1+ ENDIF \ SPECIFIED ONE IS SEEN LOOP SWAP DROP \ RETURN RESULT ENDIF ; (P SCANS THROUGH MEMORY STARTING AT ADR2 TO ADR1 AND INCREMENTING BY +1 UNTIL ANY CHARACTER NOT MATCHING THE ONE SPECIFIED IS FOUND. RETURNS COUNT OF CHARACTERS SCANNED ) --> \ SCAN-= TMB30NOV81 : SCAN-= (S CHAR ADR1 ADR2 --- N ) 2DUP = IF \ RETURN ZERO IF THERE DROP 2DROP 0 \ IS NOTHING TO SEARCH ELSE 0 ROT ROT DO \ OTHERWISE RUN THROUGH MEMORY OVER I C@ = IF \ FROM HIGH TO LOW LEAVE \ LOOKING FOR THE SPECIFIED CHAR. ELSE 1- ENDIF -1 +LOOP SWAP DROP \ RETURN RESULT ENDIF ; (P SCANS THROUGH MEMORY STARTING AT ADR2 TO ADR1 AND DECREMENTING BY -1 LOOKING FOR THE SPECIFIED CHARACTER. RETURNS THE NUMBER OF CHARACTERS SCANNED UNTIL SUCESS ) --> \ SCAN-<> TMB30NOV81 : SCAN-<> (S CHAR ADR1 ADR2 --- N ) 2DUP = IF \ RETURN ZERO IF THERE DROP 2DROP 0 \ IS NOTHING TO SEARCH ELSE 0 ROT ROT DO \ OTHERWISE RUN THROUGH MEMORY OVER I C@ <> IF \ FROM HIGH TO LOW LEAVE \ UNTIL ANY CHARACTER BUT THE ELSE 1- ENDIF \ SPECIFIED ONE IS SEEN -1 +LOOP SWAP DROP \ RETURN RESULT ENDIF ; --> (P SCANS THROUGH MEMORY STARTING AT ADR2 TO ADR1 AND DECREMENTING BY -1 UNTIL ANY CHARACTER NOT MATCHING THE SPECIFEID ONE IS FOUND. RETURNS COUNT OF CHARACTERS SCANNED ) \ MOVE-LEFT-WORD TMB30NOV81 : MOVE-LEFT-WORD (S --- N ) BL 0 BUF-ADR BUFPOS \ SCANS BACKWARDS FOR THE SCAN-= >R \ FIRST BLANK BL 0 BUF-ADR BUFPOS R + \ NOW SCAN BACKWARDS FOR THE SCAN-<> R> + >R \ FIRST NON BLANK BL 0 BUF-ADR BUFPOS R + \ FINALLY LOOK FOR THE FIRST SCAN-= R> + \ BLANK AGAIN. DUP BUFPOS + C@ BL = IF \ CORRECT FOR THE POSSIBILITY 1+ \ THAT BLANK WAS NOT FOUND ENDIF ; \ AT THE BEGINNING OF THE SCREEN (P RETURNS THE NUMBER OF CHARACTERS THAT MUST BE SKIPPED TO MOVE TO THE BEGINNING OF THE PREVIOUS WORD, RELATIVE TO THE CURRENT CURSOR POSITION. THE NUMBER RETURNED IS ALWAYS LESS THAN OR EQUAL TO ZERO ) --> \ MOVE-RIGHT-WOR D TMB30NOV81 : MOVE-RIGHT-WORD (S --- N ) BL [ C/SCR 1- ] LITERAL BUF-ADR BUFPOS SCAN+= >R BL [ C/SCR 1- ] LITERAL BUF-ADR BUFPOS R + SCAN+<> R> + ; (P RETURNS THE NUMBER OF CHARACTERS THAT MUST BE SKIPPED TO MOVE TO THE BIGINNING OF THE NEXT WORD RELATIVE TO THE CURRENT CURSOR POSITION. ) --> \ R-WORD L-W ORD TMB30NOV81 : R-WORD (S --- ) MOVE-RIGHT-WORD \ MOVE FORWARD 1 WORD +CURPOS ; \ AND UPDATE CURSOR (P R-WORD MOVES THE CURSOR RIGHT 1 WORD. THE CURSOR IS LEFT AT THE BEGINNING OF THE WORD. IF THERE ISN'T ANY, THE CURSOR MOVES TO THE END OF THE SCREEN ) : L-WORD MOVE-LEFT-WORD \ MOVE BACKWARDS 1 WORD +CURPOS ; \ AND UPDATE CURSOR (P L-WORD MOVES THE CURSOR LEFT 1 WORD. THE CURSOR IS LEFT AT THE END OF THE PREVIOUS WORD. IF THERE ISN'T ANY, THE CURSOR MOVE TO THE VEGINNING OF THE SCREEN ) --> \ DEL-CH ARS TMB30NOV81 : DEL-CHARS (S N POS --- ) 2DUP + OVER \ N P FROM P DUP CHARS-TO-EOL \ N P F P L BUF-MOVE \ N P DUP CHARS-TO-EOL + \ N EOL OVER - BUF-ADR \ N EOL-N SWAP BLANKS ; \ FILL END WITH BLANKS (P DEL-CHARS DELETES N CHARACTERS STARTING AT POSITION POS. THIS IS USED MAINLY FOR DELETING ENTIRE WORDS AT ONE TIME. IT IS MUCH FASTER THAN CALLING DEL-CHAR N TIMES FOR MOST WORDS ) --> \ D- WORD TMB30NOV81 : D-WORD (S --- ) MOVE-RIGHT-WORD \ MOVE OVER 1 WORD CURPOS BUF-ADR \ BUT LESS THATN LAST BLANK CURPOS CHARS-TO-EOL \ ON THE CURRENT LINE -TRAILING SWAP DROP \ FOR SPEED MIN CURPOS DEL-CHARS \ AND DELETE TEXT CURPOS DISPLAY-TO-EOL ; \ AND SHOW RESULT (P D-WORD DELETES THE NEXT WORD IN THE INPUT STREAM. NOTE THAT CHARACTER AND WORD DELETION AFFECT ONLY THE CURRENT LINE ) --> \ U-TAB D-TAB CRL-SCREEN TMB30NOV81 : U-TAB (S --- ) 4 C/L * \ MOVE UP 4 LINES MINUS +CURPOS ; : D-TAB (S --- ) 4 C/L * \ MOVE DOWN 4 LINES +CURPOS ; : CLR-SCREEN (S --- ) 0 &CURSOR ! \ RESET CURSOR CURPOS BUF-ADR \ GET BUFFER ADDRESS C/SCR BLANKS \ AND SET ALL TO BLANKS 0 DISPLAY-TO-EOS \ AND RE DISPLAY E-UPDATE ; \ INDICATE SCREEN CHANGED --> \ DISPLAY-STATUS TMB30NOV81 : DISPLAY-STATUS (S --- ) &MODE @ &OLD-MODE @ <> IF \ HAS MODE CHANGED? 40 0 CRTXY \ MOVE CURSOR &MODE @ IF \ 1=INSERT 0=OVERSTRIKE ." INSERT ON " \ DISPLAY MESSAGE ON THE ELSE \ STATUS LINE 9 SPACES ENDIF &MODE @ &OLD-MODE ! \ RESET OLD MODE ENDIF CURPOS C/L /MOD \ CHAR POS, LINE# 35 0 CRTXY 2 .R \ DISPLAY LINE# 28 0 CRTXY 2 .R ; \ DISPLAY CHAR# --> \ CLR-LINE TMB30NOV81 : CLR-LINE (S --- ) CURPOS DUP \ SAVE CURRENT CURSOR POSITION >LINE# LINE#> &CURSOR ! \ GET TO BEGINNING ON LINE CURPOS BUF-ADR \ BUFFER ADDRESS OF BOL C/L BLANKS \ BLANK IT OUT E-UPDATE \ INDICATE TEXT HAS CHANGE D 0 MOVE-CURSOR \ GET TO BEGINNING CURPOS CLEAR-TO-EOL \ AND CLEAR THE LINE &CURSOR ! ; \ RESTORE THE CURSOR (P CLR-LINE SETS THE CURRENT LINE TO BLANKS ) --> \ GET-USER-ID TMB30NOV81 : GET-USER-ID (S --- ) &E-ID 10 -TRAILING 0= IF \ IS USER ID BLANK? CR ." ENTER YOUR ID: " \ PROMPT USER 10 0 DO 46 ( . ) EMIT LOOP \ DISPLAY FIELD LENGTH 10 0 DO 8 ( BS ) EMIT LOOP \ AND BACK-UP 10 EXPECT \ LET THE USER ENTER I T &E-ID 10 -TIDY \ REPLACE CONTROL CHARS WITH BLK ELSE \ ALREADY ENTERED USER ID DROP \ IF HERE ENDIF ; (P GET-USER-ID CHECKS TO SEE IF THE SUER'S ID HAS BEEN SET, AND IF NOT, PROMPTS HIM FOR IT AND SAVES IT ) --> \ REFRESH THE TERMINAL SCREEN 03DEC81PDC : TER-REFR (S --- ) CRTCLR-SCR \ CLEAR THE TERMINAL SCREEN 0 %Y-OFF CRTXY \ POSITION CURSOR L/SCR 0 DO \ DISPLAY THE LINE NUMBERS I 3 .R CR LOOP 10 0 CRTXY \ MOVE TO STATUS LINE ." SCR:" SCR @ 4 .R 6 SPACES ." X= Y=" 0 DISPLAY-TO-EOS ; \ PUT OUT CURRENT SCREEN (P THIS ROUTINE WILL PUT OUT THE CURRENT SCREEN TO REFRESH THE CRT. ) --> \ CONTROL CHARACTER DEFINITIONS TMB30NOV81 CASE: (CONTROL-CHAR) (S N --- ) BEEP \ 0: ^@ --- ERROR L-WORD \ 1: ^A --- LEFT WORD CLR-LINE \ 2: ^B --- CLEAR LINE D-TAB \ 3: ^C --- DOWN 4 LINES R-ARROW \ 4: ^D --- RIGHT ARROW U-ARROW \ 5: ^E --- UP ARROW R-WORD \ 6: ^F --- RIGHT WORD D-CHAR \ 7: ^G --- DELETE CHAR L-ARROW \ 8: ^H --- LEFT ARROW E-TAB \ 9: ^I --- TAB TO NEXT COLUMN --> \ CONTROL CHARACTER DEFINITIONS 03DEC81PDC BEEP \ 10: ^J --- ERROR CLR-SCREEN \ 11: ^K --- CLEAR SCREEN BEEP \ 12: ^L --- ERROR RETURN \ 13: ^M --- CARRIAGE RETURN I-LINE \ 14: ^N --- INSERT LINE BEEP \ 15: ^O --- ERROR BEEP \ 16: ^P --- ERROR TER-REFR \ 17: ^Q --- REFRESH THE TERMINAL SCREEN U-TAB \ 18: ^R --- UP 4 LINES L-ARROW \ 19: ^S --- LEFT ARROW --> \ CONTROL CHARACTER DEFINITIONS TMB30NOV81 D-WORD \ 20: ^T --- DELETE WORD BEEP \ 21: ^U --- ERROR INSERT-MODE \ 22: ^V --- TOGGLE INSERT MODE BEEP \ 23: ^W --- A BACKSPACE D-ARROW \ 24: ^X --- DOWN ARROW D-LINE \ 25: ^Y --- DELETE L INE EXIT-SCRATCH \ 26: ^Z --- ABANDON SCREEN EXIT-UPDATE \ 27: ESC -- EXIT EDITOR NORMALLY ; --> \ CONTROL-CHAR TMB30NOV81 : CONTROL-CHAR (S CHAR --- ) DUP 127 = IF \ IF ITS A DELETE DROP 8 \ THEN TURN IT INTO ENDIF \ A BACKSPACE DUP 28 < IF \ MIGHT IT BE VALID? (CONTROL-CHAR) \ YES, SO GO DO IT ELSE DROP BEEP \ NO, COMPLAIN ENDIF ; (P PROCESS A CONTROL CHARACTER. IF THE CHARACTER IS A DELETE, IT IS CHANGED INTO A BACKSPACE. IF IT IS LESS THAN OR EQUAL TO AN ESCAPE, IT IS EXECUTED, OTHERWISE WE BEEP. ) --> \ E-OVERSTRIKE 03DEC81PDC : E-OVERSTRIKE (S --- ) TRKEY DUP \ GET NEXT KEYSTROKE ?PRINTABLE IF \ IF ITS PRINTABLE DUP EMIT \ SHOW IT ON THE SCREEN BUFPOS C! \ STICK IT IN THE BUFFER E-UPDATE \ BUFFER HAS CHANGED 1 +CURPOS \ AND MOVE THE CURSOR ELSE CONTROL-CHAR \ ELSE PROCESS IT AS A COMMAND ENDIF ; (P E-OVERSTRIKE IS CALLED WHENEVER THE EDITOR IS IN OVERSTRIKE MODE. NOTE THAT ONLY A SINGLE CHARACTER IS PROCESSED, AND CONTROL IS ALWAYS RETURNED TO THE MAIN PROCESSING LOOP ) --> \ E-INSERT TMB30NOV81 : E-INSERT (S --- ) TRKEY DUP \ GET THE NEXT CHARACTER ?PRINTABLE IF \ CHECK IF ITS PRINTABLE CURPOS INS-CHAR \ IF SO, INSERT IT HERE CURPOS DISPLAY-TO-EOL \ RE-DISPLAY THE LINE 1 +CURPOS \ AND MOVE OVER 1 ELSE CONTROL-CHAR \ ELSE PROCESS THE COMMAND ENDIF ; (P E-INSERT IS CALLED WHENEVER THE EDITOR IS IN INSERT MODE. NOTE THAT ONLY A SINGLE CHARACTER IS PROCESSED AND CONTROL IS RETURNED IMMEDIATELY TO THE CALLING ROUTINE. ) --> \ E-INIT EDITOR INIT. ROUTINE 19NOV81PDC : E-INIT DEPTH IF SCR ! ENDIF SCR @ BLOCK &BUF-ADR ! GET-USER-ID CRTCLR-SCR 0 &MODE ! 0 &CURSOR ! 0 &UPDATE ! 0 %Y-OFF CRTXY L/SCR 0 DO I 3 .R CR LOOP \ DISPLAY LINE NUMBERS 10 0 CRTXY ." SCR:" SCR @ 4 .R 6 SPACES ." X= Y=" \ STATUS 5 20 CRTXY ." A=L-WORD,B=CLEAR-LINE,C=DOWN 4,D=RIGHT ARR." 5 21 CRTXY ." E=UP ARR,F=RIGHT WORD,G=DELETE CHAR.,H=LEFT AR" 5 22 CRTXY ." I=TAB,K=CLEAR,M=CARR.RET.,N=INSERT LINE,R=UP 4" 5 23 CRTXY ." T=DEL.WORD,V=TOGGLE,X=DOWN,Z=ABANDON,ESC=UPDATE" 0 DISPLAY-TO-EOS ; --> \ E 03DEC81PDC : E (S [N] --- ) EDITOR \ LOOK THROUGH THE EDITOR VOCABULARY E-INIT BKEY \ INITIALIZE THE SCREEN AND TERMINAL BEGIN \ THIS IS THE ONLY LOOP IN THE EDITOR DISPLAY-STATUS \ DISPLAY THE STATUS ON LINE 0 0 MOVE-CURSOR \ MOVE THE CURSOR TO WHERE IT SHOULD BE &MODE @ IF \ CHECK THE MODE, 1=INSERT 0=OVERSTRIKE E-INSERT ELSE E-OVERSTRIKE ENDIF AGAIN ; (P USED TO INVOKE THE EDITOR. SCREEN NUMBER SHOULD BE ON STK ) --> \ ADM-3 CURSOR ROUTINES TMB30NOV81 : ADM3-CRTXY (S X Y --- ) 27 EMIT 89 EMIT ( ESC = ) 32 + EMIT 32 + EMIT ; : ADM3-CRTCLR-SCR (S --- ) 27 EMIT 72 EMIT 27 EMIT 74 EMIT ; : ADM3-CRTCLR-EOL 27 EMIT 75 EMIT ; ' ADM3-CRTXY CFA 'CRTXY ! ' ADM3-CRTCLR-SCR CFA 'CRTCLR-SCR ! ' ADM3-CRT CLR-EOL CFA 'CLEAR-TO-EOL ! \ FORTH DECOMPILER - CASE, OF, ENDOF, ENDCASE 03DEC81PDC\ THIS DECOMPILER FROM 'DOCTOR DOBBS JOURNAL'-SEPT.1981 \ ISSUE NO. 59. TYPED INTO THE SYSTEM BY PDC FORTH DEFINITIONS DECIMAL : CASE ?COMP CSP @ !CSP 4 ; IMMEDIATE \ CASE DEFINITION : OF 4 ?PAIRS \ 'OF' DEFINITION COMPILE OVER COMPILE = COMPILE 0BRANCH HERE 0 , COMPILE DROP 5 ; IMMEDIATE : ENDOF 5 ?PAIRS \ ENDOF DEFINITION COMPILE BRANCH HERE 0 , SWAP 2 [COMPILE] ENDIF 4 ; IMMEDIATE : ENDCASE 4 ?PAIRS COMPILE DROP BEGIN SP@ CSP @ = 0= WHILE 2 [COMPILE] ENDIF REPEAT CSP ! ; IMMEDIATE --> \ DECOMPILER VARIABLES 24NOV81PDC0 VARIABLE QUIT.FLAG 0 VARIABLE WORD.PTR \ FIND RUN TIME ADDRESS OF EACH VOCABULARY WORD TYPE ' (LOOP) 2 - CONSTANT LOOP.ADR ' LIT 2 - CONSTANT LIT.ADR ' : 2 - @ CONSTANT DOCOL.ADR ' 0BRANCH 2 - CONSTANT 0BRANCH.ADR ' BR ANCH 2 - CONSTANT BRANCH.ADR ' (+LOOP) 2 - CONSTANT PLOOP.ADR ' (.") 2 - CONSTANT PDOTQ.ADR ' C/L 2 - @ CONSTANT CONST.ADR ' BASE 2 - @ CONSTANT USERV.ADR ' USE 2 - @ CONSTANT VAR.ADR ' (;CODE) 2 - CONSTANT PSCODE.ADR --> \ MORE DECOMPILER DEFINITIONS 24NOV81PDC : N. \ PRINT A NUMBER IN DECIMAL AND HEX DUP DECIMAL . SPACE HEX 0 ." ( " D. ." H ) " DECIMAL ; : PDOTQ.DSP \ DISPLAY A COMPILED TEXT STRING WORD.PTR @ 2+ DUP >R DUP C@ + 1 - WORD.PTR ! \ UPDATE PFA POINTER R> COUNT TYPE ; : WORD.DSP \ GIVEN CFA, DISPLAY THE GLOSSARY NAME 3 - -1 TRAVERSE DUP 1+ C@ 59 = IF 1 QUIT.FLAG ! ENDIF \ IF " ;" WE ARE DONE DUP C@ 160 AND 128 = \ MAKE SURE LEGAL NFA IF ID. ELSE 1 QUIT.FLAG ! ENDIF ; --> \ MORE DECOMPILER DEFINITIONS 24NOV81PDC : BRANCH.DSP \ GET BRANCH OFFSET, CALCULATE THE ACTUAL \ BRANCH ADDR. AND DISPLAY IT ." TO " WORD.PTR @ 2+ DUP WORD.PTR ! \ UPDATE THE PFA POINTER DUP @ + \ OFFSET+PFA = ACTUAL TARGET ADDR 0 HEX D. DECIMAL ; \ AND PRINT IT : USERV.DSP \ DISPLAY A USER VARIABLE ." User variable, current value = " WORD.PTR @ 2+ \ CALCULATE PFA C@ 38 +ORIGIN @ + \ THEN AREA ADDR. @ N. \ GET AND PRINT CONTENTS 1 QUIT.FLAG ! ; \ WE ARE DONE, SET THE FLAG --> \ MORE DECOMPILER DEFINITIONS 24NOV81PDC : VAR.DSP \ DISPLAY A VARIABLE ." Variable, current value = " WORD.PTR @ 2+ \ CALCULATE PFA @ N. \ GET AND PRINT CONTENTS 1 QUIT.FLAG ! ; \ ALL DONE, SET THE FLAG : CONST.DSP \ DISPLAY A COMPILIED CONSTANT ." Constant, value = " WORD.PTR @ 2+ \ CALCULATE PFA @ N. \ GET AND PRINT CONTENTS 1 QUIT.FLAG ! ; \ ALL DONE, SET FLAG --> \ DECOMPILER MAIN PROCESSING LOOP 24NOV81PDC: DIS -FIND 0= \ IS INPUT WORD IN DICTIONARY ? IF 3 SPACES ." ? Not In Dictionary" CR \ NO- QUIT ELSE DROP DUP DUP 2 - \ YES- CALCULATE CFA @ = \ IF CONTENTS OF CFA = PFA THEN ITS A PRIMITIVE IF ." < Primitive> " CR \ SO TELL USER AND QUIT ELSE \ OTHERWISE ITS A HIGH LEVEL FORTH SO DECODE IT 0 QUIT.FLAG ! \ INITIALIZE THE DONE FLAG 2 - WORD.PTR ! \ INITIALIZE PSEUDOCODE POINTER CR CR \ PRINT SOME BLANK LINES BEGIN \ NOW LIST THE COMPILED PSEUDOCODE WORD.PTR @ DUP \ FETCH CURRENT PSEUDOCODE POINTER 0 HEX D. SPACE DECIMAL \ AND PRINT VALUE OF POINTER @ , \ GET CURRENT PSEUDOCODE WO RD --> \ MAIN PROCESSING LOOP CONTINUED 24NOV81PDCCASE \ NOW DECODE ANY SPECIAL WORD TYPES LIT.ADR OF \ COMPILED LITERAL, PRINT ITS VALUE WORD.PTR @ 2+ DUP WORD.PTR ! @ N. ENDOF DOCOL.ADR OF \ : POINTS TO THE NESTING ROUTINE ." : " ENDOF \ SO JUST PRINT A COLON 0BRANCH.ADR OF \ CONDITIONAL BRANCH WITH IN-LI NE OFFSET ." Branch If Zero " BRANCH.DSP ENDOF BRANCH.ADR OF \ UNCONDITIONAL BRANCH WITH IN-LINE OFFSET ." Branch " BRANCH.DSP ENDOF LOOP.ADR OF \ END OF A DO...LOOP STRUCTURE ." Loop " BRANCH.DSP ENDOF PLOOP.ADR OF \ END OF A DO...+LOOP STRUCTURE ." +Loop " BRANCH.DSP ENDOF --> \ MAIN PROCESSING CONTINUED 24NOV81PDC PDOTQ.ADR OF \ DISPLAY COMPILED TEXT STRING ." Print text: " PDOTQ.DSP ENDOF USERV.ADR OF \ DISPLAY USER VARIABLE USERV.DSP ENDOF VAR.ADR OF \ DISPLAY A GLOBAL VARIABLE VAR.DSP ENDOF CONST.ADR OF \ DISPLAY A COMPILED CONSTANT CONST.DSP ENDOF PSCODE.ADR OF \ DISPLAY ;CODE AND QUIT WORD.PTR @ @ WORD.DSP 1 QUIT.FLAG ! ENDOF --> \ MAIN PROCESSING CONTINUED 24NOV81PDC\ ALL SPECIAL WORD TYPES CHECKED, DUP WORD.DSP \ IF WORD DID NOT MATCH ANY CASES \ JUST PRINT ITS NAME ENDCASE CR \ DONE DECODING WORD TYPE 2 WORD.PTR +! \ UPDATE PSEUDOCODE POINTER QUIT.FLAG @ \ CHECK IF FINI SHED FLAG SET OR IF ?TERMINAL OR \ INTERRUPTION FROM TERMINAL UNTIL \ OTHERWISE DISPLAY ANOTHER WORD ENDIF ENDIF CR ; \ ALL DONE NOW