": e  v*`"LL"^*~**H'LI/H˱ʕhʅΈʅiʐLCLI'iH `LJEXECUT`͵LBRANCȀeHȱe˅hLI0BRANCșiʐLG(LOOPѺ hWL(+LOOPѵHH}h}hL(DOKHHHH[LGBDIGI^n800 08 0 < HLBHLB(FINDd oѠQ)?-ȱQ #@ʀie•eÕ•HL@ȱȱªȱ…ÆеѩHL@ENCLOSŔ o8ȱLGLGEMI#KE;D#?TERMINADd#CLp#CMOVZk oLGƑLpUa”Ô666uuuLGU *66866LYAN5H5LBOHLBXO0UHULBSP(FHL@SP>UϪLGRPMeѠϪLG;]yhhLGLEAVrѺLG>҂HHLGRhhLGҲѺHL@0ȔLG0*LGǁuuLGDuuuuLWMINUE8LGDMINU;^8LFOVESuHL@DROlYSWA}HLBDUІHL@+uuLWTOGGLůULWHLBCLG LWC"LWAz?HHiʘe΅LG)AwS1wCONSTANVASAHȱL@VARIABLhAsiHeL@USE҈AseHeL@}}}}B} C/}@FIRS}DžLIMI}@B/BU}B/SC }+ORIGIA-wTI$ WIDT8 WARNINAFENCLDYVOC-LINdBLlDzIzOUԃSCҋOFFSEԔCONTEXԝ CURRENԩ"STATŶ$BAS&DP(FL*CS,R.HL01Aw2AwHERAiwALLOAiw-A%5wC=A% 5wMACw^AbwUjAp'. bwv8PIȔLYAwROԴAwSPACABw-DUAwTRAVERSGAsgswLATESAwLFAgbwCF.AbwNF=Agb-wPFKAgw!CS`ADw?ERROsAOw?COMЄAgw?EXEßAgw?PAIRӶAbgw?CSADbgw?LOADINAgwCOMPILAAwAw-AgwSMUDG;A$g wHEJAgwDECIMA^Ag w(;CODEoA$fCw;CODńA1SwgP#wA* ǾwFILAs  biwERASAwBLANK/AwHOL?A- wPAPA%gwNEXi}GPUSz}@PUԅ}BPUSH0}GPOК}YPOPTWϧ}WBINARٱ}Iо}}}XSAV}U}SETU}oPFLAGFLAWORA !>%g"Hsb% % iw(NUMBERA l, wNUMBEiA g-n-tbg.b\w-FINĶA$% %$w(ABORT AwERRO7AVA%w ? 7"SwIDGAog g_f4sboiogwCREAT~A-%g{Qg7"%I 5ign5g%bg$A%Aw[COMPILEݯACAwLITERAA-AwDLITERA=AGGw?STACYADg{Dg{gwINTERPREvA CAC% dGwIMMEDIATŜA$g@wVOCABULARA-ACA%wAwwFORT0*DEFINITION8AwPROMPJA  wok _wdAg)$wQUIԄA1c_mwABORԑASy3!_wfig-FORTH 1.1e @X`COLļ  v* " F Gϭй ψ˩ƅةlLeS->ACw+FACwD+WA\wABhA\wDABzAnwMIΈAsswMAؗAsswMAss.nwMAs.\G\wAw/MO AMw A wMO* A w*/MO8 Aw*F AN wM/MOZ A%wUSi  PREև  +BUƑ A-n bwUPDATŜ A - wFLUS Abg. I-X!wEMPTY-BUFFER Asb7wDR!AwDR-!A-wBUFFE=!A   -[$ wBLOCO!A b4 X![$bb w(LINE!AN   !w.LIN!A"DwMESSAG"AVg . b#" wMSG # '_wLOA-"ALj  w--i"A s> bwD#E " D#E "`D#E "`JKB V`KEP8qϑȩqϑϵ +# Ѣ` /#LYѢ H BHIh V`ѢBHI VLGILG +# Ѣ` /#LGEXPECԜ"# BHIDµEÆĢ VL#H8mSSeRRΐeUSSeRURT +#ĠLW-DISˆ#$RW   S0LWR/$A - gg$ 'gwU$AGwFORGEԈ$A$Qa{gws{@Xwgbf4{sbiwBAC˜$A%bAwBEGI %A%wENDI%A%sbwTHE,%A4%wDH%AI%wLOOU%A%w+LOOf%A%wUNTI{%A%wENđ%A%wAGAIΧ%A%wREPEAԳ%A%b4%wI%A%AwELS%A%A4%wWHIL%A%wSPACE&A Iw<,&Aow#M&AosbwSIG\&Ag-Wws&Aq g sgg0Ww#Ӌ&A&sswD.Ҳ&AsR&&z&a&sb5&wD&A&w.&AM&w&AM&w 'A'wU'A&wC%'A'wD2'AwD?'Aw2DUT'Assw2DROi'Aw2SWAx'Aw2OVE҈'A'p''wo'Ag~BBBwU'A*'wLIS'Ay_wSCR # 'gI_'b'b#"_wMATC'"( o+ʀ*ƥ¥ðդƩuHuLBINDE(A_ ǍI_b'b#"XwTRIAr(A.  sI_b'_g7"_wVLISԢ(Ag _Gf4XwBOO(%)Dl(FMT)7)! SHLB(SAVE-)A@X$g .%g.%g.wg 7.%g-.bgg. wSAVO)AX))w)ѵ*W   S0$ii  *ݦLYLCSAVş)AX)g *w*ѵ0BJKuD*E V0 BDEѹHI V0 B V0LWCPO*A wPOFv*A wBEEІ*A-I-- -I-- -IwASCIɗ*A$% gRwSAVE gRwTEX+A% H$%o iwLIN)+A--"wMARH+A-IbO+w?EXI`+AXwU.҂+A&wLDMЖ+A-Ib-'wDUMЦ+AsI_b-+b++-_wCDMP+A-IbBwCDUM+AsI_b-+b*,*+-_wDEPT,AD-.b. wSN,AV,)I_wTOP+b'Db *'w Stack Empty_w.WORl,.CLIԴ,}gZBRA,}BRA,}SEMI,}wPLOO,}PPLOO,}PDOT,}wPWOR-AQw1BYT-A-,',w1WOR&-A-,',wNB-A,n -__mXmwBRNC^-A-wto ,,',wSTDž-A--"B,-"B, ,w.LIԭ-}-CKI-A,ns,ns,ns-n-4-nJ-$,n.--n--wDOCO-}AT?PM.A__w Primitive__w?DOCOYu.AbU.b`.mw.SETUx.A$.,wNXT.A,*'5&,,wDECOMа.A.__.c--_wSAVE >**v!tMAR.>*F_/ tEDITO/823WHER9/> `SCR # b& !\-\"_ &**?*B/t#LOCAT/> t#LEAġ/>//t#LAǷ/>/_t-MOV/>/f t/>/ZZft/>/1 t0>_*F_/_/*0t0>/*F_/_/0tF0>\/*?//&tl0>/p0t̐0>'p0tҪ0>Z/tм0>.0t0>"00tTO0>tCLEA0>*F_0tCOP0>pF_!_  t1LIN1>/Z (tFINU1>*Ǿ0Z"f:]1tDELETm1>/_/@/f1 tΜ1>t1p0t1>.1t1>Z@p0t1>G.t1Z1p0tTIL1>/.]1v/_1p0t2>.Z/p_"f"/ff p0tASSEMIBLEL/k8J/CODz2>2<tS/>OOtBRK22CLC22CLD22؄CLI22XCLV22DEX22ʄDEYǬ22INX22INY32ȄNOP32PHA 32HPHP,32PLA832hPLPD32(RTIP32@RTS\32`SECh328DŽSEDt32SEI32xTAX32TSX32TXA32TXS32TYA32ASL.A32 ROL.A32*LSR.A32JROR.A32jNO3>t0 4>t3B4>OO>tJMP#414LJMP()9414lJSRE414 ?ERS4>*vtIF_4>OOO"tTHENp4>"_*f4*f4*tENDIF4>4tIFPL4~40IFMI4~4IFVC4~4pIFVS4~4PIFCC4~4IFCS4~4IFNE 5~4IFEQ5~4BEGIN&5>"tEND35> **O"_*f4OtUNTILB5>I5tDŽMODq5 MODE5>5kt2565>*tMODEFI؝5>5 *5tCKMODŰ5>55tM5>O* 5*5LJ5O5O>* 5tX5>*5t 6>* 5t)16>*5t,A6>*5t,R6>*5tORAc65DŽANDt65 EOR65@ADC65`STA65LDA65CMP65SBC65BIT6>5*$OO *,O>tSTOREAD6>O5O>* 5tZPAG6>p**tXYMOD 7>5*k5*ktM>7>O5*k *(77tASLa7n7ROL7n7.LSR7n7NROR7n7nDEC7n7΄INC7n7OPCOD7>(7G7*tM7>O|75* k*_7tLDY78LDX88CPY(88̄CPX488M@8>O77tSTYL8Y8STX_8Y8SAVE DlSAVE' ' F[Fm( ERROR MESSAGES )@ KStack empty Dictionary full@ RWrong address mode Isn't unique@ KValue error Disk address error@ JStack full Disk Error! ( ERROR MESSAGES )@ WUse only in Definitions Execution only@ WConditionals not paired Definition not finished@ WIn protected dictionary Use only when loading@ ROff current screen Declare VOCABULARY C ( CASSETTE LOAD ) ( LOAD DEBUG )C J21 LOAD @ R( LOAD ASSEMBLER ) 39 LOAD @ B;S C ) DAOL LLUF ( ( LOAD DEBUG )C J21 LOAD @ O( LOAD EDITOR ) 27 LOAD ( LOAD ASSEMBLER )C J39 LOAD @ B;S ( ATARI FORTH DEFS )D NBASE @ HEX C@ E: PONI _1 PFLAG ! ; ( PRT ON ) : POFF 0 PFLAG ! ; ( PRT OFF ) : BEEP 0C0 0 DOC Z08 0D01F C! 6 0 DO LOOP  00 0D01F C! 6 0 DO LOOPC ILOOP ; @ Z: ASCII BL WORD HERE 1+ C@  STATE @ IF COMPILE CLIT C,A RTHEN ; IMMEDIATE @ IBASE ! ;S !( DEBUGGER AIDS -- DUMP , CDUMP ) BASE @ HEX : H. BASE @ HEX DUP U. BASE ! ; $: B? BASE @ DUP DECIMAL . BASE ! ;@ i: FREE 2E5 @ HERE - U. ." bytes" CR ; >--!( DEBUGGER AIDS -- DUMP , CDUMP )D KDECIMAL : ?EXIT ?TERMINALI YIF LEAVE ENDIF ; : U.R 0 SWAP D.R ;@ a: LDMP DUP 8 + SWAP DO I C@ 4 .R C LOOP ;@ d: DUMP OVER + SWAP DO CR I 5 U.R I LDMP ?EXIT 8 +LOOP CR ;@ Y: CDMP DUP 16 + SWAP DO I C@ EMIT LOOP ;A DHEX %: CDUMP OVER + SWAP DO CR I 5 U.R IF bSPACE 1 2FE C! CDMP 0 2FE C!  ?EXIT 10 +LOOP CR ;A LDECIMAL --> ( STACK PRINTER ) HEX %: DEPTH SP@ 12 +ORIGIN @ SWAP - 2 / ;@ Z: S. ( PRINTS THE STACK )  DEPTH -DUP IFF \0 DO CR ." TOP+" I .  SP@ I 2 * + @ U. LOOPC aELSE ." Stack Empty" THEN CR ; @ FBASE ! @ C--> ( DEFINITION TRACER )E OBASE @ HEX 0 VARIABLE .WORD@ Y' CLIT CFA CONSTANT .CLIT ' 0BRANCH CFA CONSTANT ZBRAN@ Z' BRANCH CFA CONSTANT BRAN ' ;S CFA CONSTANT SEMIS@ [' (LOOP) CFA CONSTANT PLOOP ' (+LOOP) CFA CONSTANT PPLOOP@ Y' (.") CFA CONSTANT PDOTQ C: PWORD 2+ NFA ID. ;@ h: 1BYTE PWORD .WORD @ C@ . 1 .WORD +! ; ': 1WORD PWORD .WORD @ @ . 2 .WORD +! ;@ _: NP DUP SEMIS = IF PWORD CR CR  !PROMPT QUIT THEN ?TERMINAL IFE WPROMPT QUIT THEN ;[ ^--> ( DEFINITION TRACER ) 8: BRNCH PWORD ." to " .WORD @ .WORD @ @ + . 2 .WORD +! ; 5: STG PWORD 22 EMIT .WORD @ DUP COUNT TYPE 22 EMITC \C@ .WORD @ + 1+ .WORD ! ; @ W' LIT CFA CONSTANT .LIT @ ^: CKIT DUP ZBRAN = OVER BRAN = ! OR OVER PLOOP = OR OVER PPLOOP =@ [OR IF BRNCH ELSE DUP .LIT = IF 1WORD ELSE DUP .CLIT =A aIF 1BYTE ELSE DUP PDOTQ = IF STG ! ELSE PWORD THEN THEN THEN THEN ;@ C--> ( DEFINITION TRACER )D [' : 12 + CONSTANT DOCOL @ b: T?PR CR CR ." Primitive" CR CR ; : ?DOCOL DUP 2 - @ DOCOL - IFB YT?PR PROMPT QUIT THEN ; @ e: .SETUP [COMPILE] ' ?DOCOL .WORD ! ; @ a: NXT1 .WORD @ U. 2 SPACES .WORD  @ @ 2 .WORD +! ; #: DECOMP .SETUP CR CR BEGIN NXT1 NPF UCKIT CR AGAIN ; C@ FBASE !K M;S ( ** EDITOR ** )  XEH @ ESAB ( THIS EDITOR IS PATTERNED AFTER@ _( THE EXAMPLE EDITOR IN THE fig ( "INSTALLATION MANUAL" 8/80 WFR : TEXT HERE C/L 1+ BLANKS WORDG ^HERE PAD C/L 1+ CMOVE ; @ a: LINE DUP FFF0 AND 17 ?ERROR SCR  @ (LINE) DROP ; : MARK 10 0 DO I LINE UPDATED ODROP LOOP ;W Z--> ( EDITOR )@ [VOCABULARY EDITOR IMMEDIATE 2: WHERE DUP B/SCR / DUP SCR ! ." SCR # " DECIMAL .@ SWAP C/L /MOD C/L * ROT BLOCK + CR C/L -TRAILING TYPE CR HERE =C@ - SPACES 1 2FE C! 1C EMIT 0 2FE C! [COMPILE] EDITOR QUIT ; EDITOR DEFINITIONS : #LOCATE R# @ C/L /MOD ;@ [: #LEAD #LOCATE LINE SWAP ; !: #LAG #LEAD DUP >R + C/L R> - ; @ _: -MOVE LINE C/L CMOVE UPDATE ; @ C--> ( EDITOR )@ ^: H LINE PAD 1+ C/L DUP PAD C! C CMOVE ;@ \: E LINE C/L BLANKS UPDATE ; : S DUP 1 - 0E DO I LINE I 1+D V-MOVE -1 +LOOP E ; : D DUP H 0F DUP ROTD aDO I 1+ LINE I -MOVE LOOP E ; >--  ) ROTIDE (: M R# +! CR SPACE #LEAD TYPEF _17 EMIT #LAG TYPE #LOCATE  . DROP ;@ `: T DUP C/L * R# ! DUP H 0 M ; : L SCR @ LIST 0 M ;@ Y: R PAD 1+ SWAP -MOVE ; : P 1 TEXT R ;@ O: I DUP S R ; : TOP 0 R# ! ; B E--> ) ROTIDE (@ ^: CLEAR SCR ! 10 0 DO FORTH I EDITOR E LOOP ; C : COPY B/SCR * OFFSET @ + SWAPI ]B/SCR * B/SCR OVER + SWAP DO DUP FORTH II ^BLOCK 2 - ! 1+ UPDATE LOOP DROP FLUSH ;B E--> ( EDITOR ) !: 1LINE #LAG PAD COUNT MATCH R#J N+! ; : FIND BEGIN 3FF R# @ < IF TOPI `PAD HERE C/L 1+ CMOVE 0 ERROR ENDIF 1LINE UNTILI J; @ ^: DELETE >R #LAG + FORTH R -  #LAG R MINUS R# +! #LEADG ]+ SWAP CMOVE R> BLANKS  UPDATE ;@ C--> ( EDITOR ) ; M 0 DNIF N : N TXET 1 F :: B PAD C@ MINUS M ; : X 1 TEXT FIND PAD C@ DELETEF K0 M ; C@ `: TILL #LEAD + 1 TEXT 1LINE 0=  0 ?ERROR #LEAD + SWAP -I UDELETE 0 M ; @ C--> ( END OF EDITOR ) : C 1 TEXT PAD COUNT #LAG ROTF _OVER MIN >R FORTH R R# +!  R - >R DUP HERE R CMOVEF ^HERE #LEAD + R> CMOVE R>  CMOVE UPDATE 0 M ; @ YFORTH DEFINITIONS DECIMAL @ SLATEST 12 +ORIGIN ! HERE 28 +ORIGIN !@ QHERE 30 +ORIGIN ! ' EDITOR 6 + 32 +ORIGIN !@ LHERE FENCE !P VBASE !Z \;S F!( DISK COPY ROUTINE 32K RAM )  BASE @ DECIMAL@ V16384 CONSTANT BUFHEAD 0 VARIABLE BLK# 0 VARIABLE ADRS@ W: GET ADRS @ BLK# @ ; : RD +GET DUP 718 = IF LEAVE THEN 1 R/W ;@ m: WRT GET DUP 718 = IF LEAVE THEN 0 R/W ; : +BLK 1 BLK# +! 128 ADRS +! ;@ b: DSETUP BLK# ! BUFHEAD ADRS ! ; &: GKEY ." HIT ANY KEY " KEY CR DROP ;@ p: RDIN CR ." Insert SOURCE disk " GKEY DSETUP 90 0 DO RD +BLK LOOP ;@ u: WRTO CR ." Insert DESTINATION disk " GKEY DSETUP 90 0 DO WRT +BLK LOOP ;@ C--> ( DISK COPY ROUTINE ) ( INSERT SOURCE DISK IN DRIVE #1 ( SIMPLY TYPE "DISKCOPY" ! : MS1 CR CR@ b." SINGLE-DRIVE DISK COPY" CR CR ; : %COPY 0 DO I 90 *M ^DUP DUP RDIN WRTO 90 + . LOOP ;@ `: DISKCOPY CR MS1 CR 8 %COPY ; @ KBASE ! ;S F3( ** ASSEMBLER ** IN FORTH ) ( ASSEMBLER COMFORMS TO THE@ _( fig "INSTALLATION GUIDE" WITH ( THE FOLLOWING EXCEPTIONS: !( SHIFTS ARE: "XXX.A" FOR A-REG.@ I( SHIFTS. ( CONDITIONAL BRANCHES ARE@ a( PATTERNED AFTER THE BRANCH OP- ( CODES: "IFEQ," IS USED IN-@ ^( STEAD OF "0= IF," FOR BETTER ( CLARITY. SEE SCREEN 43. @ C--> ( ASSEMBLER ) VOCABULARY ASSEMBLER IMMEDIATE BASE @ HEX C: CODE [COMPILE] ASSEMBLERH WCREATE SMUDGE ; E@ UASSEMBLER DEFINITIONS @ ]: SB @ C, ;  ( SINGLE BYTE OPERATORS) @ C--> ( ASSEMBLER ) 00 SB BRK, 18 SB CLC, D8 SB CLD,@ `58 SB CLI, B8 SB CLV, CA SB DEX, 88 SB DEY, E8 SB INX, C8 SB INY,@ `EA SB NOP, 48 SB PHA, 08 SB PHP, 68 SB PLA, 28 SB PLP, 40 SB RTI,@ `60 SB RTS, 38 SB SEC, F8 SB SED, 78 SB SEI, A8 SB TAX, BA SB TSX,@ `8A SB TXA, 9A SB TXS, 98 SB TYA, @ [0A SB ASL.A, 2A SB ROL.A, 4A SB LSR.A, 6A SB ROR.A, : NOT 0= ; ( REVERSE LOGICAL )@ ^: 0= 1 ; ( PUSH A TRUE ) --> ( ASSEMBLER ) : 3BY @ C, , ; 4C 3BY JMP, 6C 3BY JMP(),@ K20 3BY JSR, @ F: ?ER5J T5 ?ERROR ; @ _: IF. C@ C, 0 C C, HERE ;@ ]: THEN, DUP HERE SWAP - DUP W 7F > ?ER5 DUP -80 < ?ER5B [SWAP -1 + C! ; IMMEDIATE $: ENDIF, [COMPILE] THEN, ; IMMEDIATE@ C--> ( ASSEMBLER ) 30 IF. IFPL, ( BPL )@ U10 IF. IFMI, ( BMI ) 70 IF. IFVC, ( BVC )@ U50 IF. IFVS, ( BVS ) B0 IF. IFCC, ( BCC )@ U90 IF. IFCS, ( BCS ) F0 IF. IFNE, ( BNE )@ UD0 IF. IFEQ, ( BEQ ) @ [: BEGIN, HERE ; IMMEDIATE : END, IF D0 ELSE F0 THEN C,I VHERE 1+ - DUP  !-80 < ?ER5 C, ; IMMEDIATE@ f: UNTIL, [COMPILE] END, ; IMMEDIATEn q--> ( ASSEMBLER ) 0D VARIABLE MODE ( ABS. MODE ) : MODE= MODE @ = ; ( CK MODE )@ [: 256< DUP 100 ( HEX) < ; : MODEFIX 256< IF -08 MODE +!K QTHEN ;  ( MODE=MODE-8 IF ADR<256 )@ [: CKMODE MODE= IF MODEFIX  THEN ;@ Z: M0 SWAP  0D CKMODE 1D CKMODE SWAPE TC@ MODE @ OR C,X _256< IF C C, ELSE , THEN 0D MODE ! ;A QDECIMAL 46 LOADU W;S iBjDISKNAMEDAT=APX-20029EXTENDED fig-FORTH 1.1PATRICK MULLARKY11/10/811= ( ASSEMBLER )D GHEX !: X) 01 MODE ! ; ( [ADDR,X] )@ a: # 09 MODE ! ; ( IMMEDIATE ) !: )Y 11 MODE ! ; ( [ADDR],Y )@ \: ,X 1D MODE ! ; ( ADDR,X` a) : ,Y 19 MODE ! ; ( ADDR,Y !) @ `00 M0 ORA, 20 M0 AND, 40 M0 EOR, 60 M0 ADC, 80 M0 STA, A0 M0 LDA,@ UC0 M0 CMP, E0 M0 SBC, @ ^: BIT, 256< IF 24 C, C, ELSE 2C C, , THEN ;@ C--> ( ASSEMBLER ) C!: STOREADD C, 256< IF C, ELSE ,L \THEN 0D MODE ! ; {@ G: ZPAGEM aOVER 100 < IF F7 AND THEN ;@ _: XYMODE MODE @ 19 = MODE @ 1D = OR ;@ `: M1 C@ MODE @  1D = IF 10 ELSE 0 THEN ORF VZPAGE STOREADD ; @ `0E M1 ASL, 2E M1 ROL, 4E M1 LSR, 6E M1 ROR, CE M1 DEC, EE M1 INC,@ C--> ( ASSEMBLER ) : OPCODE C@ ZPAGE XYMODE IF 10J SOR THEN ; : M2 OPCODEF \MODE @ 9 = IF 4 - THEN  STOREADD ; AC M2 LDY, AE M2 LDX,@ WCC M2 CPY, EC M2 CPX, @ D: M3H _ OPCODE  STOREADD ; 8C M3 STY, 8E M3 STX,@ C--> ( END OF ASSEMBLER ) FORTH DEFINITIONS @ ]LATEST 0C +ORIGIN ! ( NTOP ) C@ ^HERE 1C +ORIGIN ! ( FENCE ) @ [HERE 1E +ORIGIN ! ( DP ) @ FBASE !L N;S ( COLOR COMMANDS )@ JBASE @ HEX !: SETCOLOR 2 * SWAP 10 * OR SWAPJ `02C4 ( COLPF0 ) + C! ; : SE. SETCOLOR ; ( ALIAS ) ( REGISTER#-3, COLOR-2, LUM-1 ( 0-3 0-F 0-7 -->  ( GRAPHICS COMMANDS )@ QE456 CONSTANT CIO  1C VARIABLE MASKA R340 CONSTANT IOCX  53 VARIABLE SNAME CODE GR. 1 # LDA, GFLAG STA,I SXSAVE STX,W `0 ,X LDA, # 30 LDX, IOCX 0B + ,X STA,@ Z# 3 LDA, IOCX 2 + ,X STA, C SNAME FF AND # LDA, IOCX 4 + ,XA ZSTA, SNAME 100 / # LDA, IOCX 5 + ,X STA, MASK LDA,@ QIOCX 0A + ,X STA,U ]CIO JSR, XSAVE LDX, 0 # LDY, POP JMP,@ C--> ( GRAPHICS COMMANDS ) CODE &GR !XSAVE STX, # 30 LDX,M _# C LDA, IOCX 2 + ,X STA, CIO JSR,M `XSAVE LDX, 0 # LDA, !GFLAG STA, NEXT JMP, : XGR &GR 0 GR. &GR ;B X( EXIT GRAPHICS MODE ) @ C--> ) O/I SCIHPARG (CODE CPUT 0 ,X LDA, PHA,B WXSAVE STX, # 30 LDX, ! # B LDA, IOCX 2 + ,X STA, TYA,B ^IOCX 8 + ,X STA, IOCX 9 + ,X ! STA, PLA, CIO JSR, XSAVE LDX,B JPOP JMP, @ R54 CONSTANT ROWCRS 55 CONSTANT COLCRS : POS ROWCRS C! COLCRS ! ;@ S: PLOT POS CPUT ; C@ C--> ( GRAPHICS I/O ) : GTYPE -DUP IF OVER + SWAPH ^DO I C@ CPUT LOOP ELSE  DROP ENDIF ; : (G") R COUNT DUP 1+ R> + >RH OGTYPE ; @ `: G" 22 STATE @ IF COMPILE (G")  WORD HERE C@ 1+ ALLOTE _ELSE WORD HERE COUNT GTYPE  ENDIF ; IMMEDIATE @ C--> ( DRAW, FIL ) 2FB CONSTANT ATACHR@ S2FD CONSTANT FILDAT @ ICODE GCOMM aXSAVE STX, 0 ,X LDA,  # 30 LDX, IOCX 2 + ,X STA,C `CIO JSR, XSAVE LDX, POP JMP, @ `: DRAW POS ATACHR C! 11 GCOM ; @ [: FIL FILDAT C! 12 GCOM ; S; ! ESAB( SOUND COMMANDS )D NBASE @ HEX C@ TD208 CONSTANT AUDCTL D200 CONSTANT AUDBASE ": SOUND ( CH# FREQ DIST VOL --- )B W3 DUP 0D20F C! 232 C! ! SWAP 16 * + ROT DUP + AUDBASE +D WROT OVER C! 1+ C! ; @ V: FILTER! AUDCTL C! ; ( N --- ) @ IBASE ! ;S ( GRAPHICS TESTS ) !: BOX 0 10 10 PLOT 1 50 10 DRAWG a1 50 25 DRAW 1 10 25 DRAW  1 10 10 DRAW ; : FBOX XGR 5 GR. BOXF X10 25 POS 2 FIL ; ( DOS OBJECT READER ) BASE @ HEX 60 VARIABLE BLOCK# 0 VARIABLE BYTES 0 VARIABLE BYTPTR@ d0 VARIABLE ADDRSS 0 VARIABLE #BYTES C0: GETCOUNT 7F + C@ 7F AND BYTES ! 0 BYTPTR ! ;@ x: FNEXTBLK 7D + DUP C@ 100 * SWAP 1+ C@ + 3FF AND 1 - ; : LINKBLOCK FNEXTBLKB fDUP BLOCK# ! DUP 0 > IF BLOCK THEN ; 0: BLK-CK BYTES @ 0= IF BLOCK# @ BLOCK LINKBLOCKB QGETCOUNT THEN ; 3: NEXTBYTE BLK-CK -1 BYTES +! BYTPTR @ 1 BYTPTR +!@ UBLOCK# @ BLOCK + C@ ; ': NEXTWORD NEXTBYTE NEXTBYTE 100 * + ;@ C--> ( DOS OBJECT READER ) ?: ADRCALC NEXTWORD DUP ADDRSS ! NEXTWORD SWAP - 1+ #BYTES ! ; ): BLOCKSET DUP BLOCK# ! BLOCK GETCOUNT ; =: LOADOBJ BLOCKSET NEXTWORD 1+ IF CR ." Not an Object file"A MCR QUIT THEN  BEGINI PADRCALC  ;#BYTES @ 0 DO NEXTBYTE ADDRSS @ C! 1 ADDRSS +! LOOPH _BLOCK# @ BLOCK FNEXTBLK  1+ 0= BYTES @ 0= AND END ; @ IBASE ! ;S ( FLOATING POINT WORDS )A LBASE @ HEX : FDROP DROP DROP DROP ;@ F: FDUPJ ^>R >R DUP R> DUP ROT SWAP R ROT ROT R> ;@ JCODE FSWAP  XSAVE STX, # 6 LDY,@ `BEGIN, 0 ,X LDA, PHA, INX, DEY, 0= END, XSAVE LDX, # 6 LDY,@ `BEGIN, 6 ,X LDA, 0 ,X STA, INX, C!DEY, 0= END, XSAVE LDX, # 6 LDY,A aBEGIN, PLA, 0B ,X STA, DEX, DEY, 0= END, XSAVE LDX, NEXT JMP, XSAVE 100 * 86 + CONSTANT XSAV@ Q: XS, XSAV , ;X [--> ( FLOATING POINT WORDS )@ JCODE FOVERO ]DEX, DEX, DEX,  DEX, DEX, DEX, XSAVE STX,A ]# 6 LDY, BEGIN, 0C ,X LDA,  0 ,X STA, INX, DEY, 0= END,A VXSAVE LDX, NEXT JMP, @ ]XSAVE 100 * A6 + CONSTANT XLD : XL, XLD , ; &CODE AFP XS, D800 JSR, XL, NEXT JMP,@ fCODE FASC XS, D8E6 JSR, XL, NEXT JMP, &CODE IFP XS, D9AA JSR, XL, NEXT JMP,* ---> ( FLOATING POINT WORDS ) &CODE FPI XS, D9D2 JSR, XL, NEXT JMP,@ fCODE FADD XS, DA66 JSR, XL, NEXT JMP, &CODE FSUB XS, DA60 JSR, XL, NEXT JMP,@ fCODE FMUL XS, DADB JSR, XL, NEXT JMP, &CODE FDIV XS, DB28 JSR, XL, NEXT JMP,@ eCODE FLG XS, DECD JSR, XL, NEXT JMP, &CODE FLG10 XS, DED1 JSR, XL, NEXT JMP,@ eCODE FEX XS, DDC0 JSR, XL, NEXT JMP, &CODE FEX10 XS, DDCC JSR, XL, NEXT JMP,@ fCODE FPOLY XS, DD40 JSR, XL, NEXT JMP, E -->  ( FLOATING POINT WORDS ) D4 CONSTANT FR0@ OE0 CONSTANT FR1 FC CONSTANT FLPTR@ QF3 CONSTANT INBUF F2 CONSTANT CIX  >-- ( FLOATING POINT ) : F@ >R R @ R 2+ @ R> 4 + @ ;@ ]: F! >R R 4 + ! R 2+ ! R> ! ; @ \: F.TY BEGIN INBUF @ C@ DUP  7F AND EMIT 1 INBUF +!G S80 > UNTIL ; : F. FR0 F@ FSWAP FR0 F! FASCD WF.TY SPACE FR0 F! ; : F? F@ F. ; A >-- ( FLOATING POINT ) : FR0 F@ ; : FS FR0 F! ; : F+ ;@ S: F- ; : F* ;@ S: F/ ; : FLOAT FR0 ! IFP F> ;@ V: FIX FS FPI FR0 @ ; : FLOG FS FLG F> ;@ V: FLOG10 FS FLG10 F> ; : FEXP FS FEX F> ;@ [: FEXP10 FS FEX10 F> ; --> ( FLOATING POINT ) : ASCF 0 CIX ! INBUF ! AFP F> ; : FLIT R> DUP 6 + >R F@ ;@ U: FLITERAL STATE @ IF  COMPILE FLIT HERE F! 6 ALLOTB IENDIF ; (: FLOATING ( FLOAT FOLLOWING CONSTANT )C WBL WORD HERE 1+ ASCF  FLITERAL ; IMMEDIATE@ X( EX: FLOATING 1.2345 ) ( OR FLOATING -1.67E-13 ) : FP [COMPILE] FLOATING ;@ IIMMEDIATEN Q--> ( FLOATING POINT ) C : FVARIABLEA ` ; @ K: FCONSTANT  B FF@ ; @ R: F0= OR OR 0= ; : F= F- F0= ;@ D: F ; @ JBASE ! ;S ( FORTH INC.'S EDITOR ) W( This editor was written by S.H. Daniel, in FORTH DIMENSIONS, ( Volume III, number 3. C"( visibility. P. Mullarky 9/29/81 --->  ( FORTH INC.'S EDITOR ) BASE @ FORTH DEFINITIONS HEX 6: TEXT HERE C/L 1+ BLANKS WORD HERE PAD C/L 1+ CMOVE ;@ q: LINE DUP FFF0 AND 17 ?ERROR SCR @ (LINE) DROP ; VOCABULARY EDITOR IMMEDIATE@ w: WHERE DUP B/SCR / DUP SCR ! ." SCR # " DECIMAL . SWAP RC/L /MOD C/L * ROT BLOCK + CR C/L TYPE [COMPILE] EDITOR QUIT ; EDITOR DEFINITIONS : #LOCATE R# @ C/L /MOD ;@ [: #LEAD #LOCATE LINE SWAP ; : #LAG #LEAD DUP >R + C/L R> - ;@ _: -MOVE LINE C/L CMOVE UPDATE ; a: BUF-MOVE PAD 1+ C@ IF PAD SWAP C/L 1+ CMOVE ELSE DROP THEN ; : >LINE# #LOCATE SWAP DROP ; --> ( FORTH INC.'S EDITOR ) : FIND-BUF PAD 50 + ;@ \: INSERT-BUF FIND-BUF 50 + ; 9: (HOLD) LINE INSERT-BUF 1+ C/L DUP INSERT-BUF C! CMOVE ;@ a: (KILL) LINE C/L BLANKS UPDATE ; 3: (SPREAD) >LINE# DUP 1 - E DO I LINE I 1+ -MOVE -1@ N+LOOP (KILL) ; 4: X >LINE# DUP (HOLD) F DUP ROT DO I 1+ LINE I -MOVE@ MLOOP (KILL) ; C6: DISPLAY-CURSOR CR SPACE #LEAD TYPE A0 EMIT #LAG TYPE@ P#LOCATE . DROP ; ?!: T C/L * R# ! 0 DISPLAY-CURSOR ;@ P: L SCR @ LIST ; : N 1 SCR +! ;@ O: B -1 SCR +! ;U X--> ( FORTH INC.'S EDITOR ) : (TOP) 0 R# ! ;@ : SEEK-ERROR (TOP) FIND-BUF HERE C/L 1+ CMOVE HERE COUNT TYPE ." None" QUIT ;@ g: (R) >LINE# INSERT-BUF 1+ SWAP -MOVE ; %: P 5E TEXT INSERT-BUF BUF-MOVE (R) ;@ ^: WIPE 10 0 DO I (KILL) LOOP ; o: COPY B/SCR * OFFSET @ + SWAP B/SCR * B/SCR OVER + SWAP DO DUP FORTH I BLOCK 2 - ! 1+ UPDATE LOOP DROP FLUSH ; ): 1LINE #LAG FIND-BUF COUNT MATCH R# +! ;@ z: (SEEK) BEGIN 3FF R# @ < IF SEEK-ERROR THEN 1LINE UNTIL ; 8: (DELETE) >R #LAG + R - #LAG R MINUS R# +! #LEAD + SWAP@ XCMOVE R> BLANKS UPDATE ; (: (F) 5E TEXT FIND-BUF BUF-MOVE (SEEK) ;@ ^: F (F) DISPLAY-CURSOR ; --> ( FORTH INC.'S EDITOR )@ \: (E) FIND-BUF C@ (DELETE) ; : E (E) DISPLAY-CURSOR ;@ K: D (F) E ; 4: TILL #LEAD + 5E TEXT FIND-BUF BUF-MOVE 1LINE 0= IF@ xSEEK-ERROR THEN #LEAD + SWAP - (DELETE) DISPLAY-CURSOR ; 0 VARIABLE COUNTER@ w: BUMP 1 COUNTER 1+ COUNTER @ 38 > IF 0 COUNTER ! CR CR F MESSAGE C EMIT THEN ;@ z: S C EMIT 5E TEXT 0 COUNTER ! FIND-BUF BUF-MOVE SCR @ DUP <>R DO I SCR ! (TOP) BEGIN 1LINE IF DISPLAY-CURSOR SCR ? BUMP@ eTHEN 3FF R# @ < UNTIL LOOP R> SCR ! ; 9: I 5E TEXT INSERT-BUF BUF-MOVE INSERT-BUF COUNT #LAG ROT@ {OVER MIN >R R R# +! R - >R DUP HERE R CMOVE HERE #LEAD + R> CCMOVE R> CMOVE UPDATE@ PDISPLAY-CURSOR ;U X--> Q( FORTH INC.'S EDITOR ) : U C/L R# +! (SPREAD) P ;@ K: R (E) I ; 9: M SCR @ >R R# @ >R >LINE# (HOLD) SWAP SCR ! 1+ C/L * R#@ c(SPREAD) (R) R> C/L + R# R> SCR ! ; DECIMAL@ SLATEST 12 +ORIGIN ! HERE 28 +ORIGIN !@ QHERE 30 +ORIGIN ! ' EDITOR 6 + 32 +ORIGIN !@ LHERE FENCE ! #FORTH DEFINITIONS BASE ! FORTH ;S ( RAGSDALE ASSEMBLER ) ;( This assembler was published in Dr. Dobbs Journal V.6 N.9F S( Sept. '81 ) @( ... and is the assembler used in the fig "Installation Guide." >-- ( RAGSDALE ASSEMBLER )@ VOCABULARY ASSEMBLER IMMEDIATE ASSEMBLER DEFINITIONS BASE @ HEX C@ |0 VARIABLE INDEX -2 ALLOT 0909 , 1505 , 0115 , 8011 , 8009 , c71D0D , 8019 , 8080 , 0080 , 1404 , 8014 , 8080 , 8080 ,@ T1C0C , 801C , 2C80 , 2 VARIABLE MODE : .A 0 MODE ! ; : # 1 MODE ! ; : MEM 2 MODE ! ; : ,X 3 MODE ! ; : ,Y 4 MODE ! ; : X) 5 MODE ! ; : )Y 6 MODE ! ; 7: ) F MODE ! ; : BOT ,X 0 ; : SEC ,X 2 ; : RP) ,X 101 ;@ r: UPMODE IF MODE @ 8 AND 0= IF 8 MODE +! THEN THEN b1 MODE @ F AND -DUP IF 0 DO DUP + LOOP THEN OVER 1+ @ AND 0= ; : CPU C@ C, MEM ; ;00 CPU BRK, 18 CPU CLC, D8 CPU CLD, 58 CPU CLI, B8 CPU CLV,@ {CA CPU DEX, 88 CPU DEY, E8 CPU INX, C8 CPU INY, EA CPU NOP, ;48 CPU PHA, 08 CPU PHP, 68 CPU PLA, 28 CPU PLP, 40 CPU RTI,@ 60 CPU RTS, 38 CPU SEC, F8 CPU SED, 78 CPU SEI, AA CPU TAX, --> ( RAGSDALE ASSEMBLER )@ {A8 CPU TAY, BA CPU TSX, 8A CPU TXA, 9A CPU TXS, 98 CPU TYA, ;: MCP DUP 1+ @ 80 AND IF 10 MODE +! THEN@ OVER FF00 AND UPMODE UPMODE IF MEM CR LATEST ID. 3 ERROR THEN \C@ MODE C@ INDEX + C@ + C, MODE C@ 7 AND IF MODE C@ F AND 7 < IF C, ELSE , THEN THEN MEM ; 21C6E 60 MCP ADC, 1C6E 20 MCP AND, 1C6E C0 MCP CMP,@ r1C6E 40 MCP EOR, 1C6E A0 MCP LDA, 1C6E 00 MCP ORA, 21C6E E0 MCP SBC, 1C6C 80 MCP STA, 0D0D 01 MCP ASL,@ r0C0C C1 MCP DEC, 0C0C E1 MCP INC, 0D0D 41 MCP LSR, 20D0D 21 MCP ROL, 0D0D 61 MCP ROR, 0414 81 MCP STX,@ r0486 E0 MCP CPX, 0486 C0 MCP CPY, 1496 A2 MCP LDX, 20C8E A0 MCP LDY, 048C 80 MCP STY, 0480 14 MCP JSR,@ a8480 40 MCP JMP, 0484 20 MCP BIT, : BEGIN, HERE 1 ; IMMEDIATE@ : UNTIL, ?EXEC >R 1 ?PAIRS R> C, HERE 1+ - C, ; IMMEDIATE --> ( RAGSDALE ASSEMBLER )@ `: IF, C, HERE 0 C, 2 ; IMMEDIATE :: THEN, ?EXEC 2 ?PAIRS HERE OVER C@ IF SWAP ! ELSE OVER 1+@ [- SWAP C! THEN ; IMMEDIATE ;: ELSE, 2 ?PAIRS HERE 1+ 1 JMP, SWAP HERE OVER 1+ - SWAP C!@ N2 ; IMMEDIATE C : NOT 20 + ;@ {90 CONSTANT CS D0 CONSTANT 0= 10 CONSTANT 0< 90 CONSTANT >= u@ : END-CODE CURRENT @ CONTEXT ! ?EXEC ?CSP SMUDGE ; IMMEDIATE FORTH DEFINITIONS DECIMAL@ |: CODE ?EXEC CREATE [COMPILE] ASSEMBLER ASSEMBLER MEM !CSP ; IMMEDIATE@ q' ASSEMBLER CFA ' ;CODE 8 + ! LATEST 12 +ORIGIN ! 0HERE 28 +ORIGIN ! HERE 30 +ORIGIN ! HERE FENCE !@ \' ASSEMBLER 6 + 32 +ORIGIN !a pBASE ! FORTH ;S ) NEERCS TSET (123 456 XXX 789 123 F ( DOS I/O )@ JBASE @ HEX 6340 VARIABLE IOCB 0 VARIABLE IO.X 0 VARIABLE IO.CH@ p: IOCC 10 * 70 MIN DUP IO.X C! 340 + IOCB ! ; $: @ IOCB @ + ;@ v2 ICCOM 3 ICSTA 4 ICBAL 8 ICBLL 6A ICAX1 B ICAX2 C ICAX3 D ICAX4@ ZE ICAX5 F ICAX6 @ tCODE XCIO XSAVE STX, IO.X LDX, IO.CH LDA, E456 JSR, &XSAVE LDX, IO.CH STA, TYA, PUSH0A JMP, 9: OPEN IOCC ICAX2 C! ICAX1 C! ICBAL ! 03 ICCOM C! XCIO ;@ `: CLOSE IOCC 0C ICCOM C! XCIO ; (: PUTC IOCC IO.CH C! 0B ICCOM C! XCIO ;@ r: GETC IOCC 7 ICCOM C! XCIO IO.CH C@ SWAP ; --> ( DOS I/O )@ p: GETREC IOCC 5 ICCOM C! ICBLL ! ICBAL ! XCIO ; 0: PUTREC IOCC 9 ICCOM C! ICBLL ! ICBAL ! XCIO ;@ Y: STATUS IOCC ICSTA C@ ; 4: DEVSTAT IOCC 0D ICCOM C! XCIO >R 2EA @ 2EC @ R> ;@ {: SPECIAL IOCC ICCOM C! ICAX6 C! ICAX5 C! ICAX4 C! ICAX3 C! ICAX2 C! ICAX1 C! XCIO ;@ t: FORMAT CR CR ." Input Drive # " KEY DUP EMIT 30 - 1 MAX 4 MIN@ CR CR ." When you hit RETURN I'm going to" CR ." FORMAT Drive " 5DUP . CR CR ." Hit any other key to abort " BEEP KEY@ |9B = IF (FMT) 1 = CR CR ." Format " IF ." OK" ELSE ." ERROR" THEN ELSE DROP THEN CR CR ;@ IBASE ! ;S C ( ATARI-850 DOWNLOAD )@ JBASE @ HEX CODE DO-SIOB aXSAVE STX, 0 # LDA, E459 JSR,  XSAVE LDX, NEXT JMP,@ : SET-DCB 50 300 C! 1 301 C! 3F 302 C! 40 303 C! 500 304 ! 2 5 306 C! 0 307 C! C 308 C! 0 309 ! 0 30B C! ;