QS-Forth Screens#
SCR # 1 0 FORTH DEFINITIONS HEX 1 2 : L-ON 0780 ' CREATE ! ; 3 : L-OFF ' FIRST CFA 4 ' CREATE ! ; DECIMAL 5 : LOCATE ~[COMPILE] ' DUP 6 ~[ FENCE @ ] LITERAL > 7 IF NFA 2 - @ DUP 0= 8 IF 25 MESSAGE 9 ELSE DUP 0 < 10 IF 5 MESSAGE QUIT ELSE LIST 11 ENDIF ENDIF 12 ELSE 9 MESSAGE ENDIF ; 13 14 DECIMAL --> 15 SCR # 2 0 HEX 1 2 : CASE: <BUILDS ] SMUDGE 3 DOES> SWAP 2 * + 4 @ EXECUTE ; 5 6 6 USER S0 ( COMP STK ORG ) 7 8 USER R0 ( RET STK ORG ) 8 9 : UPDATE PREV @ @ 8000 OR PREV 10 @ ! ; 11 12 : DCX DECIMAL ; 13 14 DECIMAL --> 15 SCR # 3 0 ( STACK WORDS ) 1 2 : .S ( PEEK AT STACK ) 3 S0 @ SP@ - 2 / 1 - 4 IF SP@ 2 - S0 @ 2 - 5 DO I @ . -2 +LOOP 6 ELSE ." STACK EMPTY " 7 CR ENDIF ; 8 9 : 2DUP OVER OVER ; 10 11 : LOAD-ED 30 LOAD ; 12 : LOAD-ASM 58 LOAD ; 13 : LOAD-IO 6 LOAD ; 14 DECIMAL --> 15 SCR # 4 0 ( TEXT LINE ) HEX 1 2 : TEXT ( TEXT --> PAD ) 3 HERE C/L 1+ BLANKS WORD HERE 4 PAD C/L 1+ CMOVE ; 5 6 : LINE ( ADR OF LINE-->STK ) 7 DUP FFF0 AND 17 ?ERROR 8 SCR @ (LINE) DROP ; 9 : INVON FF 0668 C! 10 FF 06BE C! ; 11 : INVOF 7F 0668 C! 12 7F 06BE C! ; 13 : BELL 06BE C@ FF 06BE C! 14 FD EMIT 06BE C! ; 15 INVOF DECIMAL --> SCR # 5 0 ( HDUMPER ) HEX 1 : HXOT <# # # #> TYPE ; 2 : HPRT C@ 7F AND DUP 3 20 < IF DROP 2E THEN 4 SPACE 1B EMIT EMIT SPACE ; 5 : ADDR <# # # # # #> TYPE ; 6 : DUMP ( ADDR CNT ) CR 7 HEX 1 - 08 / 1+ 8 0 DO DUP 0 ADDR SPACE 9 8 0 DO DUP I + C@ 0 10 HXOT SPACE LOOP CR 11 4 SPACES 12 8 0 DO DUP I + HPRT LOOP 13 08 + CR LOOP DROP ; 14 : U. 0 <# #S #> TYPE SPACE ; 15 DECIMAL ;S SCR # 6 0 FORTH DEFINITIONS 1 ( CIO CALL CHEATER ) HEX 2 ." I/O MODULE LOADING..." CR 3 CREATE JSRCIO ( CALL TO ) 4 ( CH #6 ) 5 B5 C, 00 C, ( LDA TOS ) 6 86 C, B5 C, ( STX XSAVE ) 7 A2 C, 60 C, ( LDX #$60 ) 8 20 C, C4 C, E4 C, ( JSR ) 9 A6 C, B5 C, ( LDX XSAVE ) 10 E8 C, E8 C, ( CLR STK ) 11 4C C, DF C, 0A C, ( 0A ) 12 13 SMUDGE 14 15 DECIMAL --> SCR # 7 0 ( IOCB CONTSTANTS ) HEX 1 2 60 VARIABLE IO# 3 4 : IO#@ IO# @ + ; 5 6 : CHANID 340 IO#@ ; 7 : CDEV# 341 IO#@ ; 8 : CCMD 342 IO#@ ; 9 : CSTAT 343 IO#@ ; 10 : BUFADR 344 IO#@ ; 11 : BUFLEN 348 IO#@ ; 12 : CAUX1 34A IO#@ ; 13 : CAUX2 34B IO#@ ; 14 15 DECIMAL --> SCR # 8 0 ( IOCB COMMANDS ) HEX 1 2 04 CONSTANT INOP 3 08 CONSTANT OUTOP 4 5 : #-> ( ASSIGNS I0CB # ) 6 10 * DUP IO# ! 7 ' JSRCIO 5 + C! ; 8 9 0 VARIABLE "K" -2 ALLOT 10 4B C, 3A C, 9B C, 11 12 0 VARIABLE "S" -2 ALLOT 13 53 C, 3A C, 9B C, 14 15 DECIMAL --> SCR # 9 0 ( IOCB CONT ) 1 HEX 2 0 VARIABLE "P" -2 ALLOT 3 50 C, 3A C, 9B C, 4 5 0 VARIABLE "C" -2 ALLOT 6 43 C, 3A C, 9B C, 7 8 0 VARIABLE "E" -2 ALLOT 9 45 C, 3A C, 9B C, 10 11 : CKSTAT CSTAT C@ DUP 80 AND 12 IF 7F AND 21 + DUP ?ERROR 13 ELSE DROP ENDIF ; 14 DECIMAL --> 15 SCR # 10 0 ( OPEN IOCB ) 1 HEX 2 ( "K" INOP 0 I0CB# OPEN ) 3 4 : OPEN #-> ( IOCB# ) 5 03 CCMD C! ( OPEN CMD) 6 CAUX2 C! ( 0 USUAL ) 7 CAUX1 C! ( IN/OUT ) 8 BUFADR ! ( -> K: ) 9 JSRCIO ( SET TO 6) 10 CKSTAT ; ( ERROR? ) 11 12 13 DECIMAL --> 14 15 SCR # 11 0 ( GET A CHAR TO STACK ) HEX 1 ( GET ... ASCII TO STACK ) 2 3 : GET #-> 0 ( DUMMY ) 4 07 CCMD C! ( GET CHAR ) 5 0 BUFADR ! ( 0 -> A ) 6 JSRCIO CKSTAT ; 7 8 : PUT #-> 9 0B CCMD C! ( PUT CHAR ) 10 0 BUFADR ! ( 0-> A ) 11 JSRCIO CKSTAT DROP ; 12 HEX 13 : CLOSE #-> 14 0C CCMD C! JSRCIO 15 CKSTAT ; DECIMAL --> SCR # 12 0 ( PRINTER WORDS ) 1 2 : PRON 4 CLOSE 3 "P" OUTOP 0 4 OPEN ; 4 5 : PROF 4 CLOSE 6 "E" OUTOP 0 4 OPEN ; 7 8 --> 9 10 11 12 13 14 15 SCR # 13 0 ( VOL,DIST,FREQ,VOICE, SND ) 1 HEX 2 : SOUND 0232 C@ 07 AND 3 D20F C! 0 D208 C! 4 DUP 3 > IF 5 ." ILLEGAL CHAN" ABORT ENDIF 6 2 * D200 + >R >R 10 * OR 7 EF AND 8 100 * R> OR R> ! ; 9 10 11 : XSND D208 D200 DO 12 0 I C! LOOP ; 13 DECIMAL 14 --> 15 SCR # 14 0 ." GRAPHICS LOADING..." CR 1 ( ALL USE CH # 6 ) 2 : GRN 6 OPEN ; 3 : GR. ( MODE 7 SPLIT ) 4 6 CLOSE >R 5 "S" OUTOP 16 OR R> GRN ; 6 7 : GR.16 6 CLOSE >R "S" 8 OUTOP R> GRN ; HEX 9 10 : SETCOLOR DUP 4 > IF 11 ." ILLEGAL COLOR" 12 . . . ELSE 13 02C4 + >R 10 * OR 14 R> C! ENDIF ; 15 DECIMAL --> SCR # 15 0 ( PLOT DRAWTO ) HEX 1 : CKER CSTAT C@ 8D = IF 2 ." RANGE ERROR " 3 QUIT ELSE CKSTAT ENDIF ; 4 5 : DRAWTO ( Y,X,C ) 02FB C! 6 54 C! 55 ! 6 #-> 7 11 CCMD C! ( DRAW) 8 0 BUFADR ! JSRCIO CKER ; 9 10 : PLOT >R OVER OVER OVER 11 OVER DUP 0= IF 2+ ENDIF 1 - 12 5A C! 5B ! I DRAWTO R> 13 DRAWTO ; 14 DECIMAL --> 15 SCR # 16 0 ( POS. GR." ) HEX 1 : POS. 54 C! 55 ! ; 2 3 : GRTYPE -DUP IF OVER + 4 SWAP DO I C@ 6 #-> 0B 5 CCMD C! 0 BUFADR ! JSRCIO 6 CKER DROP LOOP ELSE 7 DROP ENDIF ; 8 : GR(.") R COUNT DUP 1+ R> 9 + >R GRTYPE ; 10 11 : GR." 22 STATE @ IF COMPILE 12 GR(.") WORD HERE C@ 1+ 13 ALLOT ELSE WORD HERE COUNT 14 GRTYPE ENDIF ; IMMEDIATE 15 DECIMAL ;S SCR # 19 0 (ERROR MESSAGES ) 1 EMPTY STACK 2 DICTIONARY FULL 3 INCORRECT ADDRESS MODE 4 NAME NOT UNIQUE 5 LOCATE OUT OF RANGE 6 DISK OUT OF RANGE 7 FULL STACK 8 DISK ERROR !! 9 IN BOOT 10 11 12 13 14 15 QS FORTH VER 1.0 3/27/81 SCR # 20 0 ( ERROR MESSAGES ) 1 COMPILATION ONLY, USE IN DEF 2 EXECUTION ONLY 3 CONDITIONALS NOT PAIRED 4 INCOMPLETE DEFINITION 5 IN PROTECTED DICTIONARY 6 USE ONLY WHEN LOADING 7 OFF CURRENT EDIT SCREEN 8 9 NOT COMPILED FROM DISK 10 # OPERAND > $FF 11 ILLEGAL USE OF Z-PAGE 12 ILLEGAL ADDR MODE 13 14 15 SCR # 21 0 ( IOCB ERRORS ) 1 BREAK ABORT 2 IOCB OPEN 3 NONEXISTENT DEVICE 4 IOCB WRITE ONLY 5 INVALID COMMAND 6 DEVICE NOT OPEN 7 BAD IOCB # 8 IOCB READ ONLY ERROR 9 EOF 10 TRUNCATED RECORD 11 DEVICE TIMEOUT 12 DEVICE NOT ACKNOWLEDGE CMD 13 SERIAL BUS FRAMING ERROR 14 CURSOR OUT OF RANGE 15 SERIAL BUS FRAME OVERRUN SCR # 22 0 SERIAL CHECKSUM ERROR 1 DEVICE ERROR 2 BAD SCREEN MODE # 3 FUNCTION NOT SUPPORTED 4 SCREEN MODE EXCEEDED MEMORY 5 6 7 8 9 10 11 12 13 14 15 SCR # 23 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 SCR # 24 0 ( SET COLD START ) 1 2 FORTH DEFINITIONS 3 4 5 HEX 6 ' FORTH 4 + @ C +ORIGIN ! 7 HERE 1E +ORIGIN ! 8 VOC-LINK @ 20 +ORIGIN ! 9 HERE 1C +ORIGIN ! ( FENCE) 10 HERE 600 - 80 / 2+ 11 601 C! ( BOOT CNT ) 12 DECIMAL ;S 13 14 15 SCR # 25 0 ( BOOTMAKER ) 1 HEX 2 0 VARIABLE BOOTSTART 3 4 : MAKEBOOT 5 600 BOOTSTART ! 6 HERE BOOTSTART @ - 80 / 2+ 7 1 DO 8 BOOTSTART @ I 0 R/W 9 80 BOOTSTART +! LOOP ; 10 11 12 13 DECIMAL ;S 14 15 SCR # 26 0 ( MEMORY REF POINTER SET ) 1 HEX 2 3 : MEMSET 4 02E5 @ ( FETCH HI LIMIT ) 5 DUP 6 ' LIMIT ! 7 420 - 8 DUP ' FIRST ! 9 DUP USE ! PREV ! 10 COLD ; ;S 11 12 13 14 15 SCR # 30 0 FORTH DEFINITIONS 1 VOCABULARY EDITOR IMMEDIATE 2 ( EDITOR CONT ) HEX 3 : WHERE ( PRINT ERROR ) 4 DUP B/SCR / DUP SCR ! 5 ." SCR # " DECIMAL . SWAP 6 C/L /MOD C/L * ROT BLOCK + 7 CR C/L TYPE CR HERE C@ - 8 SPACES 5E EMIT ~[COMPILE] 9 EDITOR QUIT ; 10 11 EDITOR DEFINITIONS 12 CR ." EDITOR LOADING..." 13 14 --> 15 SCR # 31 0 ( EDITOR CONT ) HEX 1 : -MOVE ( BLOCK ADR->LINE ) 2 LINE C/L CMOVE UPDATE ; 3 4 5 : E ( ERASE LINE ) 6 LINE C/L BLANKS UPDATE ; 7 8 : S DUP 1 - 0E DO I LINE I 9 1+ -MOVE -1 +LOOP E ; 10 : /R PAD 1+ SWAP -MOVE ; 11 --> 12 13 14 15 SCR # 32 0 ( EDITOR CONT ) 1 : CLEAR SCR ! 10 0 DO FORTH 2 I EDITOR E LOOP ; 3 4 : COPY B/SCR * OFFSET @ + 5 SWAP B/SCR * B/SCR OVER 6 + SWAP DO DUP FORTH 7 I BLOCK 2 - ! 1+ UPDATE 8 LOOP DROP FLUSH ; 9 10 : D 0F DUP ROT DO I 1+ LINE 11 I -MOVE LOOP E ; 12 13 14 : P 1 TEXT /R ; 15 --> SCR # 33 0 ( DUPLICATE ) 1 0 VARIABLE EBLK ( ENDING BLK ) 2 0 VARIABLE SBLK ( STARTIN BLK ) 3 0 VARIABLE PSBLK 4 : DISP ( ->DEST ADR IN FRE RAM ) 5 PSBLK @ B/BUF * HERE + ; 6 7 : GTPAR ( SET UP DO AND PSBLK ) 8 EBLK @ SBLK @ 0 PSBLK ! ; 9 10 : MVIN ( MOVE BLKS INTO RAM ) 11 GTPAR DO I BLOCK DISP 12 B/BUF CMOVE 1 PSBLK +! 13 LOOP ; 14 DECIMAL --> 15 SCR # 34 0 : MOVOT ( WRITE RAM TO DISC ) 1 GTPAR OFFSET @ + SWAP OFFSET 2 @ + SWAP DO I BUFFER DISP 3 SWAP B/BUF CMOVE 1 PSBLK +! 4 UPDATE FLUSH LOOP ; 5 6 : DUPLICATE ( STARTSCR ENDSCR ) 7 1+ B/SCR * EBLK ! B/SCR * 8 SBLK ! EBLK @ SBLK @ - 9 ' FIRST 1+ C@ DP 1+ C@ - 10 2 * 2 - > IF ." TOO MANY " 11 QUIT ENDIF CR MVIN 12 ." INSERT DESTINATION DISK 13 " CR ." RETURN TO CONTINUE " 14 KEY DROP CR MOVOT ; 15 DECIMAL --> SCR # 35 0 ( ATARI FORTH EDITOR ) HEX 1 2 0 VARIABLE COL ( USR COL PTR ) 3 0 VARIABLE LIN ( USR LIN PTR ) 4 5 6 : EDLIST ( SPEC LIST FOR ED ) 7 7D EMIT 8 DECIMAL CR DUP SCR ! 9 ." SCR # " . 10 0 DO 10 CR I 3 .R I SCR @ .LINE 11 LOOP CR ; 12 13 14 --> 15 SCR # 36 0 ( ATARI ED OS ACCESS WORDS ) HEX 1 2 : ONCUR 0 02F0 C! ; 3 4 : OFCUR 1 02F0 C! ; 5 6 DECIMAL --> 7 8 9 10 11 12 13 14 15 SCR # 37 0 ( SMOVE ) DECIMAL 1 2 : SMOVE ( SOURCE DEST # TOMV ) 3 CR FLUSH EMPTY-BUFFERS 4 ." CAUTION !!! " CR 5 >R 2DUP SWAP 6 ." MOVE " DUP . ." THRU " R + 7 1 - . ." -->" DUP . ." THRU " 8 R + 1 - . SPACE ." Y OR N" CR 9 R> KEY 89 = IF 10 0 DO OVER I + OVER I + 11 COPY LOOP DROP DROP 12 ELSE QUIT ENDIF ; 13 DECIMAL --> 14 15 SCR # 38 0 ( LFCUR RTCUR ) HEX 1 : (LFCUR) 1E EMIT ; 2 : (RTCUR) 1F EMIT ; 3 DECIMAL 4 : RTCUR OFCUR COL @ 31 = 5 IF 31 0 DO (LFCUR) LOOP 6 0 COL ! ELSE (RTCUR) 7 1 COL +! ENDIF ONCUR ; 8 9 10 : LFCUR OFCUR COL @ 11 IF (LFCUR) -1 COL +! 12 ELSE 31 0 DO (RTCUR) LOOP 13 31 COL ! ENDIF ONCUR ; 14 15 DECIMAL --> SCR # 39 0 ( UPCUR DNCUR ) HEX 1 : (DNCUR) 1D EMIT ; 2 : (UPCUR) 1C EMIT ; 3 4 : DNCUR OFCUR LIN @ 5 F = IF F 0 DO (UPCUR) 6 LOOP 0 LIN ! 7 ELSE (DNCUR) 1 LIN +! 8 ENDIF ONCUR ; 9 10 : UPCUR OFCUR LIN @ 11 IF (UPCUR) -1 LIN +! 12 ELSE F 0 DO (DNCUR) 13 LOOP F LIN ! ENDIF 14 ONCUR ; 15 DECIMAL --> SCR # 40 0 ( HOME CURSOR ) HEX 1 2 : LINCLEAR ( CURSOR->LIN 0 ) 3 LIN @ DUP IF 0 DO UPCUR 4 LOOP ELSE DROP ENDIF ; 5 : COLCLEAR ( CURSOR->COL 0 ) 6 COL @ DUP IF 0 DO LFCUR 7 LOOP ELSE DROP ENDIF ; 8 9 : HOMECUR ( CURSOR->HOME ) 10 LINCLEAR COLCLEAR ; 11 12 13 : CURSHOW (RTCUR) (LFCUR) ; 14 15 --> SCR # 41 0 ( ED CONT EDCR...TAB ) DECIMAL 1 2 : BUFF-> ( BUFFER CHAR ADR ) 3 LIN @ SCR @ (LINE) 4 DROP COL @ + ; 5 6 : EDCR ( SPECIAL CR FOR ED ) 7 COL @ IF COLCLEAR ENDIF 8 DNCUR ; 9 10 5 VARIABLE (TAB) 11 : TAB 31 COL @ - (TAB) @ < 12 IF COLCLEAR ELSE 13 (TAB) @ COL @ OVER MOD - 14 0 DO RTCUR LOOP ENDIF ; 15 DECIMAL --> SCR # 42 0 ( ED CONT EDMIT ) HEX 1 2 : ((EDEMIT)) 3 EMIT (LFCUR) RTCUR 4 COL @ 0= IF DNCUR ENDIF ; 5 6 : TOBUFF ( SENDS CHAR TO LINE ) 7 DUP ( CHAR ) 8 BUFF-> C! ; 9 10 : EDMIT DUP 20 < IF BELL DROP 11 ELSE TOBUFF ((EDEMIT)) 12 ENDIF UPDATE 0 ; 13 DECIMAL --> 14 15 SCR # 43 0 ( LIN PRINT WORDS ) DECIMAL 1 0 VARIABLE TEMP1 2 0 VARIABLE TEMP2 3 4 : PTRSAV COL @ TEMP1 ! 5 LIN @ TEMP2 ! ; 6 7 8 : LINOUT 9 COLCLEAR BUFF-> 32 10 TYPE 32 COL ! COLCLEAR ; 11 12 : CURREST COLCLEAR TEMP1 @ 13 -DUP IF 0 DO RTCUR LOOP 14 ENDIF ; 15 --> SCR # 44 0 HEX 1 2 : REFRESH ( OUTPUT ALL LINS) 3 PTRSAV 4 10 LIN @ DO LINOUT 5 DNCUR LOOP TEMP2 @ 6 -DUP IF 0 DO DNCUR LOOP 7 ENDIF ; 8 9 DECIMAL --> 10 11 12 13 14 15 SCR # 45 0 ( CHAR INSERT WORDS ) 1 2 : MOVRT DUP OVER 1 - C@ 3 SWAP C! 1 - ; 4 5 : XPAND ( SPREAD LIN AT CUR ) 6 PTRSAV ( SAVE POINTERS ) 7 31 COL @ - 8 DUP BUFF-> + SWAP 0 9 DO MOVRT LOOP 10 BL SWAP C! 11 LINOUT CURREST UPDATE ; 12 13 DECIMAL --> 14 15 SCR # 46 0 ( CHAR INSERT WORDS ) 1 2 : MOVLF DUP OVER 1+ C@ 3 SWAP C! 1+ ; 4 5 : CPAND ( SHRINK LIN AT CUR ) 6 PTRSAV ( SAVE POINTERS ) 7 BUFF-> 31 COL @ - 0 8 DO MOVLF LOOP 9 BL SWAP C! ONCUR 10 LINOUT CURREST UPDATE ; 11 12 DECIMAL --> 13 14 15 SCR # 47 0 HEX 1 2 : BKSP COL @ IF LFCUR ENDIF 20 3 EDMIT LFCUR DROP ; 4 : FINI ( WRAP-UP ON ESC ) 5 HOMECUR UPCUR (DNCUR) 6 CR (UPCUR) ; 7 8 : INSL ( SPREAD AT LIN # ) 9 LIN @ S REFRESH ; 10 11 : DELL ( DELETE LINE ) 12 LIN @ D REFRESH ; 13 DECIMAL --> 14 15 SCR # 48 0 ( EDITOR LOOK UP TABLE ) HEX 1 EDITOR DEFINITIONS 2 10 VARIABLE XTABLE 3 1C C, ( UP ) 1D C, ( DN ) 4 1E C, ( LF ) 1F C, ( RT ) 5 7D C, ( HM ) 7E C, ( BS ) 6 0D C, ( CR ) 9D C, ( IL ) 7 9C C, ( DL ) FF C, ( XL ) 8 FE C, ( CL ) 7F C, ( TB ) 9 9F C, ( ST ) 9E C, ( CT ) 10 FD C, ( BL ) DECIMAL 11 : KEYLIT 0 XTABLE @ 0 12 DO DROP DUP I XTABLE 2 13 + + C@ = IF LEAVE ENDIF 14 I LOOP ; 15 DECIMAL --> SCR # 49 0 ( CONTROL WORDS ) 1 2 CASE: CONTROL 3 UPCUR DNCUR LFCUR RTCUR 4 HOMECUR BKSP EDCR INSL 5 DELL XPAND CPAND TAB 6 BELL BELL BELL EDMIT ; 7 8 : +KEY ( LIST BACK ONE ) 9 SCR @ DUP 1 > 10 IF 1 - ENDIF EDLIST ; 11 12 : *KEY SCR @ 1+ EDLIST ; 13 14 --> 15 SCR # 50 0 ( ED MODE CONTROL ) HEX 1 2 : ED (UPCUR) (RTCUR) (RTCUR) 3 (RTCUR) (RTCUR) 4 INVON 5 1 COL ! F LIN ! HOMECUR 6 CURSHOW BEGIN KEY 7 DUP 1B XOR WHILE 8 KEYLIT CONTROL DROP 9 CURSHOW REPEAT FINI 10 INVOF 11 DROP ; 12 DECIMAL --> 13 14 15 SCR # 51 0 ( ED MODE CONTROL ) DECIMAL 1 : 0-> DROP 0 ; 2 : L ( LIST SCREEN,WAIT ) 3 INVON EDLIST 4 BEGIN KEY 5 DUP 27 XOR WHILE 6 DUP 43 = IF +KEY 0-> ENDIF 7 DUP 42 = IF *KEY 0-> ENDIF 8 DUP 45 = IF ED 0-> ENDIF 9 IF BELL ENDIF REPEAT 10 DROP INVOF ; 11 12 FORTH DEFINITIONS 13 : KL ~[COMPILE] EDITOR EDITOR 14 SCR @ L ; DECIMAL --> 15 SCR # 52 0 ( INVERSE ADDR, CNT ) HEX 1 EDITOR DEFINITIONS 2 : INTYPE INVON 0 DO I OVER + 3 C@ 80 OR EMIT LOOP 4 DROP INVOF ; 5 6 : <L> ( T IF BETWEEN L#'S ) 7 DUP SBLK @ < 0= SWAP 8 EBLK @ > 0= AND ; 9 10 : IN.LINE (LINE) INTYPE ; 11 12 DECIMAL --> 13 14 15 SCR # 53 0 ( ATARI FORTH EDITOR ) HEX 1 2 : INVLIST 7D EMIT 3 DECIMAL CR DUP SCR ! 4 ." SCR # " . 10 0 DO 5 CR I 3 .R I SCR @ 6 OVER <L> IF IN.LINE ELSE 7 .LINE ENDIF LOOP CR ; 8 9 0 VARIABLE STBLK 10 0 VARIABLE SBBLK 11 0 VARIABLE SSCR 12 0 VARIABLE DTBLK 13 0 VARIABLE DBBLK 14 0 VARIABLE DSCR 15 DECIMAL --> SCR # 54 0 1 : FROM ( SCR LO HI L# ) 2 15 MIN 3 DUP STBLK ! EBLK ! 4 DUP SBBLK ! SBLK ! DUP 5 SSCR ! INVLIST ; 6 7 : /H LINE PAD 1+ C/L DUP PAD 8 C! CMOVE ; 9 10 : SS->DD 11 STBLK @ 1+ SBBLK @ - 0 12 DO SSCR @ SCR ! I SBBLK @ + 13 /H DSCR @ SCR ! I DBBLK @ + 14 /R LOOP ; 15 DECIMAL --> SCR # 55 0 1 2 3 4 : INTO DUP SBLK ! DBBLK ! 5 DSCR ! STBLK @ SBBLK @ - 6 DBBLK @ + DUP EBLK ! DTBLK ! 7 SS->DD DSCR @ INVLIST 8 CR ." OK? Y/N " KEY 9 89 = IF KL ELSE 10 EMPTY-BUFFERS ENDIF ; 11 12 13 ;S 14 15 SCR # 58 0 ( ATARI ASSMBLER 9/19/80 ) 1 FORTH DEFINITIONS 2 VOCABULARY ASSEMBLER IMMEDIATE 3 ' ASSEMBLER CFA 4 ' ;CODE 8 + ! 5 10 VARIABLE ADRMD 6 : CODE: ?EXEC !CSP 7 10 ADRMD ! CREATE 8 ~[COMPILE] ASSEMBLER ; 9 IMMEDIATE 10 11 : C; CURRENT @ CONTEXT ! 12 ?EXEC ?CSP SMUDGE ; 13 IMMEDIATE 14 CR ." ASSEMBLER LOADING..." 15 --> SCR # 59 0 ( MSC LABELS TO FIG CODE ) 1 2 ASSEMBLER DEFINITIONS 3 4 HEX 5 47 +ORIGIN CONSTANT NEXT 6 3DF +ORIGIN CONSTANT PUSH0A 7 B5 CONSTANT XSAVE 8 9 0 VARIABLE INCLS 10 DECIMAL --> 11 12 13 14 15 SCR # 60 0 --> 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 SCR # 61 0 ( OPCODE TABLE ) HEX 1 0 VARIABLE OPTBL ( FF ILLEGAL ) 2 ( A:) FF C, FF C, FF C, FF C, 3 08 C, FF C, FF C, FF C, 4 ( 16) 0C C, 08 C, 08 C, 08 C, 5 0C C, 0C C, 0C C, 0C C, 6 ( 8A) 04 C, 00 C, 00 C, 00 C, 7 04 C, 04 C, 04 C, 04 C, 8 ( # ) 08 C, FF C, FF C, FF C, 9 FF C, 00 C, 00 C, 00 C, 10 ( 16,X) 1C C, 18 C, FF C, FF C, 11 1C C, FF C, FF C, 1C C, 12 ( 16,Y) 18 C, FF C, FF C, FF C, 13 FF C, FF C, 1C C, FF C, 14 15 DECIMAL --> SCR # 62 0 ( '8,X' ) HEX 1 00 C, FF C, FF C, FF C, 2 FF C, FF C, FF C, FF C, 3 ( '8',Y) 4 10 C, FF C, FF C, FF C, 5 FF C, FF C, FF C, FF C, 6 ( 8,X ) 7 14 C, 10 C, FF C, 10 C, 8 14 C, FF C, FF C, 14 C, 9 ( 8,Y ) 10 FF C, FF C, 10 C, FF C, 11 FF C, FF C, 14 C, FF C, 12 13 14 15 DECIMAL --> SCR # 63 0 ( TABLE FETCH WORDS ) DECIMAL 1 2 : ?TABLE 3 ADRMD @ 8 * 4 INCLS @ + 5 OPTBL 2 + + C@ ; 6 7 HEX 8 : AMDCK ?TABLE 9 DUP FF = 1C ?ERROR ; 10 ( ADR MODE ERROR ) 11 DECIMAL --> 12 13 14 15 SCR # 64 0 HEX 1 : ?HI DUP FF00 AND ; 2 3 DECIMAL 4 : ADRMD! ADRMD ! ; 5 6 : 16/8 ?HI 7 IF ( LONG ADR ) 8 1 9 ELSE ( SHORT ADR ) 10 2 ENDIF ADRMD ! ; 11 12 : #: ?HI 26 ?ERROR 13 3 ADRMD! ; 14 15 : A: 0 ADRMD! ; DECIMAL --> SCR # 65 0 1 : ,X ?HI ( TEST FOR 16/8 ) 2 IF ( 16 ) 3 4 4 ELSE 8 5 ENDIF ADRMD! ; 6 7 8 9 --> 10 11 12 13 14 15 SCR # 66 0 1 : ,Y ?HI 2 IF ( 16 OR 8 ) 3 5 4 ELSE 5 9 6 ENDIF ADRMD! ; 7 8 9 10 --> 11 12 13 14 15 SCR # 67 0 : ,X) 1 ?HI 27 ?ERROR 2 6 ADRMD! ; 3 4 : ),Y ?HI 27 ?ERROR 5 7 ADRMD! ; 6 7 --> 8 9 10 ( 1B IS Z-PAGE ERROR MSG ) 11 12 13 14 15 SCR # 68 0 ( CODE BUILDERS AAA CLASS ) 1 2 : BLDCD INCLS ! ( CLASS ) 3 10 ADRMD @ = 4 IF SWAP 16/8 SWAP ENDIF 5 AMDCK OR C, ( TEST MODE ) 6 ADRMD @ IF ( NOT A: ) 7 ?HI IF , ELSE C, ENDIF 8 ENDIF 10 ADRMD ! ; 9 10 : T3A <BUILDS SWAP C, C, 11 DOES> 12 DUP C@ SWAP 1+ C@ 13 BLDCD ; 14 --> 15 SCR # 69 0 ( OPCODE FOLLIES ) HEX 1 ( AAA CLASS INCLS 0 ) 2 3 61 0 T3A ADC, 21 0 T3A AND, 4 C1 0 T3A CMP, A1 0 T3A LDA, 5 01 0 T3A ORA, E1 0 T3A SBC, 6 81 0 T3A STA, 41 0 T3A EOR, 7 8 ( BB1 CLASS INCLS 1 ) 9 10 C6 1 T3A DEC, E6 1 T3A INC, 11 12 ( BBX CLASS INCLS 2 ) 13 14 86 2 T3A STX, 15 DECIMAL --> SCR # 70 0 ( BBY CLASS 3 INCLS ) HEX 1 2 84 3 T3A STY, 3 4 ( BBB CLASS 4 INCLS ) 5 6 02 4 T3A ASL, 42 4 T3A LSR, 7 22 4 T3A ROL, 62 4 T3A ROR, 8 9 ( CC CLASS 5 INCLS ) 10 11 E0 5 T3A CPX, C0 5 T3A CPY, 12 13 14 15 DECIMAL --> SCR # 71 0 ( DDDX CLASS 6 INCLS ) HEX 1 2 A2 6 T3A LDX, 3 4 ( DDDY CLASS 7 INCLS ) 5 6 A0 7 T3A LDY, 7 8 9 10 11 12 13 DECIMAL --> 14 15 SCR # 72 0 : IMPL <BUILDS C, ( IMPLIED ) 1 DOES> C@ C, ; HEX 2 3 00 IMPL BRK, 18 IMPL CLC, 4 D8 IMPL CLD, 58 IMPL CLI, 5 B8 IMPL CLV, CA IMPL DEX, 6 88 IMPL DEY, E8 IMPL INX, 7 C8 IMPL INY, EA IMPL NOP, 8 48 IMPL PHA, 8A IMPL TXA, 9 98 IMPL TYA, 08 IMPL PHP, 10 68 IMPL PLA, 28 IMPL PLP, 11 40 IMPL RTI, 60 IMPL RTS, 12 38 IMPL SEC, F8 IMPL SED, 13 78 IMPL SEI, AA IMPL TAX, 14 A8 IMPL TAY, BA IMPL TSX, 15 9A IMPL TXS, DECIMAL --> SCR # 73 0 ( REL BRANCH ) DECIMAL 1 2 HEX 3 : RBR <BUILDS C, 4 DOES> C@ C, 3 C, ; 5 6 ( BRANCH AROUND JMP ) 7 8 90 RBR BCC, B0 RBR BCS, 9 F0 RBR BEQ, 30 RBR BMI, 10 D0 RBR BNE, 10 RBR BPL, 11 50 RBR BVC, 70 RBR BVS, 12 DECIMAL --> 13 14 15 SCR # 74 0 ( JMP & BIT ) HEX 1 2 : JMP, 4C C, , ; 3 4 : (JMP), 6C C, , ; 5 6 : JSR, 20 C, , ; 7 8 : BIT, ?HI IF 2C C, , 9 ELSE 24 C, C, 10 ENDIF ; 11 12 13 14 15 DECIMAL -->
