4  `p ! mL0BjDEHIJ `0BlDE0HI ɛ )`K @BÝDEHIJK `@l BlDE@HIl ) `E ` C B   `ЩM`` LLJLZ^)~uuLI/H毱ʕhiLLCLI'lH <Х ҥ | jf   Y  v :  Ѧ` :   `    ȱ  `` ĥ`EXECUTc$LBRANC<eHȱehLI0BRANC1[iLG(LOOPO| hhhhLc(+LOOPq膵HH}h}hL(DOHHHHLGb DIGI 800 08 0  HLBHLB(FIND7  Q)?-ȱQ #ieeHL@ȱȱȱеHL@ENCLOS,  8ȱŦLGŦLGEMIԑ KE ?TERMINA C $CMOV   ĦƧLGL U ( 666uuuLGU! `  *66866ƦLANY 5H5LBOҕ HLBXOҫ UHULBSP HL@SP LGRP LG;  hhLGLEAV $ LG> ? HHLGR8 Q hhLGJ b HL@0\ x ȔLG0q *LG uuLGD uuuuLMINUӰ 8LGDMINU 8L OVE HL@DRO SWA ' HLBDU ? HL@+7 N uuLTOGGLG o ULd ~ HLBCx LG LC L E[| N 9HHieLG m  CONSTAN 9HȱL@VARIABL  iHeL@USE#  eHeL@@  \  d  l  Bt  C/|  FIRSԅ  LIMIԏ  B/BUƛ  B/SCҧ  +ORIGIγ -  TI¿ M WIDT M WARNIN M FENC M D M VOC-LIN M BLM IM OUM SC&M OFFSE/M CONTEX8M CURRENDM "STATQM $BAS^M &DPiM (FLsM *CS|M ,RM .HLĎM 01 h  2 p  HERŬ |  ALLOԹ L    p  C  h     v  U   $8PIȔL % " RO; = % O %  SPACG  -DUY = Y=  TRAVERSi % j "Y%   LATES| [| |  LF j CF p  NF j- PF h j  !CS   ?ERRO % Y:  ?COM  f| v j ?EXE& f| j ?PAIR= j ?CSR | j ?LOADINf | v j COMPIL~ .O = = |  ۘ ` f  ݴ jf  SMUDG j m  HE jp  DECIMA j p  (;CODE O   ;COD  m, A =  +~ Y  D+ Y  ABӠ =  DABӲ =  MI ?Y%   MA "Y%   M = % & O  M = = ` ^ O ` % O %   &   /MOC = O ! O V%   MOb V  */MOp = O ! *~ %   M/MOĒ = ` ` ^ O % = ^ O  USš4 PREֿ4 +BU - = Y = |  UPDAT | | - | EMPTY-BUFFER ) DR rA  DR6 -A  BUFFEF | = = Y ` | Y` ` | - ` ` `  O  BLOCX A| = | = | ` = Y4v Y ` a= ` h p = | ` = v Y=  O   FLUSȡ  j f` -a z (LINE = O G   .LIN. 7 MESSAGQ | YpYj"A| fY: MSG # ` LOAc | = #| = ` # G #O # O   -- ` # | vL  8qȩq L CL L )L LG-DIS8  S䦵)L 㦵ĕL-BC. ` j ^ jG  R/m Y -R@:-W- = -f= - - -G-  6-    v `   FORGE = | j= | ` Y| =  := j| = ` Y p  | pv YO   BAC  BEGIX .h  ENDIi .p [ %  THE{  Dϗ x  LOOФ x [z_ +LOOе x [_ UNTI h [Y_ EN  AGAI h [:_ REPEA = = O O p  I Y` p  ELS5 p [:` % p p  WHILJ : SPACEk ` pY ` az <{ a  #   | a  SIGΫ M Yj-I  p| Mj "Yj j0 I #  v Y D. = % O  D ` a .< = O  K A \ | ` LISh  = 5 SCR # `j`  x Pa5| Yz  INDEt - %  x Pa` Y Y" z  TRIAĵ - x fx Gx %  {z -m  VLIS -, N| | ,| -?Y ` , = a| = v Y  BOOTSTAR)4 MAKEBOOw - | -fh | ` -L z MAKEBOOT :{:- m  FORTH DEFINITIONS HEX : L-ON 0780 ' CREATE ! ; : L-OFF ' FIRST CFA ' CREATE ! ; DECIMAL : LOCATE [COMPILE] ' DUP [ FENCE @ ] LITERAL > IF NFA 2 - @ DUP 0= IF 25 MESSAGE ELSE DUP 0 < IF 5 MESSAGE QUIT ELSE LIST ENDIF ENDIF ELSE 9 MESSAGE ENDIF ; DECIMAL --> HEX : CASE: SWAP 2 * + @ EXECUTE ; 6 USER S0 ( COMP STK ORG ) 8 USER R0 ( RET STK ORG ) : UPDATE PREV @ @ 8000 OR PREV @ ! ; : DCX DECIMAL ; DECIMAL --> ( STACK WORDS ) : .S ( PEEK AT STACK ) S0 @ SP@ - 2 / 1 - IF SP@ 2 - S0 @ 2 - DO I @ . -2 +LOOP ELSE ." STACK EMPTY " CR ENDIF ; : 2DUP OVER OVER ; : LOAD-ED 30 LOAD ; : LOAD-ASM 58 LOAD ; : LOAD-IO 6 LOAD ; DECIMAL --> ( TEXT LINE ) HEX : TEXT ( TEXT --> PAD ) HERE C/L 1+ BLANKS WORD HERE PAD C/L 1+ CMOVE ; : LINE ( ADR OF LINE-->STK ) DUP FFF0 AND 17 ?ERROR SCR @ (LINE) DROP ; : INVON FF 0668 C! FF 06BE C! ; : INVOF 7F 0668 C! 7F 06BE C! ; : BELL 06BE C@ FF 06BE C! FD EMIT 06BE C! ; INVOF DECIMAL --> ( HDUMPER ) HEX : HXOT <# # # #> TYPE ; : HPRT C@ 7F AND DUP 20 < IF DROP 2E THEN SPACE 1B EMIT EMIT SPACE ; : ADDR <# # # # # #> TYPE ; : DUMP ( ADDR CNT ) CR HEX 1 - 08 / 1+ 0 DO DUP 0 ADDR SPACE 8 0 DO DUP I + C@ 0 HXOT SPACE LOOP CR 4 SPACES 8 0 DO DUP I + HPRT LOOP 08 + CR LOOP DROP ; : U. 0 <# #S #> TYPE SPACE ; DECIMAL ;S FORTH DEFINITIONS ( CIO CALL CHEATER ) HEX ." I/O MODULE LOADING..." CR CREATE JSRCIO ( CALL TO ) ( CH #6 ) B5 C, 00 C, ( LDA TOS ) 86 C, B5 C, ( STX XSAVE ) A2 C, 60 C, ( LDX #$60 ) 20 C, C4 C, E4 C, ( JSR ) A6 C, B5 C, ( LDX XSAVE ) E8 C, E8 C, ( CLR STK ) 4C C, DF C, 0A C, ( 0A ) SMUDGE DECIMAL --> ( IOCB CONTSTANTS ) HEX 60 VARIABLE IO# : IO#@ IO# @ + ; : CHANID 340 IO#@ ; : CDEV# 341 IO#@ ; : CCMD 342 IO#@ ; : CSTAT 343 IO#@ ; : BUFADR 344 IO#@ ; : BUFLEN 348 IO#@ ; : CAUX1 34A IO#@ ; : CAUX2 34B IO#@ ; DECIMAL --> ( IOCB COMMANDS ) HEX 04 CONSTANT INOP 08 CONSTANT OUTOP : #-> ( ASSIGNS I0CB # ) 10 * DUP IO# ! ' JSRCIO 5 + C! ; 0 VARIABLE "K" -2 ALLOT 4B C, 3A C, 9B C, 0 VARIABLE "S" -2 ALLOT 53 C, 3A C, 9B C, DECIMAL --> ( IOCB CONT ) HEX 0 VARIABLE "P" -2 ALLOT 50 C, 3A C, 9B C, 0 VARIABLE "C" -2 ALLOT 43 C, 3A C, 9B C, 0 VARIABLE "E" -2 ALLOT 45 C, 3A C, 9B C, : CKSTAT CSTAT C@ DUP 80 AND IF 7F AND 21 + DUP ?ERROR ELSE DROP ENDIF ; DECIMAL --> ( OPEN IOCB ) HEX ( "K" INOP 0 I0CB# OPEN ) : OPEN #-> ( IOCB# ) 03 CCMD C! ( OPEN CMD) CAUX2 C! ( 0 USUAL ) CAUX1 C! ( IN/OUT ) BUFADR ! ( -> K: ) JSRCIO ( SET TO 6) CKSTAT ; ( ERROR? ) DECIMAL --> ( GET A CHAR TO STACK ) HEX ( GET ... ASCII TO STACK ) : GET #-> 0 ( DUMMY ) 07 CCMD C! ( GET CHAR ) 0 BUFADR ! ( 0 -> A ) JSRCIO CKSTAT ; : PUT #-> 0B CCMD C! ( PUT CHAR ) 0 BUFADR ! ( 0-> A ) JSRCIO CKSTAT DROP ; HEX : CLOSE #-> 0C CCMD C! JSRCIO CKSTAT ; DECIMAL --> ( PRINTER WORDS ) : PRON 4 CLOSE "P" OUTOP 0 4 OPEN ; : PROF 4 CLOSE "E" OUTOP 0 4 OPEN ; --> ( VOL,DIST,FREQ,VOICE, SND ) HEX : SOUND 0232 C@ 07 AND D20F C! 0 D208 C! DUP 3 > IF ." ILLEGAL CHAN" ABORT ENDIF 2 * D200 + >R >R 10 * OR EF AND 100 * R> OR R> ! ; : XSND D208 D200 DO 0 I C! LOOP ; DECIMAL --> ." GRAPHICS LOADING..." CR ( ALL USE CH # 6 ) : GRN 6 OPEN ; : GR. ( MODE 7 SPLIT ) 6 CLOSE >R "S" OUTOP 16 OR R> GRN ; : GR.16 6 CLOSE >R "S" OUTOP R> GRN ; HEX : SETCOLOR DUP 4 > IF ." ILLEGAL COLOR" . . . ELSE 02C4 + >R 10 * OR R> C! ENDIF ; DECIMAL --> ( PLOT DRAWTO ) HEX : CKER CSTAT C@ 8D = IF ." RANGE ERROR " QUIT ELSE CKSTAT ENDIF ; : DRAWTO ( Y,X,C ) 02FB C! 54 C! 55 ! 6 #-> 11 CCMD C! ( DRAW) 0 BUFADR ! JSRCIO CKER ; : PLOT >R OVER OVER OVER OVER DUP 0= IF 2+ ENDIF 1 - 5A C! 5B ! I DRAWTO R> DRAWTO ; DECIMAL --> ( POS. GR." ) HEX : POS. 54 C! 55 ! ; : GRTYPE -DUP IF OVER + SWAP DO I C@ 6 #-> 0B CCMD C! 0 BUFADR ! JSRCIO CKER DROP LOOP ELSE DROP ENDIF ; : GR(.") R COUNT DUP 1+ R> + >R GRTYPE ; : GR." 22 STATE @ IF COMPILE GR(.") WORD HERE C@ 1+ ALLOT ELSE WORD HERE COUNT GRTYPE ENDIF ; IMMEDIATE DECIMAL ;S (ERROR MESSAGES ) EMPTY STACK DICTIONARY FULL INCORRECT ADDRESS MODE NAME NOT UNIQUE LOCATE OUT OF RANGE DISK OUT OF RANGE FULL STACK DISK ERROR !! IN BOOT QS FORTH VER 1.0 3/27/81 ( ERROR MESSAGES ) COMPILATION ONLY, USE IN DEF EXECUTION ONLY CONDITIONALS NOT PAIRED INCOMPLETE DEFINITION IN PROTECTED DICTIONARY USE ONLY WHEN LOADING OFF CURRENT EDIT SCREEN NOT COMPILED FROM DISK # OPERAND > $FF ILLEGAL USE OF Z-PAGE ILLEGAL ADDR MODE ( IOCB ERRORS ) BREAK ABORT IOCB OPEN NONEXISTENT DEVICE IOCB WRITE ONLY INVALID COMMAND DEVICE NOT OPEN BAD IOCB # IOCB READ ONLY ERROR EOF TRUNCATED RECORD DEVICE TIMEOUT DEVICE NOT ACKNOWLEDGE CMD SERIAL BUS FRAMING ERROR CURSOR OUT OF RANGE SERIAL BUS FRAME OVERRUN SERIAL CHECKSUM ERROR DEVICE ERROR BAD SCREEN MODE # FUNCTION NOT SUPPORTED SCREEN MODE EXCEEDED MEMORY ( SET COLD START ) FORTH DEFINITIONS HEX ' FORTH 4 + @ C +ORIGIN ! HERE 1E +ORIGIN ! VOC-LINK @ 20 +ORIGIN ! HERE 1C +ORIGIN ! ( FENCE) HERE 600 - 80 / 2+ 601 C! ( BOOT CNT ) DECIMAL ;S ( BOOTMAKER ) HEX 0 VARIABLE BOOTSTART : MAKEBOOT 600 BOOTSTART ! HERE BOOTSTART @ - 80 / 2+ 1 DO BOOTSTART @ I 0 R/W 80 BOOTSTART +! LOOP ; DECIMAL ;S ( MEMORY REF POINTER SET ) HEX : MEMSET 02E5 @ ( FETCH HI LIMIT ) DUP ' LIMIT ! 420 - DUP ' FIRST ! DUP USE ! PREV ! COLD ; ;S FORTH DEFINITIONS VOCABULARY EDITOR IMMEDIATE ( EDITOR CONT ) HEX : WHERE ( PRINT ERROR ) DUP B/SCR / DUP SCR ! ." SCR # " DECIMAL . SWAP C/L /MOD C/L * ROT BLOCK + CR C/L TYPE CR HERE C@ - SPACES 5E EMIT [COMPILE] EDITOR QUIT ; EDITOR DEFINITIONS CR ." EDITOR LOADING..." --> ( EDITOR CONT ) HEX : -MOVE ( BLOCK ADR->LINE ) LINE C/L CMOVE UPDATE ; : E ( ERASE LINE ) LINE C/L BLANKS UPDATE ; : S DUP 1 - 0E DO I LINE I 1+ -MOVE -1 +LOOP E ; : /R PAD 1+ SWAP -MOVE ; --> ( EDITOR CONT ) : CLEAR SCR ! 10 0 DO FORTH I EDITOR E LOOP ; : COPY B/SCR * OFFSET @ + SWAP B/SCR * B/SCR OVER + SWAP DO DUP FORTH I BLOCK 2 - ! 1+ UPDATE LOOP DROP FLUSH ; : D 0F DUP ROT DO I 1+ LINE I -MOVE LOOP E ; : P 1 TEXT /R ; --> ( DUPLICATE ) 0 VARIABLE EBLK ( ENDING BLK ) 0 VARIABLE SBLK ( STARTIN BLK )0 VARIABLE PSBLK : DISP ( ->DEST ADR IN FRE RAM ) PSBLK @ B/BUF * HERE + ; : GTPAR ( SET UP DO AND PSBLK ) EBLK @ SBLK @ 0 PSBLK ! ; : MVIN ( MOVE BLKS INTO RAM ) GTPAR DO I BLOCK DISP B/BUF CMOVE 1 PSBLK +! LOOP ; DECIMAL --> : MOVOT ( WRITE RAM TO DISC ) GTPAR OFFSET @ + SWAP OFFSET @ + SWAP DO I BUFFER DISP SWAP B/BUF CMOVE 1 PSBLK +! UPDATE FLUSH LOOP ; : DUPLICATE ( STARTSCR ENDSCR ) 1+ B/SCR * EBLK ! B/SCR * SBLK ! EBLK @ SBLK @ - ' FIRST 1+ C@ DP 1+ C@ - 2 * 2 - > IF ." TOO MANY " QUIT ENDIF CR MVIN ." INSERT DESTINATION DISK " CR ." RETURN TO CONTINUE " KEY DROP CR MOVOT ; DECIMAL --> ( ATARI FORTH EDITOR ) HEX 0 VARIABLE COL ( USR COL PTR ) 0 VARIABLE LIN ( USR LIN PTR ) : EDLIST ( SPEC LIST FOR ED ) 7D EMIT DECIMAL CR DUP SCR ! ." SCR # " . 10 0 DO CR I 3 .R I SCR @ .LINE LOOP CR ; --> ( ATARI ED OS ACCESS WORDS ) HEX : ONCUR 0 02F0 C! ; : OFCUR 1 02F0 C! ; DECIMAL --> ( SMOVE ) DECIMAL : SMOVE ( SOURCE DEST # TOMV ) CR FLUSH EMPTY-BUFFERS ." CAUTION !!! " CR >R 2DUP SWAP ." MOVE " DUP . ." THRU " R + 1 - . ." -->" DUP . ." THRU " R + 1 - . SPACE ." Y OR N" CR R> KEY 89 = IF 0 DO OVER I + OVER I + COPY LOOP DROP DROP ELSE QUIT ENDIF ; DECIMAL --> ( LFCUR RTCUR ) HEX : (LFCUR) 1E EMIT ; : (RTCUR) 1F EMIT ; DECIMAL : RTCUR OFCUR COL @ 31 = IF 31 0 DO (LFCUR) LOOP 0 COL ! ELSE (RTCUR) 1 COL +! ENDIF ONCUR ; : LFCUR OFCUR COL @ IF (LFCUR) -1 COL +! ELSE 31 0 DO (RTCUR) LOOP 31 COL ! ENDIF ONCUR ; DECIMAL --> ( UPCUR DNCUR ) HEX : (DNCUR) 1D EMIT ; : (UPCUR) 1C EMIT ; : DNCUR OFCUR LIN @ F = IF F 0 DO (UPCUR) LOOP 0 LIN ! ELSE (DNCUR) 1 LIN +! ENDIF ONCUR ; : UPCUR OFCUR LIN @ IF (UPCUR) -1 LIN +! ELSE F 0 DO (DNCUR) LOOP F LIN ! ENDIF ONCUR ; DECIMAL --> ( HOME CURSOR ) HEX : LINCLEAR ( CURSOR->LIN 0 ) LIN @ DUP IF 0 DO UPCUR LOOP ELSE DROP ENDIF ; : COLCLEAR ( CURSOR->COL 0 ) COL @ DUP IF 0 DO LFCUR LOOP ELSE DROP ENDIF ; : HOMECUR ( CURSOR->HOME ) LINCLEAR COLCLEAR ; : CURSHOW (RTCUR) (LFCUR) ; --> ( ED CONT EDCR...TAB ) DECIMAL : BUFF-> ( BUFFER CHAR ADR ) LIN @ SCR @ (LINE) DROP COL @ + ; : EDCR ( SPECIAL CR FOR ED ) COL @ IF COLCLEAR ENDIF DNCUR ; 5 VARIABLE (TAB) : TAB 31 COL @ - (TAB) @ < IF COLCLEAR ELSE (TAB) @ COL @ OVER MOD - 0 DO RTCUR LOOP ENDIF ; DECIMAL --> ( ED CONT EDMIT ) HEX : ((EDEMIT)) EMIT (LFCUR) RTCUR COL @ 0= IF DNCUR ENDIF ; : TOBUFF ( SENDS CHAR TO LINE ) DUP ( CHAR ) BUFF-> C! ; : EDMIT DUP 20 < IF BELL DROP ELSE TOBUFF ((EDEMIT)) ENDIF UPDATE 0 ; DECIMAL --> ( LIN PRINT WORDS ) DECIMAL 0 VARIABLE TEMP1 0 VARIABLE TEMP2 : PTRSAV COL @ TEMP1 ! LIN @ TEMP2 ! ; : LINOUT COLCLEAR BUFF-> 32 TYPE 32 COL ! COLCLEAR ; : CURREST COLCLEAR TEMP1 @ -DUP IF 0 DO RTCUR LOOP ENDIF ; --> HEX : REFRESH ( OUTPUT ALL LINS) PTRSAV 10 LIN @ DO LINOUT DNCUR LOOP TEMP2 @ -DUP IF 0 DO DNCUR LOOP ENDIF ; DECIMAL --> ( CHAR INSERT WORDS ) : MOVRT DUP OVER 1 - C@ SWAP C! 1 - ; : XPAND ( SPREAD LIN AT CUR ) PTRSAV ( SAVE POINTERS ) 31 COL @ - DUP BUFF-> + SWAP 0 DO MOVRT LOOP BL SWAP C! LINOUT CURREST UPDATE ; DECIMAL --> ( CHAR INSERT WORDS ) : MOVLF DUP OVER 1+ C@ SWAP C! 1+ ; : CPAND ( SHRINK LIN AT CUR ) PTRSAV ( SAVE POINTERS ) BUFF-> 31 COL @ - 0 DO MOVLF LOOP BL SWAP C! ONCUR LINOUT CURREST UPDATE ; DECIMAL --> HEX : BKSP COL @ IF LFCUR ENDIF 20 EDMIT LFCUR DROP ; : FINI ( WRAP-UP ON ESC ) HOMECUR UPCUR (DNCUR) CR (UPCUR) ; : INSL ( SPREAD AT LIN # ) LIN @ S REFRESH ; : DELL ( DELETE LINE ) LIN @ D REFRESH ; DECIMAL --> ( EDITOR LOOK UP TABLE ) HEX EDITOR DEFINITIONS 10 VARIABLE XTABLE 1C C, ( UP ) 1D C, ( DN ) 1E C, ( LF ) 1F C, ( RT ) 7D C, ( HM ) 7E C, ( BS ) 0D C, ( CR ) 9D C, ( IL ) 9C C, ( DL ) FF C, ( XL ) FE C, ( CL ) 7F C, ( TB ) 9F C, ( ST ) 9E C, ( CT ) FD C, ( BL ) DECIMAL : KEYLIT 0 XTABLE @ 0 DO DROP DUP I XTABLE 2 + + C@ = IF LEAVE ENDIF I LOOP ; DECIMAL --> ( CONTROL WORDS ) CASE: CONTROL UPCUR DNCUR LFCUR RTCUR HOMECUR BKSP EDCR INSL DELL XPAND CPAND TAB BELL BELL BELL EDMIT ; : +KEY ( LIST BACK ONE ) SCR @ DUP 1 > IF 1 - ENDIF EDLIST ; : *KEY SCR @ 1+ EDLIST ; --> ( ED MODE CONTROL ) HEX : ED (UPCUR) (RTCUR) (RTCUR) (RTCUR) (RTCUR) INVON 1 COL ! F LIN ! HOMECUR CURSHOW BEGIN KEY DUP 1B XOR WHILE KEYLIT CONTROL DROP CURSHOW REPEAT FINI INVOF DROP ; DECIMAL --> ( ED MODE CONTROL ) DECIMAL : 0-> DROP 0 ; : L ( LIST SCREEN,WAIT ) INVON EDLIST BEGIN KEY DUP 27 XOR WHILE DUP 43 = IF +KEY 0-> ENDIF DUP 42 = IF *KEY 0-> ENDIF DUP 45 = IF ED 0-> ENDIF IF BELL ENDIF REPEAT DROP INVOF ; FORTH DEFINITIONS : KL [COMPILE] EDITOR EDITOR SCR @ L ; DECIMAL --> ( INVERSE ADDR, CNT ) HEX EDITOR DEFINITIONS : INTYPE INVON 0 DO I OVER + C@ 80 OR EMIT LOOP DROP INVOF ; : ( T IF BETWEEN L#'S ) DUP SBLK @ < 0= SWAP EBLK @ > 0= AND ; : IN.LINE (LINE) INTYPE ; DECIMAL --> ( ATARI FORTH EDITOR ) HEX : INVLIST 7D EMIT DECIMAL CR DUP SCR ! ." SCR # " . 10 0 DO CR I 3 .R I SCR @ OVER IF IN.LINE ELSE .LINE ENDIF LOOP CR ; 0 VARIABLE STBLK 0 VARIABLE SBBLK 0 VARIABLE SSCR 0 VARIABLE DTBLK 0 VARIABLE DBBLK 0 VARIABLE DSCR DECIMAL --> : FROM ( SCR LO HI L# ) 15 MIN DUP STBLK ! EBLK ! DUP SBBLK ! SBLK ! DUP SSCR ! INVLIST ; : /H LINE PAD 1+ C/L DUP PAD C! CMOVE ; : SS->DD STBLK @ 1+ SBBLK @ - 0 DO SSCR @ SCR ! I SBBLK @ + /H DSCR @ SCR ! I DBBLK @ + /R LOOP ; DECIMAL --> : INTO DUP SBLK ! DBBLK ! DSCR ! STBLK @ SBBLK @ - DBBLK @ + DUP EBLK ! DTBLK ! SS->DD DSCR @ INVLIST CR ." OK? Y/N " KEY 89 = IF KL ELSE EMPTY-BUFFERS ENDIF ; ;S ( ATARI ASSMBLER 9/19/80 ) FORTH DEFINITIONS VOCABULARY ASSEMBLER IMMEDIATE ' ASSEMBLER CFA ' ;CODE 8 + ! 10 VARIABLE ADRMD : CODE: ?EXEC !CSP 10 ADRMD ! CREATE [COMPILE] ASSEMBLER ; IMMEDIATE : C; CURRENT @ CONTEXT ! ?EXEC ?CSP SMUDGE ; IMMEDIATE CR ." ASSEMBLER LOADING..." --> ( MSC LABELS TO FIG CODE ) ASSEMBLER DEFINITIONS HEX 47 +ORIGIN CONSTANT NEXT 3DF +ORIGIN CONSTANT PUSH0A B5 CONSTANT XSAVE 0 VARIABLE INCLS DECIMAL --> --> ( OPCODE TABLE ) HEX 0 VARIABLE OPTBL ( FF ILLEGAL )( A:) FF C, FF C, FF C, FF C, 08 C, FF C, FF C, FF C, ( 16) 0C C, 08 C, 08 C, 08 C, 0C C, 0C C, 0C C, 0C C, ( 8A) 04 C, 00 C, 00 C, 00 C, 04 C, 04 C, 04 C, 04 C, ( # ) 08 C, FF C, FF C, FF C, FF C, 00 C, 00 C, 00 C, ( 16,X) 1C C, 18 C, FF C, FF C, 1C C, FF C, FF C, 1C C, ( 16,Y) 18 C, FF C, FF C, FF C, FF C, FF C, 1C C, FF C, DECIMAL --> ( '8,X' ) HEX 00 C, FF C, FF C, FF C, FF C, FF C, FF C, FF C, ( '8',Y) 10 C, FF C, FF C, FF C, FF C, FF C, FF C, FF C, ( 8,X ) 14 C, 10 C, FF C, 10 C, 14 C, FF C, FF C, 14 C, ( 8,Y ) FF C, FF C, 10 C, FF C, FF C, FF C, 14 C, FF C, DECIMAL --> ( TABLE FETCH WORDS ) DECIMAL : ?TABLE ADRMD @ 8 * INCLS @ + OPTBL 2 + + C@ ; HEX : AMDCK ?TABLE DUP FF = 1C ?ERROR ; ( ADR MODE ERROR ) DECIMAL --> HEX : ?HI DUP FF00 AND ; DECIMAL : ADRMD! ADRMD ! ; : 16/8 ?HI IF ( LONG ADR ) 1 ELSE ( SHORT ADR ) 2 ENDIF ADRMD ! ; : #: ?HI 26 ?ERROR 3 ADRMD! ; : A: 0 ADRMD! ; DECIMAL --> : ,X ?HI ( TEST FOR 16/8 ) IF ( 16 ) 4 ELSE 8 ENDIF ADRMD! ; --> : ,Y ?HI IF ( 16 OR 8 ) 5 ELSE 9 ENDIF ADRMD! ; --> : ,X) ?HI 27 ?ERROR 6 ADRMD! ; : ),Y ?HI 27 ?ERROR 7 ADRMD! ; --> ( 1B IS Z-PAGE ERROR MSG ) ( CODE BUILDERS AAA CLASS ) : BLDCD INCLS ! ( CLASS ) 10 ADRMD @ = IF SWAP 16/8 SWAP ENDIF AMDCK OR C, ( TEST MODE ) ADRMD @ IF ( NOT A: ) ?HI IF , ELSE C, ENDIF ENDIF 10 ADRMD ! ; : T3A DUP C@ SWAP 1+ C@ BLDCD ; --> ( OPCODE FOLLIES ) HEX ( AAA CLASS INCLS 0 ) 61 0 T3A ADC, 21 0 T3A AND, C1 0 T3A CMP, A1 0 T3A LDA, 01 0 T3A ORA, E1 0 T3A SBC, 81 0 T3A STA, 41 0 T3A EOR, ( BB1 CLASS INCLS 1 ) C6 1 T3A DEC, E6 1 T3A INC, ( BBX CLASS INCLS 2 ) 86 2 T3A STX, DECIMAL --> ( BBY CLASS 3 INCLS ) HEX 84 3 T3A STY, ( BBB CLASS 4 INCLS ) 02 4 T3A ASL, 42 4 T3A LSR, 22 4 T3A ROL, 62 4 T3A ROR, ( CC CLASS 5 INCLS ) E0 5 T3A CPX, C0 5 T3A CPY, DECIMAL --> ( DDDX CLASS 6 INCLS ) HEX A2 6 T3A LDX, ( DDDY CLASS 7 INCLS ) A0 7 T3A LDY, DECIMAL --> : IMPL C@ C, ; HEX 00 IMPL BRK, 18 IMPL CLC, D8 IMPL CLD, 58 IMPL CLI, B8 IMPL CLV, CA IMPL DEX, 88 IMPL DEY, E8 IMPL INX, C8 IMPL INY, EA IMPL NOP, 48 IMPL PHA, 8A IMPL TXA, 98 IMPL TYA, 08 IMPL PHP, 68 IMPL PLA, 28 IMPL PLP, 40 IMPL RTI, 60 IMPL RTS, 38 IMPL SEC, F8 IMPL SED, 78 IMPL SEI, AA IMPL TAX, A8 IMPL TAY, BA IMPL TSX, 9A IMPL TXS, DECIMAL --> ( REL BRANCH ) DECIMAL HEX : RBR C@ C, 3 C, ; ( BRANCH AROUND JMP ) 90 RBR BCC, B0 RBR BCS, F0 RBR BEQ, 30 RBR BMI, D0 RBR BNE, 10 RBR BPL, 50 RBR BVC, 70 RBR BVS, DECIMAL --> ( JMP & BIT ) HEX : JMP, 4C C, , ; : (JMP), 6C C, , ; : JSR, 20 C, , ; : BIT, ?HI IF 2C C, , ELSE 24 C, C, ENDIF ; DECIMAL --> ( CONTROL STRUCTURES ) HEX : BEGIN, HERE ; : UNTIL, JMP, ; : WHILE, HERE 1 + 0 JMP, ; : REPEAT, HERE 3 + SWAP ! JMP, ; : IF, WHILE, ; : ELSE, WHILE, HERE ROT ! ; : ENDIF, HERE SWAP ! ; DECIMAL ;S