├── .gitattributes ├── basic.blk ├── clock.blk ├── cpu8086.blk ├── crck4.com ├── expand86.blk ├── extend86.blk ├── f83-fixs.txt ├── f83.com ├── huffman.blk ├── kernel86.blk ├── meta86.blk ├── nsq.exe ├── nusq.com ├── readme.1st ├── readme.pc └── utility.blk /.gitattributes: -------------------------------------------------------------------------------- 1 | *.blk linguist-language=Forth 2 | -------------------------------------------------------------------------------- /basic.blk: -------------------------------------------------------------------------------- 1 | \ BASIC compiler 06Feb84mapONLY FORTH ALSO DEFINITIONS : .R RP0 @ RP@ ?DO I @ 2- @ >NAME .ID 2 +LOOP ; VOCABULARY ARITHMETIC ARITHMETIC ALSO DEFINITIONS VOCABULARY LOGIC VOCABULARY INPUTS VOCABULARY OUTPUTS : [ ASCII ] WORD DROP ; IMMEDIATE : GET BL WORD NUMBER DROP ; CREATE #S 130 ALLOT FORTH DEFINITIONS 1 2 +THRU ( precedence and variables ) : BASIC [ ARITHMETIC ] 0 #S 2+ #S 2! START ALSO ; IMMEDIATE ARITHMETIC DEFINITIONS 3 7 +THRU ( BASIC ) : ( 10 #( +! ; IMMEDIATE : ; [ n] . ; 1 PRECEDENCE ; FORTH DEFINITIONS \ Precedence 06Feb84mapVARIABLE ADDRESS VARIABLE #( : ) -10 #( +! #( @ 0< ABORT" Unmatched )" ; IMMEDIATE : DEFER ( a n a n - a n) #( @ + BEGIN 2OVER NIP OVER >= WHILE 2SWAP DROP , REPEAT ; : PRECEDENCE ( n) >IN @ ' >R >IN ! CONSTANT R> , IMMEDIATE DOES> 2@ DEFER ; : RPN ( n) 0 1 DEFER 2DROP #( @ OR ABORT" Syntax" ; : ?IGNORE #( @ IF 0 1 DEFER 2DROP R> DROP THEN ; : NOTHING ; : START ( - n) 0 #( ! 0 ADDRESS ! ['] NOTHING 0 ARITHMETIC ; \ Variables 06Feb84map: INTEGER VARIABLE IMMEDIATE DOES> [COMPILE] LITERAL ADDRESS @ IF ADDRESS OFF ELSE COMPILE @ THEN ; : (ARRAY) ( a a) SWAP >R 7 DEFER R> [COMPILE] LITERAL ADDRESS @ IF ADDRESS OFF ELSE ['] @ 7 #( @ + 2SWAP THEN ; : [+] ( a i - a) 1- 2* + ; : ARRAY INTEGER 1- 2* ALLOT DOES> ['] [+] (ARRAY) ; : [*+] ( a x y - a) >R 1- OVER @ * R> + 2* + ; : 2ARRAY ( y x) DUP CONSTANT IMMEDIATE * 2* ALLOT DOES> ['] [*+] (ARRAY) ; \ Statement numbers ( works at any address ) 06Feb84map: FIND ( line# -- entry-adr ) TRUE #S @ #S 2+ ?DO OVER I @ ABS = IF 2DROP I FALSE LEAVE THEN 4 +LOOP IF 0 SWAP #S @ 2! #S @ 4 #S +! THEN ; : RESOLVE ( n -- ) FIND DUP @ 0< ABORT" duplicated" DUP @ NEGATE OVER ! 2+ DUP @ BEGIN ?DUP WHILE DUP @ HERE ROT ! REPEAT HERE SWAP ! ; : CHAIN ( n - a) FIND LENGTH 0< IF @ ELSE DUP @ HERE ROT ! THEN ; : STATEMENT ( n -- ) HERE 2- @ >R -4 ALLOT RPN EXECUTE R> RESOLVE START ; \ Branching - high level 13Mar84map : JUMP R> @ >R ; : CALL R> DUP @ SWAP 2+ >R >R ; : SKIP 0= IF R> 4 + >R THEN ; : (NEXT) 2DUP +! >R 2DUP R> @ SWAP 0< IF SWAP THEN - 0< IF 2DROP R> 2+ ELSE R> @ THEN >R ; : [1] COMPILE 1 HERE ; : [NEXT] COMPILE (NEXT) , ; : (GOTO) GET COMPILE JUMP CHAIN , ; : (RET) R> DROP ; \ BASIC 19Jul84map: LET STATEMENT ADDRESS ON ; IMMEDIATE : FOR [COMPILE] LET ; IMMEDIATE : TO RPN DROP ['] [1] 0 ; IMMEDIATE : STEP RPN DROP ['] HERE 0 ; IMMEDIATE : NEXT STATEMENT 2DROP ['] [NEXT] 0 ADDRESS ON ; IMMEDIATE : REM STATEMENT [COMPILE] \ ; IMMEDIATE : DIM [COMPILE] REM ; IMMEDIATE : STOP STATEMENT COMPILE (RET) ; IMMEDIATE : END STATEMENT 2DROP [COMPILE] ; PREVIOUS FORTH ; IMMEDIATE : GOTO STATEMENT (GOTO) ; IMMEDIATE : IF STATEMENT LOGIC ; IMMEDIATE : THEN RPN 0 COMPILE SKIP (GOTO) ; IMMEDIATE : RETURN STATEMENT COMPILE (RET) ; IMMEDIATE : GOSUB STATEMENT GET COMPILE CALL CHAIN , ; IMMEDIATE \ Input and Output 06Feb84map: ASK ." ? " QUERY ; : PUT GET SWAP ! ; : (INPUT) COMPILE PUT ; : (,) ( n) (.) 14 OVER - SPACES TYPE SPACE ; OUTPUTS DEFINITIONS : , ( n) ?IGNORE ['] (,) 1 DEFER ; IMMEDIATE : " [COMPILE] ." 2DROP ; IMMEDIATE INPUTS DEFINITIONS : , ?IGNORE RPN 0 (INPUT) ADDRESS ON ; IMMEDIATE ARITHMETIC DEFINITIONS : PRINT STATEMENT COMPILE CR ['] (,) 1 OUTPUTS ; IMMEDIATE : INPUT STATEMENT 2DROP COMPILE ASK ['] (INPUT) 0 INPUTS ADDRESS ON ; IMMEDIATE \ Operators 06Feb84mapLOGIC DEFINITIONS 2 PRECEDENCE <> 2 PRECEDENCE <= 2 PRECEDENCE >= 2 PRECEDENCE = 2 PRECEDENCE < 2 PRECEDENCE > ARITHMETIC DEFINITIONS : = ( a n) SWAP ! ; 1 PRECEDENCE = : ** ( n n - n) 1 SWAP 1 DO OVER * LOOP * ; 6 PRECEDENCE ABS 5 PRECEDENCE ** 4 PRECEDENCE * 4 PRECEDENCE / 4 PRECEDENCE */ 3 PRECEDENCE + 3 PRECEDENCE - \ [ Dwyer, page 17, Program 1] ( works ) 06Feb84mapINTEGER J INTEGER K : RUN BASIC 10 PRINT " THIS IS A COMPUTER" 20 FOR K = 1 TO 4 30 PRINT " NOTHING CAN GO" 40 FOR J = 1 TO 3 50 PRINT " WRONG" 60 NEXT J 70 NEXT K 80 END RUN \ [ basic: branching demo ] ( works ) 06Feb84mapINTEGER J INTEGER K : RUN BASIC 10 FOR K = 1 TO 15 STEP 3 15 LET J = J + K 20 IF K >= 8 THEN 35 25 PRINT K 30 GOTO 40 35 PRINT K , J , " SUM " 40 NEXT K 50 PRINT " DONE " 80 END RUN \ [ basic: array demo ] ( works ) 06Feb84mapINTEGER K 9 ARRAY COORDINATE : RUN BASIC 10 FOR K = 1 TO 9 20 LET COORDINATE K = ( 10 - K ) ** 3 40 PRINT COORDINATE K + 5 60 NEXT K 80 END RUN \ [ basic string printing demo ] 06Feb84mapINTEGER X INTEGER Y INTEGER Z : RUN BASIC 10 LET X = 5 20 LET Y = 7 30 PRINT X , Y 60 PRINT X , " TEST " 90 END RUN \ [ basic program # 1 ] ( works ) 06Feb84mapINTEGER K INTEGER X 3 ARRAY Z : RUN BASIC 10 LET Z 1 = 1 15 LET Z 2 = 22 20 LET Z 3 = 333 30 FOR K = 1 TO 3 40 LET X = Z K 50 PRINT X 60 NEXT K 80 END RUN \ [ basic inputting demo ] 06Feb84mapINTEGER K INTEGER X INTEGER Y : RUN BASIC 10 INPUT X , Y 20 LET K = X * Y ** 3 40 PRINT X , Y , K 80 END RUN \ [ basic: GOSUB demo ] 19Jul84mapINTEGER K 9 ARRAY COORDINATE : RUN BASIC 10 FOR K = 1 TO 9 20 LET COORDINATE K = 10 - K 30 GOSUB 60 40 NEXT K 50 GOTO 80 60 PRINT COORDINATE K 70 RETURN 80 END  -------------------------------------------------------------------------------- /clock.blk: -------------------------------------------------------------------------------- 1 | \ System Support 1 Load screen 13Apr84map1 4 +THRU CR .( Clock Loaded ) EXIT \ Months and Days 07Apr84map: "ARRAY ( compile: string-length -- ) ( run: -- a n ) CREATE C, ASCII " WORD COUNT >R HERE R@ MOVE R> ALLOT DOES> COUNT >R SWAP R@ * + R> ; 3 "ARRAY "MONTH "JanFebMarAprMayJunJulAugSepOctNovDec" 3 "ARRAY "DAY "SunMonTueWedThuFriSat" HEX 5A CONSTANT CLK-C CLK-C 1+ CONSTANT CLK-D : CLK@ (S n -- nib ) 10 OR CLK-C PC! CLK-D PC@ ; : CLK! (S n a -- ) 40 CLK-C PC! 40 OR DUP CLK-C PC! SWAP CLK-D PC! DUP 60 OR CLK-C PC! CLK-C PC! ; : CLOCK? (S -- f ) 0 CLK@ 0F0 AND 0= ; DECIMAL \ Clock 07Apr84map: CLK# (S n -- ) CLK@ 48 OR HOLD ; : (DATE) (S -- a n ) <# 11 CLK# 12 CLK# 9 CLK@ 10 CLK@ 10 * + 1- "MONTH DUP NEGATE HLD +! HLD @ SWAP CMOVE 7 CLK# 8 CLK# 0 0 #> ; : (TIME) (S -- a n ) 0. <# 0 CLK# 1 CLK# ASCII : HOLD 2 CLK# 3 CLK# ASCII : HOLD 4 CLK# 5 CLK@ 3 AND 48 OR HOLD #> ; : ?AM/PM (S -- ) 5 CLK@ DUP 8 AND 0= IF 4 AND IF ." PM" ELSE ." AM" THEN ELSE DROP THEN ; : DAY (S -- ) 6 CLK@ "DAY TYPE SPACE ; : DATE (S -- ) (DATE) TYPE SPACE ; : TIME (S -- ) (TIME) TYPE SPACE ; : NOW (S -- ) CLOCK? IF DAY DATE TIME ?AM/PM THEN ; \ Set Time 07Apr84map: INPUT? ( -- [n] f ) QUERY BL WORD NUMBER? NIP DUP 0= IF NIP THEN ; : SET-TIME (S -- ) CR ." Day of week? ( 0 to 6 ) " INPUT? IF 6 CLK! THEN CR ." Day of month? " INPUT? IF 10 /MOD 8 CLK! 7 CLK! THEN CR ." Month? " INPUT? IF 10 /MOD 10 CLK! 9 CLK! THEN CR ." Year? " INPUT? IF 10 /MOD 12 CLK! 11 CLK! THEN CR ." Hour? " INPUT? IF DUP 12 > IF 12 - 4 ELSE 0 THEN SWAP 10 /MOD ROT OR 5 CLK! 4 CLK! THEN CR ." Minute? " INPUT? IF 10 /MOD 3 CLK! 2 CLK! THEN 0 1 CLK! 0 0 CLK! CR ." Hit any key to start." CR KEY DROP 0 CLK-C PC! ; \ Automatic EDITOR ID 10Apr84map: (WHO) (S -- ) " map" ; : WHO (S -- ) (WHO) TYPE SPACE ; : SET-ID (S -- ) CLOCK? IF (DATE) [ EDITOR ] ID SWAP CMOVE (WHO) ID 7 + SWAP CMOVE THEN HELLO ; ' SET-ID IS BOOT \ Months and Days 07Apr84map"ARRAY ( compile: string-length -- ) ( run: -- a n ) Defining word for string arrays. "MONTH Array of the names of the months. "DAY Array of the names of the days of the week. CLK-C CLK-D addresses of the clock IO ports. CLK@ get a byte from the clock. CLK! give a byte to the clock. CLOCK? test for presence of the clock. \ Clock 07Apr84mapCLK# (S n -- ) prefix a number from the clock to the output.(DATE) (S -- a n ) Build an output string representing the date. Leave its address and length. (TIME) (S -- a n ) Build an output string representing the time. Leave its address and length. ?AM/PM (S -- ) If in 12 hour mode, print AM or PM. DAY (S -- ) print the name of the day. DATE (S -- ) print the date. TIME (S -- ) print the time. NOW (S -- ) if there is a clock, print the day, date, and time. \ Set Time 07Apr84mapINPUT? ( -- [n] f ) wait for user to type a number. Leave number and true, or just false if no input. SET-TIME Set the clock. Prompt for input. Entering just a Carraige Return will leave the present value unchanged. \ Automatic EDITOR ID 07Apr84map(WHO) leave address and length of string containing user id. Change this if your initials happen to be different. WHO print user id. SET-ID This replaces the usual cold boot routine. After the usual HELLO, if there is a clock, the EDITOR ID is set to contain the present date and user initials. Set BOOT to use SET-ID. If the executable image of the system is now saved, then when it is run COLD will use SET-ID. -------------------------------------------------------------------------------- /cpu8086.blk: -------------------------------------------------------------------------------- 1 | \ The Rest is Silence 11OCT83HHL************************************************************* ************************************************************* *** *** *** Please direct all questions, comments, and *** *** miscellaneous personal abuse to: *** *** *** *** Henry Laxen or Michael Perry *** *** 1259 Cornell Avenue 1125 Bancroft Way *** *** Berkeley, California Berkeley, California *** *** 94706 94702 *** *** *** *** (415) 525-8582 (415) 644-3421 *** *** *** ************************************************************* ************************************************************* \ Load Screen for 8086 Dependent Code 07Apr84map ONLY FORTH ALSO DEFINITIONS DECIMAL 3 LOAD ( The Assembler ) 18 LOAD ( The Low Level for the Debugger ) 21 LOAD ( The Low Level for the MultiTasker ) 24 LOAD ( The Machine Dependent IO words ) CR .( 8086 Machine Dependent Code Loaded ) \ 8086 Assembler 11OCT83HHLONLY FORTH ALSO DEFINITIONS 1 14 +THRU CR .( 8086 Assembler Loaded ) ONLY FORTH ALSO DEFINITIONS EXIT The 8086 Assembler was written by Mike Perry. To create and assembler language definition, use the defining word CODE. It must be terminated with either END-CODE or its synonym C;. How the assembler operates is a very interesting example of the power of CREATE DOES> Basically the instructions are categorized and a defining word is created for each category. When the nmemonic for the instruction is interpreted, it compiles itself. \ 8086 Assembler 06Apr84map: LABEL CREATE ASSEMBLER ; 232 CONSTANT DOES-OP 3 CONSTANT DOES-SIZE : DOES? (S IP -- IP' F ) DUP DOES-SIZE + SWAP C@ DOES-OP = ; ASSEMBLER ALSO DEFINITIONS : C; (S -- ) END-CODE ; OCTAL DEFER C, FORTH ' C, ASSEMBLER IS C, DEFER , FORTH ' , ASSEMBLER IS , DEFER HERE FORTH ' HERE ASSEMBLER IS HERE DEFER ?>MARK DEFER ?>RESOLVE DEFER ? @ SWAP 7000 AND = 0<> ; 0 MD R8? 1 MD R16? 2 MD MEM? 3 MD SEG? 4 MD #? : REG? (S n -- f ) 7000 AND 2000 < 0<> ; : BIG? (S N -- F ) ABS -200 AND 0<> ; : RLOW (S n1 -- n2 ) 7 AND ; : RMID (S n1 -- n2 ) 70 AND ; VARIABLE SIZE SIZE ON : BYTE (S -- ) SIZE OFF ; : OP, (S N OP -- ) OR C, ; : W, ( OP MR -- ) R16? 1 AND OP, ; : SIZE, ( OP -- OP' ) SIZE @ 1 AND OP, ; : ,/C, (S n f -- ) IF , ELSE C, THEN ; : RR, (S MR1 MR2 -- ) RMID SWAP RLOW OR 300 OP, ; VARIABLE LOGICAL : B/L? (S n -- f ) BIG? LOGICAL @ OR ; \ Addressing 16Oct83map: MEM, (S DISP MR RMID -- ) OVER #) = IF RMID 6 OP, DROP , ELSE RMID OVER RLOW OR -ROT [BP] = OVER 0= AND IF SWAP 100 OP, C, ELSE SWAP OVER BIG? IF 200 OP, , ELSE OVER 0= IF C, DROP ELSE 100 OP, C, THEN THEN THEN THEN ; : WMEM, (S DISP MEM REG OP -- ) OVER W, MEM, ; : R/M, (S MR REG -- ) OVER REG? IF RR, ELSE MEM, THEN ; : WR/SM, (S R/M R OP -- ) 2 PICK DUP REG? IF W, RR, ELSE DROP SIZE, MEM, THEN SIZE ON ; VARIABLE INTER : FAR (S -- ) INTER ON ; : ?FAR (S n1 -- n2 ) INTER @ IF 10 OR THEN INTER OFF ; \ Defining Words to Generate Op Codes 08MAY84HHL: 1MI CREATE C, DOES> C@ C, ; : 2MI CREATE C, DOES> C@ C, 12 C, ; : 3MI CREATE C, DOES> C@ C, HERE - 1- DUP -200 177 WITHIN NOT ABORT" Branch out of Range" C, ; : 4MI CREATE C, DOES> C@ C, MEM, ; : 5MI CREATE C, DOES> C@ SIZE, SIZE ON ; : 6MI CREATE C, DOES> C@ SWAP W, ; : 7MI CREATE C, DOES> C@ 366 WR/SM, ; : 8MI CREATE C, DOES> C@ SWAP R16? 1 AND OR SWAP # = IF C, C, ELSE 10 OR C, THEN ; : 9MI CREATE C, DOES> C@ OVER R16? IF 100 OR SWAP RLOW OP, ELSE 376 WR/SM, THEN ; : 10MI CREATE C, DOES> C@ OVER CL = IF NIP 322 ELSE 320 THEN WR/SM, ; \ Defining Words to Generate Op Codes 15MAY84HHL: 11MI CREATE C, C, DOES> OVER #) = IF NIP C@ INTER @ IF 1 AND IF 352 ELSE 232 THEN C, SWAP , , INTER OFF ELSE SWAP HERE - 2- SWAP 2DUP 1 AND SWAP BIG? NOT AND IF 2 OP, C, ELSE C, 1- , THEN THEN ELSE OVER S#) = IF NIP #) SWAP THEN 377 C, 1+ C@ ?FAR R/M, THEN ; : 12MI CREATE C, C, C, DOES> OVER REG? IF C@ SWAP RLOW OP, ELSE 1+ OVER SEG? IF C@ RLOW SWAP RMID OP, ELSE COUNT SWAP C@ C, MEM, THEN THEN ; : 14MI CREATE C, DOES> C@ DUP ?FAR C, 1 AND 0= IF , THEN ; \ Defining Words to Generate Op Codes 09Apr84map: 13MI CREATE C, C, DOES> COUNT >R C@ LOGICAL ! DUP REG? IF OVER REG? IF R> OVER W, SWAP RR, ELSE OVER DUP MEM? SWAP #) = OR IF R> 2 OR WMEM, ELSE ( # ) NIP DUP RLOW 0= ( ACC? ) IF R> 4 OR OVER W, R16? ,/C, ELSE OVER B/L? OVER R16? 2DUP AND -ROT 1 AND SWAP NOT 2 AND OR 200 OP, SWAP RLOW 300 OR R> OP, ,/C, THEN THEN THEN ELSE ( MEM ) ROT DUP REG? IF R> WMEM, ELSE ( # ) DROP 2 PICK B/L? DUP NOT 2 AND 200 OR SIZE, -ROT R> MEM, SIZE @ AND ,/C, SIZE ON THEN THEN ; \ Instructions 14MAY84RKG: TEST (S source dest -- ) DUP REG? IF OVER REG? IF 204 OVER W, SWAP RR, ELSE OVER DUP MEM? SWAP #) = OR IF 204 WMEM, ELSE ( # ) NIP DUP RLOW 0= ( ACC? ) IF 250 OVER W, ELSE 366 OVER W, DUP RLOW 300 OP, THEN R16? ,/C, THEN THEN ELSE ( MEM ) ROT DUP REG? IF 204 WMEM, ELSE ( # ) DROP 366 SIZE, 0 MEM, SIZE @ ,/C, SIZE ON THEN THEN ; \ Instructions 16Oct83mapHEX : ESC (S source ext-opcode -- ) RLOW 0D8 OP, R/M, ; : INT (S N -- ) 0CD C, C, ; : SEG (S SEG -- ) RMID 26 OP, ; : XCHG (S MR1 MR2 -- ) DUP REG? IF DUP AX = IF DROP RLOW 90 OP, ELSE OVER AX = IF NIP RLOW 90 OP, ELSE 86 WR/SM, THEN THEN ELSE ROT 86 WR/SM, THEN ; : CS: CS SEG ; : DS: DS SEG ; : ES: ES SEG ; : SS: SS SEG ; \ Instructions 18APR83HHL: MOV (S S D -- ) DUP SEG? IF 8E C, R/M, ELSE DUP REG? IF OVER #) = OVER RLOW 0= AND IF A0 SWAP W, DROP , ELSE OVER SEG? IF SWAP 8C C, RR, ELSE OVER # = IF NIP DUP R16? SWAP RLOW OVER 8 AND OR B0 OP, ,/C, ELSE 8A OVER W, R/M, THEN THEN THEN ELSE ( MEM ) ROT DUP SEG? IF 8C C, MEM, ELSE DUP # = IF DROP C6 SIZE, 0 MEM, SIZE @ ,/C, ELSE OVER #) = OVER RLOW 0= AND IF A2 SWAP W, DROP , ELSE 88 OVER W, R/M, THEN THEN THEN THEN THEN SIZE ON ; \ Instructions 12Oct83map 37 1MI AAA D5 2MI AAD D4 2MI AAM 3F 1MI AAS 0 10 13MI ADC 0 00 13MI ADD 2 20 13MI AND 10 E8 11MI CALL 98 1MI CBW F8 1MI CLC FC 1MI CLD FA 1MI CLI F5 1MI CMC 0 38 13MI CMP A6 5MI CMPS 99 1MI CWD 27 1MI DAA 2F 1MI DAS 08 9MI DEC 30 7MI DIV ( ESC ) F4 1MI HLT 38 7MI IDIV 28 7MI IMUL E4 8MI IN 00 9MI INC ( INT ) 0CE 1MI INTO 0CF 1MI IRET 77 3MI JA 73 3MI JAE 72 3MI JB 76 3MI JBE E3 3MI JCXZ 74 3MI JE 7F 3MI JG 7D 3MI JGE 7C 3MI JL 7E 3MI JLE 20 E9 11MI JMP 75 3MI JNE 71 3MI JNO 79 3MI JNS 70 3MI JO 7A 3MI JPE 7B 3MI JPO 78 3MI JS 9F 1MI LAHF C5 4MI LDS 8D 4MI LEA C4 4MI LES F0 1MI LOCK 0AC 6MI LODS E2 3MI LOOP E1 3MI LOOPE E0 3MI LOOPNE \ Instructions 12Apr84map ( MOV ) 0A4 5MI MOVS 20 7MI MUL 18 7MI NEG 90 1MI NOP 10 7MI NOT 2 08 13MI OR E6 8MI OUT 8F 07 58 12MI POP 9D 1MI POPF 0FF 36 50 12MI PUSH 9C 1MI PUSHF 10 10MI RCL 18 10MI RCR F2 1MI REP F2 1MI REPNZ F3 1MI REPZ C3 14MI RET 00 10MI ROL 8 10MI ROR 9E 1MI SAHF 38 10MI SAR 0 18 13MI SBB 0AE 5MI SCAS ( SEG ) 20 10MI SHL 28 10MI SHR F9 1MI STC FD 1MI STD FB 1MI STI 0AA 6MI STOS 0 28 13MI SUB ( TEST ) 9B 1MI WAIT ( XCHG ) D7 1MI XLAT 2 30 13MI XOR C2 14MI +RET \ Structured Conditionals 09Apr84map: A?>MARK (S -- f addr ) TRUE HERE 0 C, ; : A?>RESOLVE (S f addr -- ) HERE OVER 1+ - SWAP C! ?CONDITION ; : A?MARK ASSEMBLER IS ?>MARK ' A?>RESOLVE ASSEMBLER IS ?>RESOLVE ' A? 79 CONSTANT 0< 78 CONSTANT 0>= 7D CONSTANT < 7C CONSTANT >= 7F CONSTANT <= 7E CONSTANT > 73 CONSTANT U< 72 CONSTANT U>= 77 CONSTANT U<= 76 CONSTANT U> 71 CONSTANT OV DECIMAL \ Structured Conditionals 06Apr84mapHEX : IF C, ?>MARK ; : THEN ?>RESOLVE ; : ELSE 0EB IF 2SWAP THEN ; : BEGIN ?NEXT #) JMP ; : 1PUSH >NEXT 1- #) JMP ; : 2PUSH >NEXT 2- #) JMP ; DECIMAL \ Load Screen for High Level Trace 17Oct83mapONLY FORTH ALSO DEFINITIONS 1 2 +THRU CR .( Low level Debugger Code Loaded ) ONLY FORTH ALSO DEFINITIONS EXIT The debugger is designed to let the user single step the execution of a high level definition. To invoke the debugger, type DEBUG XXX where XXX is the name of the word you wish to trace. When XXX executes, you will get a single step trace showing you the word within XXX that is about to execute, and the contents of the parameter stack. If you wish to poke around, type F and you can interpret Forth commands until you type RESUME, and execution of XXX will continue where it left off. This debugger works by patching the NEXT routine, so it is highly machine and implementation dependent. The same idea should work however on any Forth system with a centralized NEXT routine. \ High Level Trace 18APR83HHLVOCABULARY BUG BUG ALSO DEFINITIONS VARIABLE 'DEBUG ( Code field for high level trace ) VARIABLE ( Upper limit of IP ) VARIABLE CNT ( How many times thru debug next ) ASSEMBLER HEX LABEL FNEXT ( Fix the >NEXT code back to normal ) 0AD # AL MOV AL >NEXT #) MOV D88B # AX MOV AX >NEXT 1+ #) MOV RET LABEL DNEXT ( The Debugger version of a normal >NEXT ) AX LODS AX W MOV 0 [W] JMP DECIMAL \ High Level Trace 12Apr84mapHEX ASSEMBLER LABEL DEBNEXT IF IP> #) IP CMP U<= IF CNT #) AL MOV AL INC AL CNT #) MOV 2 # AL CMP 0= IF AL AL SUB AL CNT #) MOV FNEXT #) CALL IP PUSH 'DEBUG #) W MOV 0 [W] JMP THEN THEN THEN DNEXT #) JMP CODE PNEXT (S -- ) 0E9 # AL MOV AL >NEXT #) MOV DEBNEXT >NEXT 3 + - # AX MOV AX >NEXT 1+ #) MOV NEXT C; FORTH DEFINITIONS CODE UNBUG (S -- ) FNEXT #) CALL NEXT C; DECIMAL \ Load Screen for the MultiTasker 18APR83HHLONLY FORTH ALSO DEFINITIONS 1 2 +THRU CR .( MultiTasker Low Level Loaded ) ONLY FORTH ALSO DEFINITIONS EXIT The MultiTasker is loaded as an application on top of the regular Forth System. There is support for it in the nucleus in the form of USER variables and PAUSEs inserted inside of KEY EMIT and BLOCK. The Forth multitasking scheme is co-operative instead of interruptive. All IO operations cause a PAUSE to occur, and the multitasking loop looks around at all of the current task for something to do. \ Multitasking low level 08MAY84HHLCODE (PAUSE) (S -- ) IP PUSH RP PUSH UP #) BX MOV SP 0 [BX] MOV BX INC BX INC BX INC BX INC 0 [BX] BX ADD BX INC BX INC BX JMP C; CODE RESTART (S -- ) -4 # AX MOV BX POP AX BX ADD BX UP #) MOV AX POP AX POP STI 0 [BX] SP MOV CLI RP POP IP POP NEXT C; \ Manipulate Tasks 11OCT83HHLHEX 80 CONSTANT INT# : LOCAL (S base addr -- addr' ) UP @ - + ; : @LINK (S -- addr ) LINK DUP @ + 2+ ; : !LINK (S addr -- ) LINK 2+ - LINK ! ; : SLEEP (S addr -- ) E990 SWAP ENTRY LOCAL ! ; : WAKE (S addr -- ) 80CD SWAP ENTRY LOCAL ! ; : STOP (S -- ) UP @ SLEEP PAUSE ; : SINGLE (S -- ) ['] PAUSE >BODY ['] PAUSE ! ; CODE MULTI (S -- ) ' (PAUSE) @ # BX MOV BX ' PAUSE #) MOV ' RESTART @ # BX MOV DS AX MOV AX PUSH AX AX SUB AX DS MOV CS AX MOV AX INT# 4 * 2+ #) MOV BX INT# 4 * #) MOV AX POP AX DS MOV NEXT C; UP @ WAKE ENTRY !LINK DECIMAL \ Load Screen for Machine Dependent IO Words 11OCT83HHLONLY FORTH ALSO DEFINITIONS 1 1 +THRU CR .( Machine Dependent IO Words Loaded ) ONLY FORTH ALSO DEFINITIONS EXIT Since the 8086 has a seperate IO path, we define a Forth interface to it. Use P@ and P! to read or write directly to the 8086 IO ports. \ Machine Dependent IO Words 11OCT83HHLCODE PC@ (S port# -- n ) DX POP 0 AL IN AH AH SUB AX PUSH NEXT C; CODE P@ (S port# -- n ) DX POP 0 AX IN AX PUSH NEXT C; CODE PC! (S n port# -- ) DX POP AX POP 0 AL OUT NEXT C; CODE P! (S n port# -- ) DX POP AX POP 0 AX OUT NEXT C; \ Load Screen for 8086 Dependent Code 11OCT83HHL All of the Machine Dependent Code for a Particular Forth Implementation is factored out and placed into this file. For The 8086 there are 3 different components. The 8086 assembler, The run time debugger, which must have knowledge of how NEXT is implemented, and the MultiTasker, which uses code words to WAKE tasks and put them to SLEEP. \ 8086 Assembler 08OCT83HHLLABEL marks the start of a subroutine whose name returns its address. DOES-OP Is the op code of the call instruction used for DOES> U C; A synonym for END-CODE Deferring the definitions of the commas, marks, and resolves allows the same assembler to serve for both the system and the Meta-Compiler. \ 8086 Assembler Register Definitions 12Oct83map On the 8086, register names are cleverly defined constants. The value returned by registers and by modes such as #) containsboth mode and register information. The instructions use the mode information to decide how many arguments exist, and what toassemble. Like many CPUs, the 8086 uses many 3 bit fields in its opcodesThis makes octal ( base 8 ) natural for describing the registers We redefine the Registers that FORTH uses to implement its virtual machine. \ Addressing Modes 16Oct83mapMD defines words which test for various modes. R8? R16? MEM? SEG? #? test for mode equal to 0 thru 4. REG? tests for any register mode ( 8 or 16 bit). BIG? tests offsets size. True if won't fit in one byte. RLOW mask off all but low register field. RMID mask off all but middle register field. SIZE true for 16 bit, false for 8 bit. BYTE set size to 8 bit. OP, for efficiency. OR two numbers and assemble. W, assemble opcode with W field set for size of register. SIZE, assemble opcode with W field set for size of data. ,/C, assemble either 8 or 16 bits. RR, assemble register to register instruction. LOGICAL true while assembling logical instructions. B/L? see 13MI \ Addressing 16Oct83mapThese words perform most of the addressing mode encoding. MEM, handles memory reference modes. It takes a displacement, a mode/register, and a register, and encodes and assembles them. WMEM, uses MEM, after packing the register size into the opcodeR/M, assembles either a register to register or a register to or from memory mode. WR/SM, assembles either a register mode with size field, or a memory mode with size from SIZE. Default is 16 bit. Use BYTE for 8 bit size. INTER true if inter-segment jump, call, or return. FAR sets INTER true. Usage: FAR JMP, FAR CALL, FAR RET. ?FAR sets far bit, clears flag. \ Defining Words to Generate Op Codes 12Oct83map1MI define one byte constant instructions. 2MI define ascii adjust instructions. 3MI define branch instructions, with one byte offset. 4MI define LDS, LEA, LES instructions. 5MI define string instructions. 6MI define more string instructions. 7MI define multiply and divide instructions. 8MI define input and output instructions. 9MI define increment/decrement instructions. 10MI define shift/rotate instructions. *NOTE* To allow both 'ax shl' and 'ax cl shl', if the register on top of the stack is cl, shift second register by cl. If not, shift top ( only) register by one. \ Defining Words to Generate Op Codes 09Apr84map11MI define calls and jumps. notice that the first byte stored is E9 for jmp and E8 for call so C@ 1 AND is zero for call, 1 for jmp. syntax for direct intersegment: address segment #) FAR JMP 12MI define pushes and pops. 14MI defines returns. RET FAR RET n +RET n FAR +RET \ Defining Words to Generate Op Codes 16Oct83map13MI define arithmetic and logical instructions. \ Instructions 16Oct83mapTEST bits in dest \ Instructions 16Oct83map ESC INT assemble interrupt instruction. SEG assemble segment instruction. XCHG assemble register swap instruction. CS: DS: ES: SS: assemble segment over-ride instructions. \ Instructions 12Oct83mapMOV as usual, the move instruction is the most complicated. It allows more addressing modes than any other, each of which assembles something more or less unique. \ Instructions 12Oct83mapMost instructions are defined on these two screens. Mnemonics inparentheses are defined earlier or not at all. \ Instructions 12Oct83mapMost instructions are defined on these two screens. Mnemonics inparentheses are defined earlier or not at all. \ Structured Conditionals 16Oct83mapA?>MARK assembler version of forward mark. A?>RESOLVE assembler version of forward resolve. A? then the contents of the execution variable 'DEBUG are executed. First the IP is pushed onto the parameter stack. The word pointed to by 'DEBUG can be any high or low level word so long as it discards the IP that was pushed before it is called, and it must terminate by callingPNEXT to patch next once again for more tracing. PNEXT patches Forth's Next to jump to DEBNEXT. This puts us into DEBUG mode and allows for tracing. FIX restores Forth's Next to its original condition. Effectively disabling tracing. \ Multitasking low level 11OCT83HHL(PAUSE) (S -- ) Puts a task to sleep by storing the IP and the RP on the parameter stack. It then saves the pointer to the parameter stack in the user area and jumps to the code pointed at by LINK, switching tasks. RESTART (S -- ) Sets the user pointer to point to a new user area and restores the parameter stack that was previously saved in the USER area. Then pops the RP and IP off of the stack and resumes execution. The inverse of PAUSE. \ Manipulate Tasks 11OCT83HHLINT# The software interrupt number to use on the 8086 LOCAL Map a User variable from the current task to another task@LINK Return a pointer the the next tasks entry point !LINK Set the link field of the current task (perhaps relative)SLEEP makes a task pause indefinitely. WAKE lets a task start again. STOP makes a task pause indefinitely. SINGLE removes the multi-tasker's scheduler/dispatcher loop. MULTI installs the multi-tasker's scheduler/dispatcher loop. By patching the appropriate INT vector and enabling PAUSE. \ Machine Dependent IO Words 07Apr84mapCODE PC@ (S port# -- n ) Fetch an 8 bit byte from an io port CODE P@ (S port# -- n ) Fetch a 16 bit word from an io port CODE PC! (S n port# -- ) Store an 8 bit byte into an io port CODE P! (S n port# -- ) Store a 16 bit word into an io port -------------------------------------------------------------------------------- /crck4.com: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ForthHub/F83/8d1080bb7eb08b3112600539a8db0624c74d536c/crck4.com -------------------------------------------------------------------------------- /expand86.blk: -------------------------------------------------------------------------------- 1 | \ The Rest is Silence 04Apr84map************************************************************* ************************************************************* *** *** *** Please direct all questions, comments, and *** *** miscellaneous personal abuse to: *** *** *** *** Henry Laxen or Michael Perry *** *** 1259 Cornell Avenue 1125 Bancroft Way *** *** Berkeley, California Berkeley, California *** *** 94706 94702 *** *** *** ************************************************************* ************************************************************* \ Expand the Huffman encoded files for F83 01MAY84HHLFROM HUFFMAN.BLK OK : PROMPT (S -- ) CR ." To expand your F83 system, make sure this disk" CR ." is in drive A: and that an empty, formatted disk is" CR ." in drive B:. You will need two disks." CR ." When ready, press any key to continue. " HERE 1 EXPECT ( Give user a chance to get out ) ; : WAKE-USER (S -- ) 100 0 DO BEEP KEY? ?LEAVE LOOP ; : SWITCH-DISKS (S -- ) WAKE-USER CR ." Your disk is now full, please" CR ." remove it and insert another empty, formatted disk" CR ." in drive B: and press any key to continue. " HERE 1 EXPECT [ DOS ] 0 25 BDOS RESET SELECT ; --> \ Expand the Huffman encoded files for F83 : HI HELLO CR ." To expand your system, type XYZZY " ; ' HI IS BOOT DEFINE EXPAND86.BLK : XYZZY (S -- ) CR ." This takes a long long long time, and bells will " CR ." ring when you are needed, so I suggest you get it" CR ." started and have a long cool drink." PROMPT EXPAND86.BLK [ DOS ] OPEN-FILE [ FORTH ] 3 LOAD ; : EXPAND CR >IN @ ." Expanding: " BL WORD COUNT TYPE ." into " BL WORD COUNT TYPE SPACE >IN ! EXPAND ; : COMPRESS CR >IN @ ." Compressing: " BL WORD COUNT TYPE ." into " BL WORD COUNT TYPE SPACE >IN ! COMPRESS ; MARK THEN SAVE-SYSTEM RUNME.COM \ Expand the Huffman encoded files for F83 24APR84HHLTHEN EXPAND M86.HUF B:META86.BLK THEN EXPAND K86.HUF B:KERNEL86.BLK SWITCH-DISKS THEN EXPAND E86.HUF B:EXTEND86.BLK THEN EXPAND C86.HUF B:CPU8086.BLK THEN EXPAND UT.HUF B:UTILITY.BLK THEN EXPAND HF.HUF B:HUFFMAN.BLK THEN EXPAND CK.HUF B:CLOCK.BLK THEN EXPAND FX.HUF B:F83-FIXS.TXT WAKE-USER EMPTY ' HELLO IS BOOT SAVE-SYSTEM B:F83.COM CR .( Congratulations, you have a full) CR .( F83 system. May the Forth be with you.) ( These are all of the files that are distributed with a Perry & Laxen public domain Forth system. They will be expanded with this utility. Please be patient. ) \ Expand the Huffman encoded files for F83 24APR84HHLTHEN COMPRESS A:META86.BLK B:M86.HUF THEN COMPRESS A:KERNEL86.BLK B:K86.HUF THEN COMPRESS A:HUFFMAN.BLK B:HF.HUF THEN COMPRESS A:EXTEND86.BLK B:E86.HUF THEN COMPRESS A:CPU8086.BLK B:C86.HUF THEN COMPRESS A:UTILITY.BLK B:UT.HUF THEN COMPRESS A:CLOCK.BLK B:CK.HUF THEN COMPRESS A:F83-FIXS.TXT B:FX.HUF WAKE-USER -------------------------------------------------------------------------------- /extend86.blk: -------------------------------------------------------------------------------- 1 | \ The Rest is Silence 03Apr84map************************************************************* ************************************************************* *** *** *** Please direct all questions, comments, and *** *** miscellaneous personal abuse to: *** *** *** *** Henry Laxen or Michael Perry *** *** 1259 Cornell Avenue 1125 Bancroft Way *** *** Berkeley, California Berkeley, California *** *** 94706 94702 *** *** *** ************************************************************* ************************************************************* ( Load Screen to Bring up Standard System 07Apr84map) CR .( Loading system extensions.) CR 2 VIEW# ! ( This will be view file# 2 ) WARNING OFF 3 LOAD ( BASICS ) 6 LOAD ( FILE-INTERFACE ) FROM CPU8086.BLK 1 LOAD ( Machine Dependent Code ) FROM UTILITY.BLK 1 LOAD ( Standard System Utilities ) WARNING ON --> \ Load up the system 08MAY84HHL: HELLO (S -- ) CR ." 8086 Forth 83 Model " CR ." Version 2.1.0 Modified 01Jun84 " START ONLY FORTH ALSO DEFINITIONS ; ' HELLO IS BOOT \ 13 LOAD ( Configuration: change and load as desired. ) : MARK (S -- ) CREATE DOES> (FORGET) FORTH DEFINITIONS ; MARK EMPTY HERE FENCE ! CR .( System has been loaded, Size = ) HERE U. SAVE-SYSTEM F83.COM CR .( System saved as F83.COM ) ( Commenting and Loading Words 16Oct83map) 64 CONSTANT C/L 16 CONSTANT L/SCR : \ ( -- ) >IN @ NEGATE C/L MOD >IN +! ; IMMEDIATE : (S ( -- ) [COMPILE] ( ; IMMEDIATE : ? (S adr -- ) @ . ; : ?ENOUGH (S n -- ) DEPTH 1- > ABORT" Not enough Parameters" ; : THRU (S n1 n2 -- ) 2 ?ENOUGH 1+ SWAP ?DO I LOAD LOOP ; : +THRU (S n1 n2 -- ) BLK @ + SWAP BLK @ + SWAP THRU ; : --> (S -- ) >IN OFF 1 BLK +! ; IMMEDIATE 1 2 +THRU ( Rest of Basic Utilities ) \ The ALSO and ONLY Concept 07Feb84mapCONTEXT DUP @ SWAP 2+ ! ( Make FORTH also ) VOCABULARY ROOT ROOT DEFINITIONS : ALSO (S -- ) CONTEXT DUP 2+ #VOCS 2- 2* CMOVE> ; : ONLY (S -- ) ['] ROOT >BODY CONTEXT #VOCS 1- 2* 2DUP ERASE + ! ROOT ; : SEAL (S -- ) ' >BODY CONTEXT #VOCS 2* ERASE CONTEXT ! ; : PREVIOUS (S -- ) CONTEXT DUP 2+ SWAP #VOCS 2- 2* CMOVE CONTEXT #VOCS 2- 2* + OFF ; \ The ALSO and ONLY Concept 06Apr84map: FORTH FORTH ; : DEFINITIONS DEFINITIONS ; : ORDER (S -- ) CR ." Context: " CONTEXT #VOCS 0 DO DUP @ ?DUP IF BODY> >NAME .ID THEN 2+ LOOP DROP CR ." Current: " CURRENT @ BODY> >NAME .ID ; : VOCS (S -- ) ." : " VOC-LINK @ BEGIN DUP #THREADS 2* - BODY> >NAME .ID @ DUP 0= UNTIL DROP ; ONLY FORTH ALSO DEFINITIONS \ Load Screen for DOS Interface 07Apr84mapDOS DEFINITIONS 1 6 +THRU FORTH DEFINITIONS CR .( File Interface Loaded ) \S The DOS interface consists of a set of words that access the BDOS functions of DOS, such as making, opening, and deleting files. There is also a word that parses a string and creates a file control block. Finally the word SAVE can be used to save the contents of memory as a DOS file. \ DOS Interface 10Apr84mapCREATE FCB2 B/FCB ALLOT : RESET (S -- ) 0 13 BDOS DROP ; : CLOSE (S fcb -- ) 16 BDOS DOS-ERR? ABORT" Close error" ; : SEARCH0 (S fcb -- n ) 17 BDOS ; : SEARCH (S fcb -- n ) 18 BDOS ; : DELETE (S fcb -- n ) 19 BDOS ; : READ (S fcb -- ) 20 BDOS DOS-ERR? ABORT" Read error" ; : WRITE (S fcb -- ) 21 BDOS DOS-ERR? ABORT" Write error" ; : MAKE-FILE (S fcb -- ) 22 BDOS DOS-ERR? ABORT" Can't MAKE File " ; \ Create File Control Blocks 19Apr84map: (!FCB) (S Addr len FCB-addr --- ) DUP B/FCB ERASE DUP 1+ 11 BLANK >R OVER 1+ C@ ASCII : = IF OVER C@ [ ASCII A 1- ] LITERAL - R@ C! 2 /STRING THEN R> 1+ -ROT 0 DO DUP C@ ASCII . = IF SWAP 8 I - + ELSE 2DUP C@ SWAP C! SWAP 1+ THEN SWAP 1+ LOOP 2DROP ; : !FCB (S FCB-addr ) BL WORD COUNT CAPS @ IF 2DUP UPPER THEN ROT (!FCB) ; : SELECT (S drive -- ) ( DUP 9 BIOS 0= ABORT" Illegal drive " ) 14 BDOS DROP ; \ Save a Core Image as a File on Disk 06Apr84map\ : CPM86-HEADER (S -- ) \ [ HEX ] 80 80 ERASE 1 80 C! 10 82 C! 10 86 C! \ 80 SET-DMA FCB2 DUP WRITE \ 80 80 ERASE DUP WRITE WRITE [ DECIMAL ] ; DEFER HEADER ' NOOP IS HEADER : SAVE (S Addr len --- ) FCB2 DUP !FCB DUP DELETE DROP DUP MAKE-FILE -ROT HEADER BOUNDS ?DO I SET-DMA DUP WRITE 128 +LOOP CLOSE ; FORTH DEFINITIONS : MORE (S n -- ) [ DOS ] 1 ?ENOUGH CAPACITY SWAP DUP 8* FILE @ MAXREC# +! BOUNDS ?DO I BUFFER B/BUF BLANK UPDATE LOOP SAVE-BUFFERS FILE @ CLOSE ; : CREATE-FILE (S #blocks -- ) [ DOS ] FCB2 DUP !FILES DUP !FCB MAKE-FILE MORE ; \ Display Directory 13Apr84mapDOS DEFINITIONS : .NAME (S n -- ) #OUT @ C/L > IF CR THEN 32 * PAD + 1+ 8 2DUP TYPE SPACE + 3 TYPE 3 SPACES ; FORTH DEFINITIONS : DIR (S -- ) [ DOS ] " ????????.???" FCB2 (!FCB) CR PAD SET-DMA FCB2 SEARCH0 BEGIN .NAME FCB2 SEARCH DUP DOS-ERR? UNTIL DROP ; : DRIVE? (S -- ) 0 25 BDOS ASCII A + EMIT ." : " ; : A: (S -- ) [ DOS ] 0 SELECT ; : B: (S -- ) [ DOS ] 1 SELECT ; DOS DEFINITIONS \ Define and Open files 04Apr84map: FILE: (S -- fcb ) >IN @ CREATE >IN ! HERE DUP B/FCB ALLOT !FCB DOES> !FILES ; : ?DEFINE (S -- fcb ) >IN @ DEFINED IF NIP >BODY ELSE DROP >IN ! FILE: THEN ; FORTH DEFINITIONS : DEFINE (S -- ) [ DOS ] ?DEFINE DROP ; : OPEN (S -- ) [ DOS ] ?DEFINE !FILES OPEN-FILE ; : FROM (S -- ) [ DOS ] ?DEFINE IN-FILE ! OPEN-FILE ; : SAVE-SYSTEM (S -- ) [ DOS HEX ] 100 HERE SAVE ; DECIMAL \ Viewing Source Screens 08MAY84HHLCREATE VIEW-FILES 32 ALLOT VIEW-FILES 32 ERASE : VIEWS (S n -- ) [ DOS ] ?DEFINE 2DUP 40 + ! BODY> SWAP 2* VIEW-FILES + ! ; 1 VIEWS KERNEL86.BLK 2 VIEWS EXTEND86.BLK 3 VIEWS CPU8086.BLK 4 VIEWS UTILITY.BLK \ My normal configuration 07Apr84mapCAPS ON ' EPSON IS INIT-PR ' FORM-FEED IS PAGE ' (WHERE) IS WHERE EDITOR QUME FORTH 5 VIEWS CLOCK.BLK FROM CLOCK.BLK 1 LOAD ( Load Screen to Bring up Standard System 04Apr84map) This is set so that definitions in this file can be VIEWed. BASICS are needed by everything else. FILE-INTERFACE allows convenient use of files. CPU8080.BLK Contains all of the 8080 machine dependent stuff such as the Assembler, the Debug Utility which patches NEXT, and the MultiTasker, which needs some code words in order to function efficiently. UTILITY.BLK Contains all of the standard utilities that are usually resident in a Forth system, such as the editor, the decompiler, a print utility, etc. \ Load up the system 07Apr84mapHELLO (S -- ) Gives the user the sign on message, making him foolishly believe that he is running an 83 Standard System. It also does all of the one time start up code required, such as relocating the heads and opening the screen file, if any. Load configuration. Personalize here. MARK (S -- ) A Defining word that allows you to restore the dictionary to a known state. EMPTY The current state of the dictionary. ( Commenting and Loading Words 25Jul83map) C/L The number of characters per line. L/SCR The number of lines per screen. \ A comment word. Ignores the rest of the line (S Used for Stack Comments. Behaves just like ( ? Displays the contents of an address. ?ENOUGH (S n -- ) Issue an error message if too few parameters on the stack. THRU (S n1 n2 -- ) Load a bunch of screens. +THRU (S n1 n2 -- ) Load a bunch of screens relative to the current screen. --> (S -- ) Load the next screen. \ The ALSO and ONLY Concept 03Apr84map ROOT A small vocabulary for controlling search order. ALSO (S -- ) Adds another vocabulary to the search order. ONLY Erases the search order and forces the ROOT vocabulary to be the first and last. SEAL Usage: SEAL FORTH will change the search order such that only FORTH will be searched. Used for turn-key applications. PREVIOUS The inverse of ALSO, removes the most recently referenced vocabulary from the search order. \ The ALSO and ONLY Concept 03Apr84mapWe initialize the ROOT vocabulary with a few definitions that allow us to do vocabulary related things. ORDER (S -- ) Displays the search order currently in effect. Also displays the CURRENT vocabulary, which is were definitions are placed. VOCS (S -- ) Lists all of the vocabularies that have been defined so far, in the order of their definition. \ DOS BDOS Interface 10Apr84mapFCB2 Space for a second FCB when needed. RESET Reset the DOS disk system CLOSE Close the given file, and report errors. SEARCH0 Search for the first occurance SEARCH Search for the next occurance. DELETE Remove an old file. READ Read the next sequential record, and report errors. WRITE Write the next sequential record, and report errors. MAKE-FILE create a directory entry for a new file, and report errors. \ Create File Control Blocks 11Apr84map(!FCB) (S Addr len FCB-addr --- ) Set up the filce control block per the specified string. This is the primitive file parse word, which breaks the drive/file name string into a drive specifier, file name, and extension, and leaves the parsed result in the given file control block address. !FCB (S FCB-addr ) Parse the next word in the input stream as a file. If CAPS is false, allow lower case names. SELECT make given drive the default. \ Save a Core Image as a File on Disk 22FEB84MAPHEADER This is different for CP/M-80, CP/M-86, and CP/M-68K. SAVE (S addr len -- ) Save the string specified as a CP/M file whose name is specified following the SAVE word. The current screen file is not disturbed. MORE Extend the size of the current file by n Blocks. CREATE-FILE creates a new file containing the given number of blocks. \ Display Directory 13Apr84map .NAME prints one filename. DIR prints a directory of the current dirve. DRIVE? prints currently selected drive. A: selects drive A as the default. B: selects drive B as the default. \ Open files and list directories 29Mar84mapFILE: (S -- fcb ) Define the next word as a file by allocating an FCB in the dictionary and parsing the next word as a file name. Leave the address of the file control block. ?DEFINE (S -- fcb ) Define the next word as a file if it does not already exist. Leave the address of the file control block. DEFINE (S -- ) Define the following word as a file name without opening it. OPEN (S -- ) Open the following file and make it the current file. FROM (S -- ) Open the following file and make it the current input file. SAVE-SYSTEM (S -- ) Usage: SAVE-SYSTEM NEWNAME.68K Saves an executable image of the system as a file. \ Set up VIEW-FILES table 07Apr84mapVIEW-FILES is an array of pointers to fcbs. VIEWS installs a file into the VIEW-FILES array, and sets the fcb to contain the matching view number. Now initialize the VIEW-FILES array: KERNEL86.BLK was used to generate the precompile code. EXTEND86.BLK was opened on the execute line, loads all extras. CPU8086.BLK has the machine dependent post-compile code. UTILITY.BLK has the machine independent post-compile code. -------------------------------------------------------------------------------- /f83-fixs.txt: -------------------------------------------------------------------------------- 1 | This file describes most of the changes to F83 between versions 2 | 1.0 and 2.0. 3 | 4 | It is always difficult to follow a moving target. In the 5 | six months since we released version 1.0 we have received so many 6 | good suggestions that the temptation to use some of them was 7 | impossible to resist. To all of you who contributed, thank you 8 | again. We will try to avoid any further changes until 1985 at the 9 | earliest. If there are bugs, we will report them separately. 10 | Updating the various versions is a lot of work even without offering 11 | any support, and we are tired. It is time to move on to applications, 12 | and do something useful for a change. 13 | 14 | 15 | The changes were as follows: 16 | 17 | General: 18 | 19 | * Removed the superfluous NOOP from all self-defining words. 20 | * Changed all instances of C; to END-CODE ( by request). 21 | * Partitioned META into META.BLK ( the meta-compiler ) and 22 | KERNEL.BLK ( the source for the kernel ). 23 | 24 | 25 | META: 26 | * Fixed .SYMBOLS 27 | 28 | 29 | KERNEL: 30 | 31 | * Removed null from the system. Sealed search orders no longer 32 | require the old magic null word. 33 | * Fixed PARSE and PARSE-WORD. They used to increment >IN past 34 | the end of source text. 35 | * Changed CP/M to DOS. 36 | * Moved kernel DOS words into DOS vocabulary. 37 | * Added USER VARIABLE IN-FILE. All file operations read from IN-FILE 38 | and write to FILE. This allowed removing the confusing FILES 39 | vocabulary. User interface is unchanged: FROM makes 40 | the IN-FILE. OPEN makes both the same. LOAD uses IN-FILE, 41 | then resets it to FILE. This is probably appropriate. 42 | * FBLOCK and FBUFFER take an fcb address and a block number. 43 | * SWITCH exchanges FILE and IN-FILE. 44 | * ?UPPERCASE conditionally forces a string to upper case. Used by 45 | DEFINED and FORGET. 46 | * EMIT primitives renamed: (CONSOLE) is console only, (EMIT) is 47 | for console and maybe also printer, depending on PRINTING. 48 | * Fixed CONTROL. 49 | * Made default (PRINT) not use LISTST, because it hangs on 50 | many systems. Optionally use LISTST if available for faster spooling. 51 | * Renamed FORTH control character table from CC1 to CC-FORTH. 52 | * Changed DO to ?DO in -TRAILING. 53 | * Deleted HEADER from CREATE, made CREATE do it all. 54 | * Changed ,VIEW to make file 0 if BLK is 0. 55 | * Added \S for comment to end of screen. 56 | * Added better error handling for disk reads and writes. 57 | * Accessing a BLOCK which is Out of Range no longer leaves the 58 | buffer assigned to the non-existent block. 59 | * Changed DISCARD to mark discarded buffer as empty. 60 | * .FILE and FILE? added to display file names. 61 | 62 | 63 | EXTEND: 64 | 65 | * Split ONLY into the ONLY operator and the ROOT vocabulary. 66 | * Removed OPEN-FILE from FILE: and added it to VIEW. 67 | * Added VIEWS which installs files into VIEW-FILES table. 68 | * Moved SET-DRIVE into EXTEND, changed it to use the BIOS 69 | to determine whether a drive is legal, and renamed it SELECT. 70 | * DRIVE? prints the current drive. 71 | * Added A: and B: which select drive A or B. 72 | * Added error control into MAKE, CLOSE, READ, and WRITE. 73 | 74 | 75 | CPU: 76 | * Added three words for decompiling DOES> words. 77 | * Renamed FIX to UNBUG. 78 | 79 | 80 | UTILITY: 81 | FORTH: 82 | 83 | * Added :: for immediate compilation. 84 | * VIEW is now wordier. It prints the file name and screen number of 85 | the source code for a word, then OPENs the file and LISTs the code. 86 | * Made SEARCH much faster when CASE is significant ( false), 87 | by SCANning for the first character. Turn CAPS OFF for speed. 88 | * Added .SCR which prints current screen number and file name. 89 | It is used by LIST and EDITOR .ALL. 90 | * Changed N and B to include DISK-ERROR OFF. 91 | 92 | EDITOR: 93 | 94 | * Changed ?TEXT to use PARSE instead of WORD. This allows 95 | commands like "F ^" to use the contents of the buffers. 96 | * Modified auto display updating to work correctly with both 97 | smart and dumb terminals. 98 | * Added FIX which VIEWs and EDITs. 99 | * Renamed JUST to J. I use it a LOT. 100 | * Made ED smarter: it does not change context if already editing. 101 | * ID field defaults to blanks, not nulls. 102 | * GET-ID waits for an extra character to allow you to read what 103 | you typed before hitting return. 104 | 105 | Showing: 106 | 107 | * SHOW now uses (SEMIT) which outputs to either the console 108 | or the printer, but not both, depending on PRINTING, which is 109 | reset by (ABORT"). 110 | * SHOW works for small files: PR replaces out-of-range blocks with 111 | LOGO. 112 | * FOOTING is vectored. 113 | * PAGE defaults to linefeeds. Many people did not have form-feed 114 | capability. 115 | 116 | Multitasker: 117 | 118 | * Renamed BACKGROUND to BACKGROUND: because it compiles until 119 | a semi-colon. 120 | 121 | 122 | NEW FILES: 123 | 124 | * HUFFMAN.BLK contains the source for the Huffman encoding used 125 | on the files as shipped. 126 | * CLOCK.BLK shows how to use a clock/calendar to automatically set 127 | the editor date stamp when you boot. The code is for a CompuPro 128 | System Support 1, but should give you some hints. 129 | * HUNT.BLK has source for HUNT. 130 | HUNT lists all words whose name contains the given substring. 131 | 132 | 133 | Now what have I forgotten? I'm sure you will let me know. -------------------------------------------------------------------------------- /f83.com: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ForthHub/F83/8d1080bb7eb08b3112600539a8db0624c74d536c/f83.com -------------------------------------------------------------------------------- /huffman.blk: -------------------------------------------------------------------------------- 1 | \ The Rest is Silence 09APR84HHL************************************************************* ************************************************************* *** *** *** Please direct all questions, comments, and *** *** miscellaneous personal abuse to: *** *** *** *** Henry Laxen or Michael Perry *** *** 1259 Cornell Avenue 1125 Bancroft Way *** *** Berkeley, California Berkeley, California *** *** 94706 94702 *** *** *** *** (415) 525-8582 (415) 644-3421 *** *** *** ************************************************************* ************************************************************* \ Load Screen for Huffman Encoding/Decoding 29MAY84HHL 3 20 THRU FORTH CR .( Huffman Utility Loaded ) EXIT USAGE To compress a file type: COMPRESS INFILE1.EXT OUTFILE1.EXT To expand a file type: EXPAND INFILE2.EXT OUTFILE2.EXT Where INFILE2.EXT had better be the OUTFILE1.EXT of a prior compression. After either a COMPRESS or EXPAND executing EMPTY will reset the dictionary back to its original state. \ Shared primitives - Double Number Helpers 29MAR84HHL: D+! (S d# addr -- ) DUP 2@ ROT >R D+ R> 2! ; : ARRAY CREATE (S n -- ) 2* ALLOT DOES> (S n -- addr ) SWAP 2* + ; : 2ARRAY CREATE (S n -- ) 4 * ALLOT DOES> (S n -- addr ) SWAP 2* 2* + ; : 0OR1 (S n -- 0 | 1 ) 0<> 1 AND ; : HAPPY (S -- ) DOES> DUP @ IF OFF ." ...Working " ELSE ON 12 SPACES THEN 12 BACKSPACES ; HAPPY \ Read and Write bytes from a file 29MAR84HHLVARIABLE READING? ( True=reading False=writing ) : IO-ARRAY (S n -- ) CREATE DUP , 2* ALLOT DOES> DUP @ READING? @ IF DROP ELSE + THEN 2+ ; 2 IO-ARRAY #BITS ( Counts up to 8 ) 4 IO-ARRAY #BYTES ( Number of bytes sent so far ) 8 IO-ARRAY BIT-BUFFER ( Holds 1 byte worth of bits ) 128 IO-ARRAY IO-BUFFER ( Holds sectors worth of data ) 2 IO-ARRAY >FILE ( Points to file control block ) : INIT-IO (S -- ) READING? OFF 2 0 DO 0 #BITS ! 0. #BYTES 2! BIT-BUFFER 8 ERASE IO-BUFFER 128 CONTROL Z FILL READING? ON LOOP ; \ File System Interface 10Apr84map: PERFORM-IO (S -- ) [ DOS ] HAPPY IO-BUFFER SET-DMA >FILE @ READING? @ IF READ ELSE WRITE THEN ; : FILE-SIZE (S -- d# ) [ DOS ] >FILE @ FILE-SIZE 128 UM* ; : REWIND (S fcb -- ) [ DOS ] DUP CLOSE DUP 12 + 21 ERASE ( Clean up the FCB ) 15 BDOS DROP ( Open ) ; : CLOSE (S -- ) [ DOS ] >FILE @ CLOSE ; \ File System Interface 10Apr84map: INPUT (S -- ) READING? ON ; : OUTPUT (S -- ) READING? OFF ; CREATE IN-FCB B/FCB ALLOT CREATE OUT-FCB B/FCB ALLOT : IN&OUT (S -- ) FILE @ INPUT IN-FCB >FILE ! OUTPUT OUT-FCB >FILE ! [ DOS ] IN-FCB !FCB OUT-FCB !FCB IN-FCB 15 BDOS DOS-ERR? ABORT" Can't open file " OUT-FCB DUP DELETE DROP MAKE-FILE FILE ! ; \ Read and write bytes to a file 10Apr84map: @BYTE (S -- n ) INPUT #BYTES 2@ DROP 127 AND DUP 0= IF PERFORM-IO THEN IO-BUFFER + C@ 1. #BYTES D+! ; : !BYTE (S n -- ) OUTPUT #BYTES 2@ DROP 127 AND IO-BUFFER + C! 1. #BYTES D+! #BYTES 2@ DROP 127 AND 0= IF PERFORM-IO THEN ; \ Convert bytes into bits 10Apr84map: (!BYTE) (S -- ) 0 BIT-BUFFER 8 BOUNDS DO 2* I C@ + LOOP !BYTE ; : FLUSH-BYTE (S -- ) OUTPUT #BITS @ IF (!BYTE) THEN #BYTES 2@ DROP 127 AND IF PERFORM-IO THEN CLOSE ; : (@BYTE) (S -- ) @BYTE BIT-BUFFER 8 BOUNDS DO DUP 128 AND 0OR1 I C! 2* LOOP DROP ; \ Read or Write a Bitstream 03JUN84HHL: !BIT (S n -- ) OUTPUT 0OR1 #BITS @ BIT-BUFFER + C! 1 #BITS +! #BITS @ 8 = IF (!BYTE) #BITS OFF THEN ; : @BIT (S -- n ) INPUT #BITS @ 0= IF (@BYTE) 8 #BITS ! THEN 8 #BITS @ - BIT-BUFFER + C@ -1 #BITS +! ; : !BITS (S c n -- ) OUTPUT TUCK 16 SWAP - 0 ?DO 2* LOOP SWAP 0 ?DO DUP 32768 AND !BIT 2* LOOP DROP ; : @BITS (S n -- c ) INPUT 0 SWAP 0 ?DO 2* @BIT + LOOP ; \ Build a Frequency Table 29MAR84HHLVOCABULARY COMPRESSING COMPRESSING DEFINITIONS 256 2ARRAY FREQUENCY-TABLE : INCLUDE (S char -- ) FREQUENCY-TABLE 1. ROT D+! ; 256 ARRAY HUFFMAN 2VARIABLE MIN1 2VARIABLE MIN2 VARIABLE >MIN1 VARIABLE >MIN2 \ Construct a Huffman Code 29MAR84HHL: MINIMUMS (S -- f ) -1. MIN1 2! -1. MIN2 2! 256 0 DO I FREQUENCY-TABLE 2@ 2DUP D0= NOT IF MIN1 2@ 2OVER DU< NOT IF MIN1 2@ MIN2 2! >MIN1 @ >MIN2 ! 2DUP MIN1 2! I >MIN1 ! ELSE MIN2 2@ 2OVER DU< NOT IF 2DUP MIN2 2! I >MIN2 ! THEN THEN THEN 2DROP LOOP MIN2 2@ -1. D= NOT ; \ Construct a Huffman Code 04DEC83HHL: JOIN-MINIMUMS (S -- ) MIN1 2@ MIN2 2@ D+ ( new value ) >MIN1 @ FREQUENCY-TABLE 2! 0. >MIN2 @ FREQUENCY-TABLE 2! ( remove old value ) ; : ENCODE-MINIMUMS (S -- ) HERE >MIN1 @ HUFFMAN @ , >MIN2 @ HUFFMAN @ , >MIN1 @ 256 * >MIN2 @ + , >MIN1 @ HUFFMAN ! ; : ENCODE (S -- ) BEGIN MINIMUMS WHILE ENCODE-MINIMUMS JOIN-MINIMUMS REPEAT ; \ Display a Huffman Code 13APR84HHLCREATE >HLD 128 ALLOT VARIABLE HLD 0 HLD ! : +HOLD >HLD HLD @ + C! 1 HLD +! ; : -HOLD -1 HLD +! ; 256 ARRAY H-CODE : .HOLD (S char -- ) HERE SWAP H-CODE ! HLD @ C, >HLD HERE HLD @ DUP ALLOT CMOVE ; : DECODE RECURSIVE (S addr -- ) 0 +HOLD DUP @ IF DUP @ DECODE ELSE DUP 4 + @ FLIP 255 AND .HOLD THEN -HOLD 1 +HOLD DUP 2+ @ IF DUP 2+ @ DECODE ELSE DUP 4 + @ 255 AND .HOLD THEN -HOLD DROP ; : FLATTEN (S -- ) >MIN1 @ HUFFMAN @ DECODE ; \ Compress a string into its Huffman Equivalent 29MAY84HHL: COMPRESS-BYTE (S n -- ) H-CODE @ COUNT BOUNDS ?DO I C@ !BIT LOOP ; : COMPRESS-ENCODING (S -- ) 256 0 DO I H-CODE @ COUNT DUP IF 1 !BIT DUP 7 !BITS BOUNDS DO I C@ !BIT LOOP ELSE 0 !BIT 2DROP THEN LOOP ; \ Read and file and Encode and Compress it 29MAR84HHL: COMPRESS-FILE (S d# -- ) BEGIN 2DUP D0= NOT WHILE 1. D- @BYTE COMPRESS-BYTE REPEAT FLUSH-BYTE 2DROP ; : ENCODE-FILE (S d# -- ) BEGIN 2DUP D0= NOT WHILE 1. D- @BYTE INCLUDE REPEAT 2DROP ; \ Read the input file and write the compessed file 29MAY84HHLCREATE ZERO 0 , : INITIALIZE (S -- ) 256 0 DO 0. I FREQUENCY-TABLE 2! 0 I HUFFMAN ! ZERO I H-CODE ! LOOP INIT-IO IN&OUT ; FORTH DEFINITIONS : COMPRESS (S -- ) [ COMPRESSING ] INITIALIZE INPUT FILE-SIZE 2DUP ENCODE-FILE ENCODE FLATTEN INIT-IO INPUT >FILE @ REWIND 12345 16 !BITS 2DUP 16 !BITS 16 !BITS COMPRESS-ENCODING 2DUP COMPRESS-FILE 2DROP ; \ Expand a compressed file 03JUN84HHLVOCABULARY EXPANDING EXPANDING DEFINITIONS VARIABLE ROOT : EXPAND-BITS (S len char -- ) -256 + ROOT @ ROT 0 DO @BIT 2* + DUP @ DUP IF NIP ELSE DROP HERE DUP ROT ! 0 , 0 , 0 , THEN LOOP 4 + ! ; : EXPAND-ENCODING (S -- ) HERE ROOT ! 0 , 0 , 0 , 256 0 DO @BIT IF 7 @BITS I EXPAND-BITS THEN LOOP ; \ Expand the input stream 03JUN84HHL: LEAF? (S addr -- f ) 5 + C@ ; : EXPAND-BYTE (S -- char ) ROOT @ BEGIN @BIT 2* + @ DUP LEAF? UNTIL 4 + C@ ; : EXPAND-FILE (S d# -- ) BEGIN 2DUP D0= NOT WHILE 1. D- EXPAND-BYTE !BYTE REPEAT FLUSH-BYTE 2DROP ; \ Expand a Compressed File 28MAY84HHL: INITIALIZE (S -- ) INIT-IO IN&OUT ; FORTH DEFINITIONS : EXPAND [ EXPANDING ] INITIALIZE 16 @BITS 12345 <> ABORT" Not a Compressed file " 16 @BITS 16 @BITS SWAP EXPAND-ENCODING EXPAND-FILE ; \ Huffman File Compression 29MAY84HHL This application was written by Henry Laxen and is in the public domain. Please credit the author when distributing it. You are free to make copies, modify, publish, or ignore this as the fancy suits you. I apologize for the speed of this program (actually the lack thereof) but I wanted it to be totally transportable across different machines, and hence all of the bit twiddling is done in high level. You could speed this up substantially by writing @BIT and !BIT in code. My thanks to Andrea Fischel for showing me how to recreate the Huffman tree based on the compressed bit encoding. \ Load Screen for Huffman Encoding/Decoding 09APR84HHL The purpose of this utility is to COMPRESS and EXPAND files in order to save disk space. A Huffman encoding is used in order to achieve this compression. An excellant description of how Huffman codes work can be found in Volume 1 of Knuth. The general idea is that a frequency table is built which contains the number of occurances of each character in the file to be compressed. Based on this frequency table, each 8 bit byte is encoded as a variable length bit pattern. Obviously, the frequently occuring bytes are encoded in less than 8 bits, and the rarely occuring bytes are encoded in more than 8 bits. Very dramatic compression can be achieved with this scheme. In particular, BLK files can be substantially compressed because of the large number of blanks present. \ Shared primitives - Double Number Helpers 09APR84HHLD+! (S d# addr -- ) Increment the double number at addr by the d# on the stack. ARRAY Define a word sized array in memory. At runtime given the index into the array, return the address of the element. 2ARRAY Define a double work sized array in memory. Acts like ARRAY above. 0OR1 (S n -- 0 | 1 ) map 0 -> 0 and, all others -> 1 HAPPY (S -- ) Alternately print the string "...Working" or a string of blanks, each time it is called. This keeps the user happy, since he believes the machine is still working. \ Read and Write bytes from a file 09APR84HHLREADING? Used by file interface to distinguish read & write IO-ARRAY (S n -- ) Allows you to use the same name for a read or write version of an array or variable. Returns corresponding address. #BITS The number of bits mod 8 sent so far #BYTES Total number of bytes sent so far. BIT-BUFFER Used to buffer 1 byte worth of bits for IO IO-BUFFER Used to hold 1 sector's worth of data >FILE Points to FCB of file to read or write INIT-IO (S -- ) Initialize all of the IO variables defined above, and set the initial state to reading. \ File System Interface 09APR84HHLPERFORM-IO (S -- ) Let user know we are still alive, and either read or write a sector, depending on the IO direction. FILE-SIZE (S -- d# ) Return the size in bytes of the current file. REWIND (S fcb -- ) Allows you to reread a file for the second pass. Closes it at sets up the FCB so that the next read occurs at the beginning of the file. CLOSE (S -- ) Close the currently open file. \ File System Interface 09APR84HHLINPUT (S -- ) Set IO state to reading. OUTPUT (S -- ) Set IO state to writing. IN-FCB OUT-FCB Reserved for input & output FCBs IN&OUT (S -- ) Save the current Screen file, and read the input stream for the name of the input and output file. These names are parsed and the fcbs are placed in the arrays above. The input file is opened, and the output file is deleted and created. If an error occurs, the user is notified. Finally the current Screen file is restored. \ Read and write bytes to a file 09APR84HHL@BYTE (S -- n ) Read a byte from the input file, and place in on the stack. This is the primitive through which all reads must pass, since only it performs any actual IO. !BYTE (S n -- ) Take the byte from the stack and add it to the output file. This is the primitive through which all writes must pass, since only it performs any actual IO. \ Convert bytes into bits 09APR84HHL(!BYTE) (S -- ) Pack together the bits in the bit buffer, and write result. FLUSH-BYTE (S -- ) If there are any leftover bits to write, write them, and then perhaps flush the partially completed sector to disk. (@BYTE) (S -- ) Read the next byte from the input file and unpack the bits into the bit buffer. \ Read or Write a Bitstream 09APR84HHL!BIT (S n -- ) Write a single bit to the output file. @BIT (S -- n ) Read a single bit from the input file. !BITS (S c n -- ) Write up to 16 bits to the output file. All bit level write operations should use this word, and not !BIT above. @BITS (S n -- c ) Read up to 16 bits from the input file. All bit level read operations should use this word, and not @BIT above. \ Build a Frequency Table 09APR84HHLCOMPRESSING Segregate the COMPRESSING portion of the utility FREQUENCY-TABLE Contains the number of occurances of each byteINCLUDE (S char -- ) Increment the count in the frequency table for this char. HUFFMAN Used to build the tree of codes MIN1 MIN2 Contains the 2 smallest values in the Freq. Tab.>MIN1 >MIN2 Contains the index to the 2 smallest values \ Construct a Huffman Code 09APR84HHLMINIMUMS (S -- f ) Run through the frequency table and find the two smallest entries in it. Since these are counts, we use an unsigned comparison. The minimum values found are stored in the double variables MIN1 and MIN2. The index into the table of these values is stored in variables >MIN1 and >MIN2. The flag returned is true if two minimums exist, and false if there is only one entry left in the table. \ Construct a Huffman Code 09APR84HHLJOIN-MINIMUMS (S -- ) Combine the two minimum values found in the frequency table into a new value which is the sum of the previous values. Set the other minimum to zero, removing it. ENCODE-MINIMUMS (S -- ) Generate the Huffman tree based on the two new minimum values found in the frequency table. The character values are packed, two to a word. ENCODE (S -- ) While minimums exist in the frequency table, we construct our tree and combine them. The end result of ENCODE is a full tree, whose leaves contain characters. \ Display a Huffman Code 29MAY84HHL>HLD HLD Collect the path data while searching the tree +HOLD Append the character to the path string -HOLD Delete the character from the path string H-CODE An array which points to the encoding for a char. .HOLD Write the collected string to the dictionary. WHICH Holds the character we are looking for DECODE A recursive, inorder search of the Huffman Tree The leftmost nodes are searched for a leaf node. The path taken is collected using the HOLD mechanism set up above. If the leaf does not match the character we are searching for, we back up the path string and back up the path one level, and search the right node. When we do match, we write out the collected path string. FLATTEN Flatten the Huffman Tree into an array indexed by character. \ Compress a string into its Huffman Equivalent 09APR84HHLCOMPRESS-BYTE (S n -- ) Write the huffman code for the given byte to output file. COMPRESS-ENCODING (S -- ) We represent the encoding as follows: If the character is not present in the file, ie. the length of the huffman code is zero, then we write out a 0 bit. If the character is present, we write a 1 bit, followed by 7 bits representing the length of the encoding, followed by the encoding itself. \ Read and file and Encode and Compress it 09APR84HHLCOMPRESS-FILE (S d# -- ) Read through a file containing d# bytes of data, and compress each byte per its Huffman code. ENCODE-FILE (S d# -- ) Read through a file containing d# bytes of data, and build a frequency table for it. \ Read the input file and write the compessed file 29MAY84HHLINITIALIZE (S -- ) Initialize all of the relevant variables in order to compress a file into its Huffman equivalent. COMPRESS (S -- ) Takes two arguments from the input stream, the input file name and the output file name. The input file is read and compressed into the output file. Every file created by compress starts with two bytes containing 12345 followed by 32 bits of file length in bytes, followed by the compression. \ Expand a compressed file 29MAY84HHLEXPANDING Segregate the words associated with expanding. ROOT Points to the root of the rebuilt tree. EXPAND-BITS (S len char -- ) Add a leaf to the tree containing char. We read len bits and either follow or create tree nodes depeding on the value of the bit. A leaf has a hex ff in byte 5, data in 4. EXPAND-ENCODING (S -- ) Initialize the tree to have 1 node, the root. Read through the compressed encoding description and create the corresponding tree. \ Expand the input stream 29MAY84HHLLEAF? (S addr -- f ) Return non-zero if the node at addr is a leaf of the tree. EXPAND-BYTE (S -- ) Read bits from the file and follow the branches of the tree until we hit a leaf. Return the corresponding char. EXPAND-FILE (S d# -- ) Read d# bytes from the input file and expand them, writing the expanded data to the output file. \ Expand a Compressed File 09APR84HHLINITIALIZE (S -- ) Initialize variables, and get file names from input stream EXPAND The first 16 bits of the file to expand must be 12345, or else we are trying to expand a file that we did not compress. This would be fatal. The length is in the next 32 bits, followed by the encoding & the data. -------------------------------------------------------------------------------- /meta86.blk: -------------------------------------------------------------------------------- 1 | \ The Rest is Silence 04Apr84map************************************************************* ************************************************************* *** *** *** Please direct all questions, comments, and *** *** miscellaneous personal abuse to: *** *** *** *** Henry Laxen or Michael Perry *** *** 1259 Cornell Avenue 1125 Bancroft Way *** *** Berkeley, California Berkeley, California *** *** 94706 94702 *** *** *** ************************************************************* ************************************************************* \ Load Screen for Pre-Compile 06Apr84mapONLY FORTH ALSO DEFINITIONS FENCE OFF FORGET OUT WARNING OFF : NLOAD CR .S (LOAD) ; ' NLOAD IS LOAD 3 21 THRU ( The Meta Compiler ) ONLY FORTH DEFINITIONS ALSO CR .( Meta Compiler Loaded ) FROM KERNEL86.BLK 1 LOAD \ Vocabulary Helpers 10Jan84mapONLY FORTH ALSO VOCABULARY META META ALSO META DEFINITIONS VARIABLE DP-T : [FORTH] FORTH ; IMMEDIATE : [META] META ; IMMEDIATE : [ASSEMBLER] ASSEMBLER ; IMMEDIATE : SWITCH (S -- ) NOOP ( Context ) NOOP ( Current ) DOES> DUP @ CONTEXT @ SWAP CONTEXT ! OVER ! 2+ DUP @ CURRENT @ SWAP CURRENT ! SWAP ! ; SWITCH ( Redefine itself ) \ Memory Access Words 04Apr84map0 CONSTANT TARGET-ORIGIN : THERE (S taddr -- addr ) TARGET-ORIGIN + ; : C@-T (S taddr -- char ) THERE C@ ; : @-T (S taddr -- n ) THERE @ ; : C!-T (S char taddr -- ) THERE C! ; : !-T (S n taddr -- ) THERE ! ; : HERE-T (S -- taddr ) DP-T @ ; : ALLOT-T (S n -- ) DP-T +! ; : C,-T (S char -- ) HERE-T C!-T 1 ALLOT-T ; : ,-T (S n -- ) HERE-T !-T 2 ALLOT-T ; : S,-T (S addr len -- ) 0 ?DO COUNT C,-T LOOP DROP ; \ Define Symbol Table Vocabularies 21Dec83mapVOCABULARY TARGET VOCABULARY TRANSITION VOCABULARY FORWARD VOCABULARY USER ONLY DEFINITIONS FORTH ALSO META ALSO : META META ; : TARGET TARGET ; : TRANSITION TRANSITION ; : FORWARD FORWARD ; : USER USER ; : ASSEMBLER ASSEMBLER ; ONLY FORTH ALSO META ALSO DEFINITIONS \ Define Meta Branching Constructs 08OCT83HHL: ?>MARK (S -- f addr ) TRUE HERE-T 0 ,-T ; : ?>RESOLVE (S f addr -- ) HERE-T SWAP !-T ?CONDITION ; : ?MARK (S -- f addr ) TRUE HERE-T 0 C,-T ; : M?>RESOLVE (S f addr -- ) HERE-T OVER 1+ - SWAP C!-T ?CONDITION ; : M?MARK ASSEMBLER IS ?>MARK ' M?>RESOLVE ASSEMBLER IS ?>RESOLVE ' M? FORWARD-CODE ; \ Create Headers in Target Image 06Apr84mapVARIABLE WIDTH 31 WIDTH ! VARIABLE LAST-T VARIABLE CONTEXT-T VARIABLE CURRENT-T : HASH (S str-addr voc-addr -- thread ) SWAP 1+ C@ #THREADS 1- AND 2* + ; : HEADER (S -- ) BL WORD C@ 1+ WIDTH @ MIN ?DUP IF ALIGN BLK @ 4096 + ,-T ( Lay down view field ) HERE CURRENT-T @ HASH DUP @-T ,-T HERE-T 2- SWAP !-T HERE-T HERE ROT S,-T ALIGN DUP LAST-T ! 128 SWAP THERE CSET 128 HERE-T 1- THERE CSET THEN ; \ Meta Compiler Create Target Image 04Apr84map: TARGET-CREATE (S -- ) >IN @ HEADER >IN ! IN-TARGET CREATE IN-META HERE-T , TRUE , DOES> MAKE-CODE ; : RECREATE (S -- ) >IN @ TARGET-CREATE >IN ! ; : CODE (S -- ) TARGET-CREATE HERE-T 2+ ,-T ASSEMBLER !CSP ; ASSEMBLER ALSO DEFINITIONS : END-CODE IN-META ?CSP ; : C; END-CODE ; META IN-META \ Force compilation of target & forward words 07SEP83HHL: 'T (S -- cfa ) CONTEXT @ TARGET DEFINED ROT CONTEXT ! 0= ?MISSING ; : [TARGET] (S -- ) 'T , ; IMMEDIATE : 'F (S -- cfa ) CONTEXT @ FORWARD DEFINED ROT CONTEXT ! 0= ?MISSING ; : [FORWARD] (S -- ) 'F , ; IMMEDIATE \ Meta Compiler Branching & Defining Words 07SEP83HHL: T: (S -- ) SWITCH TRANSITION DEFINITIONS CREATE SWITCH ] DOES> >R ; : T; (S -- ) SWITCH TRANSITION DEFINITIONS [COMPILE] ; SWITCH ; IMMEDIATE : DIGIT? (S CHAR -- F ) BASE @ DIGIT NIP ; : PUNCT? (S CHAR -- F ) ASCII . OVER = SWAP ASCII - OVER = SWAP ASCII / OVER = SWAP DROP OR OR ; : NUMERIC? (S ADDR LEN -- F ) DUP 1 = IF DROP C@ DIGIT? EXIT THEN 1 -ROT 0 ?DO DUP C@ DUP DIGIT? SWAP PUNCT? OR ROT AND SWAP 1+ LOOP DROP ; \ Meta Compiler Transition Words 11Mar84mapT: ( [COMPILE] ( T; T: (S [COMPILE] (S T; T: \ [COMPILE] \ T; : STRING,-T (S -- ) ASCII " PARSE DUP C,-T S,-T ALIGN ; FORWARD: <(.")> T: ." [FORWARD] <(.")> STRING,-T T; FORWARD: <(")> T: " [FORWARD] <(")> STRING,-T T; FORWARD: <(ABORT")> T: ABORT" [FORWARD] <(ABORT")> STRING,-T T; \ Meta Compiler Defining Words 06SEP83HHLFORWARD: : CREATE RECREATE [FORWARD] HERE-T CONSTANT ; : VARIABLE (S -- ) CREATE 0 ,-T ; FORWARD: : DEFER (S -- ) TARGET-CREATE [FORWARD] 0 ,-T ; \ Meta Compiler Defining Words 07SEP83HHLFORTH VARIABLE #USER-T META ALSO USER DEFINITIONS : ALLOT (S n -- ) #USER-T +! ; FORWARD: : VARIABLE (S -- ) SWITCH RECREATE [FORWARD] #USER-T @ DUP ,-T 2 ALLOT META DEFINITIONS CONSTANT SWITCH ; FORWARD: : DEFER (S -- ) SWITCH TARGET-CREATE [FORWARD] SWITCH #USER-T @ ,-T 2 ALLOT ; ONLY FORTH ALSO META ALSO DEFINITIONS \ Meta Compiler Transition Words 04Apr84mapFORTH VARIABLE VOC-LINK-T META FORWARD: : VOCABULARY (S -- ) RECREATE [FORWARD] HERE-T #THREADS 0 DO 0 ,-T LOOP HERE-T VOC-LINK-T @ ,-T VOC-LINK-T ! CONSTANT DOES> @ CONTEXT-T ! ; : IMMEDIATE (S -- ) WIDTH @ IF ( Headers present? ) 64 ( Precedence Bit ) LAST-T @ THERE CSET THEN ; \ Meta Compiler Transition Words 04Apr84mapFORWARD: <(;USES)> FORTH VARIABLE STATE-T META T: ;USES (S -- ) [FORWARD] <(;USES)> IN-META ASSEMBLER !CSP STATE-T OFF T; T: [COMPILE] 'T EXECUTE T; FORWARD: <(IS)> T: IS [FORWARD] <(IS)> T; : IS 'T >BODY @ >BODY !-T ; T: ALIGN T; T: EVEN T; \ Display an unformatted Symbol Table 26Sep83map: .SYMBOLS (S -- ) TARGET CONTEXT @ HERE #THREADS 2* CMOVE BEGIN HERE 4 LARGEST DUP WHILE ?CR ." [[ " DUP .ID DUP NAME> >BODY @ U. ." ]] " N>LINK @ SWAP ! KEY? IF EXIT THEN REPEAT 2DROP IN-META ; \ Meta Compiler Resolve Forward References 07Jan84map: .UNRESOLVED (S -- ) FORWARD CONTEXT @ HERE #THREADS 2* CMOVE BEGIN HERE #THREADS LARGEST DUP WHILE ?CR DUP L>NAME NAME> >BODY RESOLVED? 0= IF DUP L>NAME .ID THEN @ SWAP ! REPEAT 2DROP IN-META ; : FIND-UNRESOLVED (S -- cfa f ) 'F DUP >BODY RESOLVED? ; : RESOLVE (S taddr cfa -- ) >BODY 2DUP TRUE OVER 2+ ! @ BEGIN DUP WHILE 2DUP @-T -ROT SWAP !-T REPEAT 2DROP ! ; : RESOLVES (S taddr -- ) FIND-UNRESOLVED IF >NAME .ID ." Already Resolved" DROP ELSE RESOLVE THEN ; \ Interpretive words for Meta 07SEP83HHL: H: [COMPILE] : ; H: ' 'T >BODY @ ; H: , ,-T ; H: C, C,-T ; H: HERE HERE-T ; H: ALLOT ALLOT-T ; H: DEFINITIONS DEFINITIONS CONTEXT-T @ CURRENT-T ! ; \ Load Screen for Pre-Compile 10MAR83HHLMeta Compiling is a term to describe the process of regeneratinga Forth system by compiling itself. It is similar in idea to the ordinary notion of compiling in Forth, but has some important differences. First the code that is generated by the Meta Compiler is generally not immediately executable. This maybe for a variety of reasons, such as that the object code generated physically resides at a different address from where it must be to execute correctly. Also, it is possible through Meta Compilation to generate a Forth System for a totally different CPU than the one the Meta Compiler is running on. In such a case, the object code of course is not executable on the Host System. This Screen is the load screen for the Meta Compiler itself. The purpose of this section of the Meta Compiler is to compile Code Words correctly. \ Target System Setup 10MAR83HHL Make Room for HOST definitions Set up the address where Target Compiled Code begins Set up the address where the Target Headers begin Set up the HOST address where Target Image resides Load the Source Screens that define the System Save the System as a CP/M file, ready to be executed \ Vocabulary Helpers 07SEP83HHL META The Meta Compiler Environment, many redefintions DP-T The dictionary Pointer while meta compiling [FORTH] For convenience, an immediate version [META] For convenience, an immediate version SWITCH Exchange the saved values of CONTEXT and CURRENT with themselves. This should be used in pairs, and is only really meaningful in the second occurance. Its purpose is to save and restore the CONTEXT and CURRENT vocabularies. Following the first occurance you should invoke a vocabulary and perhaps DEFINITIONS. \ Memory Access Words 27Jan84mapTARGET-ORIGIN The Offset where the Target Image resides THERE Map a Target address to a Host address C@-T Fetch a byte at the given Target address @-T Fetch a word at the given Target address C!-T Store a byte at the given Target address !-T Store a word at the given Target address HERE-T Target address of next available dictionary byteALLOT-T Allocate more space in the Target dictionary C,-T Add a byte to the Target dictionary ,-T Add a word to the Target dictionary S,-T Add a string to the Target dictionary ALIGN Makes the dictionary even. \ Define Symbol Table Vocabularies 07SEP83HHLTARGET The symbol table for Target definitions TRANSITION Holds special case compiling words, like ." and [ FORWARD Holds all forward references, not neccessary but niceUSER Holds USER version of defining words We add all of the vocabulary names to the ONLY vocabulary so that they are always accessible. This is mainly a convienence during debugging, when something fails and we need to look at different words in various vocabularies to figure out what is going on. Now we are guaranteed that we can reference all of the vocabularies inside META without standing on our heads. \ 68000 Meta Assembler 12Jan84map?>MARK Set up for a forward branch. ?>RESOLVE Resolve a forward branch. ? Run time forward reference for code compiled by ." ." Compile the unknown run time code, followed by the string. <(")> Run time forward reference for code compiled by " " Compile unknown run time code, followed by string. <(ABORT")> Run time forward ref. for code compiled by ABORT" ABORT" Compile the unknown run time code, followed by the string. \ Meta Compiler Transition Words 06SEP83HHL Forward reference for run time of CREATE & VARIABLECREATE Create a target word whose run time is the run time for VARIABLE. Also create a host word to rreturn Target Here addrVARIABLE Make a variable in the Target Image. Forward reference for run time of DEFER DEFER An execution vector in the Target System. \ Meta Compiler Transition Words 06SEP83HHL#USER-T Counts the number of user variables defined so far. ALLOT Allocate space in the USER area. Forward reference for run time of USER vars. VARIABLE Create a User variable, which is task local. Forward reference for run time of USER vectorsDEFER Create a task local execution vector. \ Meta Compiler Transition Words 10MAR83HHLVOC-LINK-T Links defined Vocabularies together. Forward reference for run time of VOCABULARY VOCABULARY Create a target word that behaves like a vocabulary. Only one target vocabulary can contain definitions in this meta compiler, but several can be defined. IMMEDIATE If heads are compiled, flip the Target IMMEDIATE bit. \ Meta Compiler Transition Words 12Jan84map<(;USES)> Forward reference for code compiled by ;USES STATE-T True if compiling inside : def. False if outside. ;USES This is a new syntax that can be used to compile a code field whose code already exists. Similar to ;CODE [COMPILE] Compile a TARGET word rather than execute its TRANSITION counterpart. <(IS)> Forward reference for run time of IS IS Compiles the unknown code field of <(IS)> IS The Meta Version of IS actually does the patch. \ Display an unformatted Symbol Table 10MAR83HHL.SYMBOLS Print a primitive unformatted symbol table on the display. This is very useful if you ever need to debug with DDT, you have no idea where the addresses are. You can make it pretty if you like. \ Meta Compiler Resolve Forward References 10MAR83HHL.UNRESOLVED Display all the words in the FORWARD vocabulary that have not already been resolved. You had better resolve them before saving a system, or else they will surely crash when you execute them. FIND-UNRESOLVED Search for a word in the FORWARD vocabulary and return statusRESOLVE Run through the linked list of forward reference and resolve each of the with the given address. RESOLVES The user interface for resolving forward references. Used as follows: ' resolution-name RESOLVES forward-name \ Interpretive words for Meta 02AUG83HHLH: Save a version of old : for later. Will be redefined. ' How ' should behave during Target Compilation. , How , should behave during Target Compilation. C, How C, should behave during Target Compilation. HERE How HERE should behave during Target Compilation. ALLOT How ALLOT should behave during Target Compilation. DEFINITIONS How DEFINITIONS should behave when interpreted. \ Meta Compiler Resolve Forward References 10MAR83HHL.UNRESOLVED -------------------------------------------------------------------------------- /nsq.exe: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ForthHub/F83/8d1080bb7eb08b3112600539a8db0624c74d536c/nsq.exe -------------------------------------------------------------------------------- /nusq.com: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ForthHub/F83/8d1080bb7eb08b3112600539a8db0624c74d536c/nusq.com -------------------------------------------------------------------------------- /readme.1st: -------------------------------------------------------------------------------- 1 | This disk contains F83.COM, a public domain implementation of FORTH-83 that 2 | is ready to run. It also contains source files in squeezed format. I have 3 | squeezed them using the public domain utility NSQ and you can unsqueeze them 4 | with the NUSQ utility. Squeezed files have a Q in the file type. 5 | 6 | The original Laxen-Perry distribution had these files squeezed with a program 7 | that took hours (!) to run to unsqueeze. AUSQ will run in minutes and the 8 | squeezed files take up less space than the original distribution disk. Make B: 9 | (or C:) your default drive. Have plenty of room on your default drive and then 10 | type A:AUSQ A:filename.BQK to make filename.BLK on your default drive. 11 | 12 | CRCK4 or CRCK is a hash checksum program to help you tell if you have good 13 | copies of the files. Type CRCK4 *.* (or CRCK *.*) and see if what you have 14 | agrees with the values listed below. This should assure you that you have a 15 | good copy of the disk. 16 | 17 | F83.COM is the ready to run FORTH system. 18 | 19 | The MS-DOS version is set up to use the IBM-PC cursor positioning codes. 20 | This won't work on other MS-DOS machines such as the TI Professional. 21 | To fix this, start F83, then type EDITOR DUMB and you can use the editor 22 | commands as though you have a dumb terminal. 23 | 24 | The VIEW word expects certain source blocks to be on drive A: and certain 25 | source files to be on drive B:. If you have a hard disk system, you can 26 | follow the directions in README.PC to recompile your system with all of the 27 | source blocks on your hard disk and the VIEW file numbers will be set up 28 | correctly. 29 | 30 | CRCK ver 4.2B (MS DOS VERSION ) Here are the files on the MS-DOS disk: 31 | CTL-S pauses, CTL-C aborts 32 | 33 | 34 | --> FILE: F83 .COM CRC = D3 3E FORTH system compiled. 35 | --> FILE: README .1ST CRC = This file 36 | --> FILE: NUSQ .COM CRC = DD 00 The unsqueeze program 37 | --> FILE: NSQ .EXE CRC = 23 CA The squeeze program 38 | --> FILE: README .PQ CRC = 2D F6 Original F83 instructions 39 | --> FILE: F83-FIXS.TQT CRC = 24 CD Changes from F83 v.1.0 40 | These "blocks" are the F83 sources squeezed 41 | --> FILE: KERNEL86.BQK CRC = 2B 60 Kernel source 42 | --> FILE: META86 .BQK CRC = 5B BE Metacompiler source 43 | --> FILE: CPU8086 .BQK CRC = 4D 6E 8086 dependent code 44 | --> FILE: EXTEND86.BQK CRC = F5 C0 Extensions source 45 | --> FILE: UTILITY .BQK CRC = ED 3E The UTILITY source 46 | These blocks are applications 47 | --> FILE: HUFFMAN .BQK CRC = 7C B7 A VERY slow compression program 48 | --> FILE: CLOCK .BQK CRC = 47 A2 Source for a calendar example 49 | --> FILE: EXPAND86.BQK CRC = 3F F6 Original source to expand .HUF 50 | --> FILE: BASIC .BQK CRC = 37 E6 A BASIC compiler in FORTH-83 51 | 52 | 53 | Ted Shapin. July 31, 1984. 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 |  -------------------------------------------------------------------------------- /readme.pc: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ForthHub/F83/8d1080bb7eb08b3112600539a8db0624c74d536c/readme.pc --------------------------------------------------------------------------------