~2L 𩓍ЩЍЩR     S `I0ݭ  4`3BULL)22)1119211v2Y(LI: HʕhiLm H `EXECUTŐ LBRANCȨ eHȱehLT 0BRANC iLR (LOOP  hhhhL (+LOOPHH}h}hL(DOOHHHHLR % nHLK 4 DIGIԇ80HLM  LLHLM H(FIND s Q)?/ȱQ %ieeHLK ȱеHLK ENCLOS$ s 88LR LR D8Up666uuuuLR CMOV s LR LU666uuuLR U" *66866L]dAN_5H5LM OtHLM XOҊUHULM SPHLK SPLR jRPLR ;hhLR iLEAVLR >RHHLR RhhLR %HLK 0;ȔLR 60P*LR UbHLhHLh~PIHLhHLhuuLR zDuuuuL[]MINU8LR DMINU8LoOVE HLK DRO]SWA'HLM DU?HLK +NuuL[9TOGGLoUL[K~HLM ICLR YL[CL[!i%s|f?9HHieLR CONSTAN? 9HȱLK VARIABL 9iHeLK USE 9eHeLK zkB sC/ #LINK"FIRSfLIMI {B/BUB/SC[HIME+ORIGI8 TIJ WIDTJ WARNINJFENCJD VOC-LINJBLJcIJOUUSCJ?OFFSEJICONTEXJ ^CURRENJ"kSTATJ$.BASJ&DPJ( FLJ*xCSJ,RJ.HLJ07INPJ2PHYSOFJ41e2mHER|ALLOTLmCe?+-9%|RO%%SPAC~"7-DU= = TRAVERSŏuuL]LATES]]Ms|fk |  ` % aCFm-CNFu-8 PFeuLFm-!CSR?ERRO%  1?COM~|9k 8L?EXE~|k 8c?PAIR-k 8x?CS|-k 8?LOADIN2|9k 8COMPILR=| ]~qk ~SMUDGk mHEk DECIMAk  (;CODE;COD9) >#EXPEC] %M"=9 f]f  QUER|k x?]:2| *e2L]:2|e-]9 i  FIL s LR 8ERAS]OBLANK~HOL8 L|PAk DWOR2|v  |:|%"k ":L -#97BITӋ s )LR ((NUMBER=| &|n]| eL NUMBE]]S=k -9=8 =~- =k .-]8]  HASe-]==m-FIN~>f|C=9 f|s|- s|C>(ABORT~cERRO|N # ? !2|v :|%NoID,k k _= -,%,k ]=,=k ]%#gCREAT|k `m8] i k !g=|Tk 9=k me-k ms| Cm-  |%m-m 8OMPILEi9]8 qLITERA~| 8 DLITERA~| %?STACk |%`e8k |`k 8INTERPREi ~||     |   CIMMEDIATk @mVOCABULARg)| )]Ms|fk m 8  wfFORTȃ11;223Z33DEFINITIONf|sk )>QUI]2"uM~|9  oK IABOR"fig-FORTH 1.4S]8 .NCOLIJ# " #     ةlLS->=N+N "D+N xAB=!DAB=%MI  E %PMA  | %hM  7%7%M F#7 #%%/MO%MO*/MO*%M/MO]# % <PTA1  ALLOT-V @PRE1G3AL1L"EMPTY-BUFFERl|k b|M]fk k ADR]Yk DR8 Yk BFN]%l|k b|M=f|9 fk  %f%k BUFFE==9 l|#|#|#k =b|- '=k - k k -=b|9  b|k b|=b| - 5b|k k ] b||b||]O$]b|k b|b|| BLOCY|=b||-b|k 9r 8& =b|k 9 b||eO$eb|k   b|m|](LINE .LINd!e8 #]8 rMESSAG| Kv A=k E k -m k Y|-k @ k @# MSG # <(LOA2|:|]:2M:2!--]:2| -2LhICCBa"ICLHl"ICAD "TCIO֊" VHLK KE|"k f"eq"" ~=k 9 ]?"EMIe#"Ck "?TERMINA]"TYPv k f"q"|"" ~  #DECMAD#&*&   ee8 (iiLR "SIύ# YLR #SECI8 8 k ]m9 k @ k 8 k 8 k 18 ]#v k !;#DIk 8 #8 |k 8 #DDI8 8 #8 |8 8  R/ k R k W8 %8 ]8  =u]8 %k %=k ] E8 k r8 k ] ] 8 %k ]M=B#$  Dk ] mk ]M='$ "|k k ]M=$ !FLUSl|k b|Mfk k ] f|f|]O$efk k "UPDATk b|k "i9]8&%FORGEs|f|-k 8%=|`k 8)|# ` .|=) ]M=mfk =m|=l` % |v9 m-K$BAC- 6&BEGIRes%ENDIRm -%"$THE_&u&DMu&LOOu ;&#+LOOu;&Y&UNTIe ;&&EN&w"AGAIe ;&G&REPEA&m-_&&I ] m&ELSm ] %m_&m%WHIL'&SPACE]lv ]Mg &<,Y'#|, -'SIGSN k -'|(Sk | k k 0'#'  r9 z'D.% F}'''' -`'#'D]'g%.')(|k 9  ](I'|<((LIS"=MSCR # <(]M"fu,(gfM|! "'INDE"%M"fu,(g]f!#  e(TRIAuuu %M"fj( "k !"k ":(VLIS]M=f|fk |ff ]Mff| eM  ` % v 4]Mff| 9 =|ff v g "(ASSEMBLE҃/../2///-XSAVUI)PO]*POPTW["*PUM /*PUSK *NEXR SETUs *INDE1   ,)MOD1D*.]*O*e**MEm*,u**,8 *9*X8 *[*)8 **8 * BO*]*SE*m+RP*8 *UPMOD *8 ]9 8 *Le*8 ]v ]M= |]9+CPgw*++BRK++CLC++CLD+غ+CLI+X+CLV+*DEX++DEY+*INX++INY+Ȑ*NOP+*PHA+H,PHP+&,PLA+h2,PLP+(+RTI+@J,RTS+`+SEC+8b,SED+n,SEI+x+TAX+,TAY+,TSX+,TXA+,TXS+,TYA+;+M/CPg w=8 ] 8 *L 8 ]B+B+ *"u*a**8 ] *8 ]8 |   *,ADC,`nR-AND, nz,CMP,n,EOR,@n,LDA,n)ORA,nn-SBC,n-STA,l`-ASL, -DEC, -INC, -LSR,A V,ROL,,! -ROR,a -STX,.CPX,%.CPY,-LDX,A.LDY, 3.STY, .JSR,k.JMP,@y.BIT, .BEGINe|-UNTILie--IF]m.ENDIFim  % -%.ELSEme~.% -%mO.THEN. /END.,NO8 ].C>,0f/0M/>x/VP]/Cs|fi'CODi?)*%o/xe/hihiHHLR /xec/hhl@/EXEC8 /p. 8 / )1+e%L01e-]!0SE]%&2=/0H=8 | 8 0 8 7"/CH=8 ]8 P08 ]P0r0CHv0M0H=8 ]8 8 ]v0v00H|0@0BDUM%Mf0gf8 ]M=f0g \"8 (8 ]M8 f-|8 |fmmN1TBgw"0ALLO=n1ARRAgt1w)NO9('U](0C 0("=018 ">`1DEPT8 -m1."1 (8 8 1m-C0-%Mf[(8  e!1SAVENFA]M8 8 f8 |8 "fC0 1V1.4~2 R'SЍ`92#SECL2CALLD˰2 SHLK 1DKI8 8 8 2=N !ERROR 8 ]|%$<(N ( EMPTY BLOCK -8 CORE ) ( EMPTY BLOCK -7 CORE ) ( EMPTY BLOCK -6 CORE ) ( EMPTY BLOCK -5 CORE ) ( EMPTY BLOCK -4 CORE ) ( EMPTY BLOCK -3 CORE ) ( EMPTY BLOCK -2 CORE ) ( EMPTY BLOCK -1 CORE ) ( EMPTY BLOCK 0 ) ;S ( EMPTY BLOCK 1 ) ;S ( EMPTY BLOCK 2 ) ;S ( SCREEN INDEX REV F 1/1 ) ;S ΠӠϠƠӠϠΠҠΠӠ̠Ġ00/00 SCREEN INDEX 01/01 SOURCE CREDITS 02/06 ERROR MESSAGES 07/0A SYSTEM SETUP / BOOTMAKER / SINGLE DRIVE BACKUP 0B/0B RPM CHECKER 0C/0E FREE 0F/0F DECOMP DISSEMBLER DATA ŠҠŠ10/10 EDITOR LOADER 11/14 SCREEN EDITOR 15/17 LINE EDITOR 18/1A ADDITIONAL EDITOR WORDS 1B/22 DECOMPILER/STACK DISPLAY 23/24 COPIES/DUPLICATE 25/26 FIND COMMAND 27/27 1.4S KERNEL MODS 28/2E ASSEMBLER 2F/2F DECUS MODS 30/30 ̠Ġ 31/35 HARDWARE/GRAPHICS/SOUND 36/36 PON/POFF 37/38 RS232C SUPPORT 39/39 DISPLAY LIST STUFF 3A/3B PLAYER/MISSILE & OLD CLONE3C/3C EXPANSION 3D/3F LPWORDS (INCL JOYST.PORTS)40/44 FORMATTED LIST PROGRAM ****** fig-FORTH MODEL ****** Through the courtesy of FORTH INTEREST GROUP P. O. BOX 1105 SAN CARLOS, CA. 94070 Implemented on the ATARI 800/400 by Steve Calfee 1/26/81 4/01/82 PETER LIPSON/ROBIN ZIEGLER 4/10/82 HARALD STRIEPE 5/5/82 - 8/20/82 RELEASE 1.4S REV.F WITH COMPILER SECURITY VARIABLE LENGTH NAMES SWITCHABLE TOP OF STACK DISPLAY DECOMPILER/DISSASSEMBLER ENHANCED SCREEN EDITOR & FAST EDIT WORDS, BASE BORDER DISPLAY ENHANCED SYSTEM SET UP/BOOTMKR Further distribution must include the above notice. Abort. IOCB already open. Non-existant device. IOCB is write-only. Invalid command (for this device) Device or file not open. Bad IOCB # IOCB is read-only End Of File Truncated Record Device Timeout Device NAK (Negative AcKnowledge) Serial Bus input framing error Cursor out of range Serial Bus data-frame overrun Serial Bus data-frame checksum error. ( SCREEN INDEX REV D 1/1 ) ;S ΠӠϠƠӠϠΠҠΠӠ̠Ġ00/00 SCREEN INDEX 01/01 SOURCE CREDITS 02/06 ERROR MESSAGES 07/09 SYSTEM SETUP / BOOTMAKER 0A/0A SINGLE DRIVE BACKUP: CLONE0B/0B RPM CHECKER 0C/0E 0F/0F DECOMP DISSEMBLER DATA ŠҠŠ10/10 EDITOR LOADER 11/14 SCREEN EDITOR 15/17 LINE EDITOR 18/1A ADDITIONAL EDITOR WORDS 1B/22 DECOMPILER/STACK DISPLAY 23/24 COPIES/DUPLICATE 25/26 EDITOR EXPANSION 27/27 1.4S KERNEL MODS 28/2E ASSEMBLER 2F/2F DECUS MODS 30/30 ̠Ġ 31/35 HARDWARE/GRAPHICS/SOUND 36/36 PON/POFF 37/38 RS232C SUPPORT 39/39 DISPLAY LIST STUFF 3A/3B PLAYER/MISSILE & OLD CLONE3C/3D EXPANSION 3E/41 LINEPRINTER WORDS 42/45 FORMATTED LIST PROGRAM ( ERROR MESSAGES ) 135 159 9 8 7 10 ;S empty stack dictionary full has incorrect address mode isn't unique disc range ?? full stack ! disc error ! THIS IS IT HELP ME! ( ERROR MESSAGES ) compilation only, use in definition execution only conditionals not paired definition not finished in protected dictionary use only when loading off current editing screen declare vocabulary outside allocated file space writing off current line string stack empty !! ( TARGET COMPILER ERROR MESSAGES WFR-79JUN02 ) below lower bound of virtual memory disc compiler assembly error in mode of can't find in TARGET target redef. T: error, is it paired with T; ? above virtual memory bounds ( SYS/BOOTMAKER 1/5 ) FORTH DEFINITIONS HEX SAVENFAs HERE 1C +ORIGIN ! ( FENCE ) HERE 1E +ORIGIN ! ( DP ) HERE DUP FENCE ! 0 +ORIGIN - 80 / 1+ CONSTANT #SECT CODE CALLDK XSAVE STX, E453 JSR, TYA, PHA, ( STATUS ) XSAVE LDX, PUSH JMP, C; : DKIO 301 ! ( CMD, DRIVE # ) 30A ! ( SECT. # ) 304 ! ( RAM BUFFER ) CALLDK ( DKHND) DUP 0< IF ." ERROR " 0FF AND BASE @ SWAP DECIMAL . BASE ! QUIT ENDIF DROP ; : WTSEC SWAP 304 ! 130 300 ! ( verif $57->) 50 302 C! SECIO ; : RDSEC SWAP 304 ! 130 300 ! 52 302 C! SECIO ; : FORMAT ." FORMAT DRIVE " DUP . ." -ARE YOU SURE?" 0 PAD ! PAD 1 EXPECT PAD C@ 59 ( Y) = IF 2100 OR PAD 0 ROT DKIO ELSE DROP THEN ; 0 VARIABLE BOOT ( ->CODE ) --> ( SYS SET UP/BOOTMKR 2/5 ) : MAKEBOOT FLUSH EMPTY-BUFFERS ." INSERT NEW DISK, TYPE Y" CR 0 PAD ! ( DEFAULT ) PAD 3 EXPECT PAD C@ 59 = IF 1 52 C! CR ." Writing sectors:" CR CR BOOT @ 1 DUP . WTSEC #SECT 0 DO I 80 * +ORIGIN I 2 + WTSEC I 2 + . LOOP 0 52 C! CR ." BOOT COMPLETED" CR THEN ; ( BOOT CODE:) HERE BOOT ! ( PT TO US ) ASSEMBLER 1FF , 480 , ' V1.4S , #SECT # LDA, 0= IF, 0 +ORIGIN , 1 , ENDIF, N STA, 2C8 C@ # LDA, 2C8 STA, D01A STA, 2C6 C@ # LDA, 2C6 STA, D018 STA, 52 # LDA, 302 STA, 48C LDA, 30A STA, 48D LDA, 30B STA, ( SCT1 ) 1 # LDA, 301 STA, 48A LDA, 304 STA, 48B LDA, 305 STA, ( ORIGIN) BEGIN, 30A INC, 0= IF, 30B INC, ENDIF, E453 JSR, 303 LDA, .A ASL, CS IF, RTS, ( FRETURN ) ENDIF, 304 LDA, 80 # EOR, 304 STA, 0< NOT IF, 305 INC, ENDIF, ( BUMP PTR.) N DEC, 0= UNTIL, 48A LDA, 0A STA, 48B LDA, 0B STA, E C@ # LDA, 2E7 STA, F C@ # LDA, 2E8 STA, CLC, RTS, FORTH --> ( BACKUP HES 82AUG15 3/5 ) 35F ARRAY BUCD BLK @ BLOCK A0 + BUCD 35F CMOVE CODE bg E474 JMP, C; : BACKUP BUCD 480 35F CMOVE 480 C ! STOF bg ; --> j8iR'Sx867X /E /XB / / / /1    I  Lȍ /ɠ R    /  ` /! 8  /Q P  `詀R@ YLii    R `Я` /m L / / L  ` LwPpM`W7 ` / Lfig-FORTH 1.4S FAST BACKUP Vers.1.2 BY H.E.STRIEPE 1982 START - commence I/O SELECT - write with verify OPTION - REBOOTInsert source disk and press START, or select OPTION to REBOOTReading SOURCE disk...Insert destination disk, press START, or SELECTWriting DESTINATION disk...****** DUPLICATION SUCCESSFUL *********** DISK I/O ERROR!TRY AGAIN *********** BREAK KEY INTERRUPT! ******( scr# A BOOTMKR/SYS 4/5 ) : DoFORget ( forgets below ) ' TEXT NFA ( FENCE ) FENCE ! 0 FORGET TEXT ; : SETSYS ( SETS RESET PARAM ) LMARGN @ DUP ( MARGINS ) LSB ' V1.4S 4 + C! MSB ' V1.4S 8 + C! COL1 @ DUP ( COLORS ) LSB ' V1.4S C + C! MSB ' V1.4S 11 + C! COL4 C@ ( BORDER ) LSB ' V1.4S 16 + C! ; : HOOK ( hooks your assembly ) ( routine into WARMSTRT ) ( ->use HOOK word ) [COMPILE] ' ' V1.4S 1+ ! ; : UNHOOK ( restore vector ) E4C0 ' V1.4S 1+ ! ; --> ( SYS SET UP/BOOTMKR 5/5 ) HEX LMARGN @ 2700 LMARGN ! ." }fig-FORTH 1.4S SYSTEM SET-UP Vers.1.1 " CR CR ." DoFORget WORD forgets below FENCE." CR CR ." n SETPHYS permanently changes the OFFSET of screen #0." CR CR ." RESPHYS resets the OFFSET to its original value; use" CR ." n SETPHYS twice to set RESPHYS to a new value" CR CR ." n FORMAT formats disk in drive n. " CR CR ." MAKEBOOT writes out compiled boot sectors." CR ." SETSYS sets booton parameters:" CR ." screen margins, colors" CR CR ." BACKUP fast single drive utility " CR LMARGN ! EMPTY-BUFFERS SP! ;S ( DISK RPM CHECKER 1/1 ) CODE ZIO XSAVE STX, BOT LDA, E459 JSR, XSAVE LDX, BOT STY, BOT 1+ STA, NEXT JMP, C; 246 CONSTANT DSKTIM : DSIO ( DISK HNDLR VIA SIO ) ( BADDR AUXS UNIT-CMD DATFLG ) 303 C! ( SET DATA-FLAG ) 301 ! ( DUNIT,CMD) 31 300 C! ( DEVICE) 30A ! ( AUXES ) 304 ! ( BUFER-ADDR ) 0 ZIO ; 1 VARIABLE DR# : BIO DSKTIM @ 306 C! 80 308 ! ( BUFLEN) DSIO ; : RDSEC 5200 OR 40 BIO ; ( DISK SPEED CHECKER ) 14 CONSTANT RTCLOCK 2F2 CONSTANT KBCHAR FF CONSTANT EPTY : READ-SEC PAD 1 DR# C@ RDSEC ; : CLR-KBRD EPTY KBCHAR C! ; : RPM DECIMAL CLR-KBRD 1 2F0 C! DR# C! 0 17 POS. ." = " BEGIN KBCHAR C@ EPTY = WHILE READ-SEC DROP 0 RTCLOCK C! 10 1 DO READ-SEC DROP LOOP D2F0 0 RTCLOCK C@ U/ SWAP DROP 4 17 POS. . REPEAT CLR-KBRD 0 2F0 C! HEX ; ;S ( ӠŠΠŠ ) ( EMPTY BLOCK D ) ;S ( EMPTY BLOCK E ) ;S !iDi@ @oiB i PiFiH H*ii WD@@x@uBxxPFHxHxHDH@c@lHBcTHc$PHFHHcH0HHcD@rB{T'PFHD@@@E PFHHJ`BZD]B`@Z@]@ZB`Z]PZF`HZH]J3Z`Z]> DECOMP DISASSEMBLER STUFF << DO NOT MOVE FROM THIS SCREEN ! ( SCREEN ED. LOAD 1.4S 1/1 ) ( HES 82aug4 ) BASE @ HEX FORTH DEFINITIONS VOCABULARY EDITOR IMMEDIATE ' EDITOR 2 + DUP VOC-LINK ! 20 +ORIGIN ! FORTH DEFINITIONS : EDIT SCR ! POFF [COMPILE] EDITOR ; HEX 15 LOAD ( LINE EDITOR ) HEX 1B LOAD ( DECOMPILER ) HEX 20 LOAD ( STACKDISPLAY) 11 LOAD ( SCREEN EDITOR ) 18 LOAD ( ENHANCEMENTS ) 23 LOAD ( copies/backup ) 25 LOAD ( FIND WORD ) 3D LOAD ( PRINTER WORDS ) : VERIFY 57 245E C! ; : NOVERIFY 50 245E C! ; : SYS STACKOFF 0 DMACTL C! 7 LOAD 22 DMACTL C! ; CODE GOBOOT E477 JMP, C; : GO STACKON GS ; : WARNON 1 WARNING ! ; : WARNOFF 0 WARNING ! ; BASE ! ;S ( SCREEN EDITOR DLI 1/4 ) ( HEH 2jul82 ) HEX EDITOR DEFINITIONS ( DLI for command window ) 0 VARIABLE COL1T 0 VARIABLE COL2T CODE EDLI PHA, TXA, PHA, COL1T LDA, COLRSH EOR, DRKMSK AND, TAX, COL2T LDA, COLRSH EOR, DRKMSK AND, WSYNC STA, D017 STX, D018 STA, PLA, TAX, PLA, RTI, C; : COLSET COL2 C@ DUP F AND COL1T C! F0 AND COL1 C@ F AND + COL2T C! ; ( Sound words for beeps ) 0 VARIABLE TOPFLAG 1 VAR L#FLG 0 VAR SPTCH 1 VAR SFLG 0 VAR EDVEC : SOUNDON 1 TO SFLG ; : SOUNDOFF 0 TO SFLG ; FORTH DEFINITIONS : SNDOFF 0 0 0 SOUND ; EDITOR DEFINITIONS : PN 10 * TO SPTCH SFLG IF 28 0 DO 0 SPTCH A A SOUND LOOP 0 SNDOFF THEN ; --> ( SCREEN ED. DLSETMOD 2/4 ) ( HES 4jul82 ) EDITOR DEFINITIONS 28 ARRAY EDBF C ARRAY DLSTMP TBL EDLST 82 C, 40 C, 202 , 202 , 02 C, 40 C, 47 C, EDBF , 41 C, DLST @ , 0 GR. DLST @ 14 + DLSTMP C CMOVE : DLSET 200 @ TO EDVEC ' EDLI 200 ! EDBF TOPFLAG @ 0= IF " UPP" ELSE " LOW" THEN SYPE " ER HALF SCR # " SYPE SCR @ 0 <# #S #> SYPE " " SYPE DROP DLST @ EDLST C + ! EDLST DLST @ 14 + E CMOVE FF D40E C! ." }" ; 208 @ CN KBDVC CODE KCHK 54 LDA, 10 # CMP, 0< IF, D209 LDA, C # CMP, 0= IF, PLA, RTI, THEN, THEN, KBDVC JMP, C; CODE EDKIS SEI, ' KCHK LSB # LDA, 208 STA, ' KCHK MSB # LDA, 209 STA, CLI, NEXT JMP, C; CODE EDKIQ SEI, KBDVC LSB # LDA, 208 STA, KBDVC MSB # LDA, 209 STA, CLI, NEXT JMP, C; --> ( SCREEN ED. MOD 1.4S 3/4 ) ( HES 82AUG18 ) EDITOR DEFINITIONS : EDCLR COL1 @ COL3 @ 0 GR. COL3 ! COL1 ! ; : EDLS EDCLR COLSET 0 DMACTL C! DLSET 22 DMACTL C! EDKIS 2203 LMARGN ! COL4 C@ DUP F0 AND SWAP 8 + F AND + COL0 C! ; : EDLQ 8F D40E C! EDVEC 200 ! EDKIQ ' V1.4S 4 + C@ 52 C! ' V1.4S 8 + C@ 53 C! 0 DMACTL C! DLSTMP DLST @ 14 + C CMOVE 22 DMACTL C! FF D40E C! CR ; : .L# L#FLG IF 10 0 DO DUP 0 I POS. I + . LOOP THEN DROP 3 12 POS. ; : ULL DUP TOPFLAG ! SCR @ EDLS EDLQ BLOCK EDLS 3 0 POS. + 200 1 DUP 2F0 C! 2FE C! TYPE CR ." DOIT" AAAA 2B2 ! ; : UL 0 ULL 0 .L# 0 DUP 2FE C! 2F0 C! 6 PN ; : LL 200 ULL 10 .L# 0 DUP 2FE C! 2F0 C! 7 PN ; --> ( SCREEN EDITOR 1.5S 4/4 ) EDITOR DEFINITIONS : DOIT 10 0 DO -1 2B2 ! 3 I POS. SCR @ BLOCK I 20 * + TOPFLAG @ + ICBAL ! 20 ICBLL ! GET DROP LOOP UPDATE TOPFLAG @ 0= IF UL ELSE LL ENDIF ; : FORTH EDLQ [COMPILE] FORTH ; EDITOR DEFINITIONS : FLUSH FORTH FLUSH ; : FH FLUSH ; : L#ON 1 TO L#FLG BASE @ > 8 IF HEX THEN DOIT ; : L#OFF 0 TO L#FLG DOIT ; FORTH DEFINITIONS ;S ( LINE EDITOR 1/3 ) ( TEXT, LINE, WHERE USED IN EDITOR 7/7/80-SRC ) FORTH DEFINITIONS HEX : TEXT ( ACCEPT FOLLOWING TEXT TO PAD *) HERE C/L 1+ BLANKS WORD HERE PAD C/L 1+ CMOVE ; : #OFLINES B/BUF B/SCR * C/L / ; : LINE ( RELATIVE TO SCR, LEAVE ADDRESS OF LINE *) DUP #OFLINES MINUS AND IF ." NOT ON SCREEN" ABORT ENDIF ( KEEP ON THIS SCREEN ) SCR @ (LINE) DROP ; : WHERE ( PRINT SCREEN # AND IMAGE OF ERROR *) DUP B/SCR / DUP SCR ! ." SCR # " . SWAP C/L /MOD C/L * ROT BLOCK + CR C/L TYPE CR HERE C@ - SPACES 5E EMIT [COMPILE] EDITOR QUIT ; --> ( LINE EDITING COMNDS 2/3 ) EDITOR DEFINITIONS : -MOVE ( MOVE IN BLOCK BUFFER ADDR FROM-2, LINE TO-1 *) LINE C/L CMOVE UPDATE ; : HL ( HOLD NUMBERED LINE AT PAD *) LINE PAD 1+ C/L DUP PAD C! CMOVE ; : BL ( ERASE LINE-1 WITH BLANKS *) LINE C/L BLANKS UPDATE ; : SL ( SPREAD MAKING LINE # BLANK *) DUP 1 - ( LIMIT ) #OFLINES 2 - ( FIRST TO MOVE ) DO I LINE I 1+ -MOVE -1 +LOOP BL ; : DL ( DELETE LINE-1, BUT HOLD IN PAD *) DUP HL #OFLINES 1 - DUP ROT DO I 1+ LINE I -MOVE LOOP BL ; : CL ( COPY LINE-2 OF SCREEN-1 TO PAD ) SCR @ >R SCR ! HL R> SCR ! ; --> ( LINE EDITING COMNDS 3/3 ) ( WFR-790105 ) : RL ( REPLACE ON LINE-1, FROM PAD ) PAD 1+ SWAP -MOVE ; : $ ( PUT FOLLOWING TEXT ON LINE-1 ) 1 TEXT RL ; : % ( INSERT TEXT FOLLOWING AFTER LINE-1 *) 1 TEXT 1+ DUP SL RL ; : IL ( INSERT PAD AFTER LINE-1 ) 1+ DUP SL RL ; : TL ( TYPE LINE BY #-1, SAVE ALSO IN PAD *) DUP . ." $ " DUP C/L * R# ! HL PAD 1+ C/L TYPE CR ; FORTH DEFINITIONS : COPY SWAP BLOCK SWAP BLOCK 400 CMOVE UPDATE FLUSH ; ;S ( VERS 1.4S MODS HES 1/3 ) FORTH DEFINITIONS HEX : HX HEX 93 2C8 C! ; DECIMAL : DX DECIMAL 68 712 C! ; : BX BINARY 248 712 C! ; HEX : BS 0008 2C5 ! ; : WS 0C00 2C5 ! ; : GS D008 2C5 ! ; : NS 94CA 2C5 ! ; EDITOR DEFINITIONS : LE EDIT LL ; : UE EDIT UL ; : N 8 PN SCR @ 1 + EDIT UL ; : P 4 PN SCR @ 1 - EDIT UL ; : L SCR @ EDIT UL ; : T 4 PN 9 PN ALT @ @ EDIT UL ; FORTH DEFINITIONS : EDT [COMPILE] EDITOR ; : UE [COMPILE] EDITOR EDITOR UE ; FORTH DEFINITIONS : LE [COMPILE] EDITOR EDITOR LE ; FORTH DEFINITIONS : L& HEX ( fast load ) 0 DUP WARNING ! DMACTL C! LOAD 22 DMACTL C! ; --> ( FAST EDIT WORDS 2/3 ) EDITOR DEFINITIONS : LIST EDLQ LIST ; : L. LIST ; ( ZIEGLER STUFF ) FORTH DEFINITIONS HEX : P SCR C@ 1- LIST ; : NL EMPTY-BUFFERS LIST ; : LS [COMPILE] EDITOR 1 + SWAP 27 53 C! DO I EDITOR TL LOOP ; : SAVE-BUFFERS FLUSH ; : ERASE-CORE EMPTY-BUFFERS ; : TRC NFA ID. ; : T ALT @ @ LIST ; CODE K XSAVE STX, TSX, 109 ,X LDA, PHA, 10A ,X LDA, XSAVE LDX, PUSH JMP, C; : ZCOLD 0 8 C! COLD ; 10 ARRAY CDAT 22 TEXT ( HES 14jul82 )" PAD 1+ CDAT 10 CMOVE : CDATE 1+ SWAP DO I BLOCK 10 + CDAT SWAP 1 CMOVE UPDATE FLUSH LOOP ; : L. LIST ; : SHOW 1+ SWAP DO I LIST LOOP ; : L SCR @ LIST ; : N SCR @ 1+ LIST ; --> ( ZIEGLER/STRIEPE V1.4S 3/3 ) FORTH DEFINITIONS : N->T SCR C@ S->D <# #S #> ; : ZERO-BLOCK SCR @ BLOCK DUP DUP 400 20 FILL " ( scr# empty block 1/1 ) ;S " ROT SWAP CMOVE 7 + N->T ROT SWAP CMOVE UPDATE FLUSH ; : LZERO 1+ SWAP DO I SCR ! ZERO-BLOCK LOOP ; EDITOR DEFINITIONS : ZERO-BLOCK EDLQ ZERO-BLOCK EDT UL ; ( FAST EDIT ENHANCEMENTS ) EDITOR DEFINITIONS : LOAD FLUSH DEPTH 0= IF SCR @ THEN LOAD ; : T. 9 PN 4 PN ALT @ @ EDIT LL ; : N. 9 PN SCR @ 1 + EDIT LL ; : P. 5 PN SCR @ 1 - EDIT LL ; : WIPE ZERO-BLOCK ; : DRAIN EMPTY-BUFFERS ; : W ."  to wipe, N to abort " KEY 4E NOT = IF WIPE THEN ; FORTH DEFINITIONS : DRAIN EMPTY-BUFFERS ; : WIPE ZERO-BLOCK ; ;S ( HIGH-LEVEL DISSASSEMBLER ) FORTH DEFINITIONS TASK DOG ' (;CODE) CFA CN .;CODE ' ;S CFA CN .;S ' BRANCH CFA CN .BR ' 0BRANCH CFA CN .0BR ' (DO) CFA CN .DO ' (LOOP) CFA CN .LOOP ' (+LOOP) CFA CN .+LOOP ' LIT CFA CN .LIT 0D6B CN .CLIT ' (.") CFA CN .(.") ' TASK CFA @ CN .: ' DOG CFA @ CN .DOES> ' COMPILE CFA CN .COMP 0 VARIABLE .IP ' BLK CFA @ CN .USR ' .;S CFA @ CN .CON ' .IP CFA @ CN .VAR 60 CN RTS, 40 CN RTI, --> ( HIGH-LEVEL DISSASSEMBLER ) : PRNAME 2+ NFA ID. ; : STRNG ( cfa--cfa prnt strng) DUP .(.") = IF PRNAME .IP @ DUP COUNT ROT OVER + 1+ .IP ! TYPE CR R> DROP ENDIF ; : LIT? ( cfa--cfa prints lit) DUP .LIT = IF PRNAME .IP @ @ . CR 2 .IP +! R> DROP ELSE DUP .CLIT = IF ." CLIT " DROP .IP @ C@ . CR 1 .IP +! R> DROP ENDIF ENDIF ; : COMP? DUP .COMP = IF PRNAME .IP @ @ PRNAME CR 2 .IP +! R> DROP ENDIF ; : PROMPT ." ok " CR ; : ENDEF ( cfa--cfa aborts@end) DUP .;CODE = OVER .;S = OR IF PRNAME CR PROMPT QUIT ENDIF ; : BRNCH ( cfa--cfa prnts dst) DUP .BR = OVER .0BR = OR OVER .LOOP = OR OVER .+LOOP = OR IF PRNAME ." to " .IP @ DUP @ + . CR 2 .IP +! R> DROP ENDIF ; --> ( DECOMP DISSASSEMBLER PBL 82) F CN OPTAB ( STD. $F ) 200 CN OPOFF 300 CN MODOFF : 1OP .IP @ DUP HH ." : " C@ 1 .IP +! DUP CHH SPACE ; ( --op) : INDX ( off base--addr) + B/BUF /MOD [ OPTAB B/SCR * ] LITERAL + BLOCK + ; : OPLUK ( op--opind modind #op) DUP + 0 INDX DUP C@ SWAP 1+ C@ 40 /MOD ; : OPANDP ( #bytes--) DUP -DUP IF .IP @ C@ CHH SPACE 1 - IF .IP @ 1+ C@ CHH ELSE 2 SPACES ENDIF ELSE 5 SPACES ENDIF ." - " -DUP IF 1 - IF .IP @ @ 2 ELSE .IP @ C@ 1 ENDIF .IP +! HH SPACE ELSE 5 SPACES ENDIF ; : MODP ( modind--) MODOFF INDX 2 TYPE SPACE ; : OPP ( opind--) OPOFF INDX 3 TYPE ." , " CR ; --> ( DECOMP DISSASSEMBLER PBL 82) : BR? ( mode #op--mode) OVER 10 = IF .IP @ DUP C@ CHH ." - " DUP C@ DUP 80 AND IF FF00 OR ENDIF 1+ + HH .IP +! SPACE ELSE OPANDP ENDIF ; : 1LINE 1OP OPLUK BR? MODP OPP ; : JMPEX ( --f test endef jmps) .IP @ C@ 4C = IF .IP @ 1+ @ DUP ASSEMBLER NEXT = OVER W 1 - = OR OVER POP = OR OVER PUSH = OR OVER PUT = OR SWAP POPTWO FORTH = OR DUP IF ENDIF ELSE 0 ENDIF ; : ;CEND .IP @ C@ DUP RTS, = SWAP RTI, = OR JMPEX OR ; : 1WRD BEGIN 1LINE ;CEND UNTIL 1LINE ; : CSEE 1WRD ; : DIS .IP ! 1WRD ; : NDIS .IP ! 0 DO 1LINE LOOP ; : ISCODE .IP @ DUP 2 - @ = IF ." primitive " CR 1WRD ELSE .IP @ CFA @ DUP 2 - @ SWAP .IP ! .;CODE = IF ." ;CODE word" CR ELSE ." odd entry point" CR ENDIF 1WRD ENDIF ; --> ( HIGH-LEVEL DISSASSEMBLER ) : ISCOL ( -- or ) .IP @ DUP CFA @ .: - IF DUP CFA @ DUP .DOES> = IF .IP @ @ .IP ! ." DOES> word" CR DROP 1 ELSE SWAP DROP DUP .CON = IF ." CONSTANT : " .IP @ @ HH CR DROP ELSE DUP .USR = IF ." USER variable " DROP CR ELSE .VAR = IF ." VARIABLE : " .IP @ DUP HH @ ." = " HH CR ELSE ISCODE ENDIF ENDIF ENDIF 0 ENDIF ELSE 1 ENDIF ; : NXTW 2 SPACES .IP @ DUP HH ." : " @ 2 .IP +! 2 SPACES LIT? BRNCH COMP? STRNG ENDEF PRNAME CR ; : FETCHW [COMPILE] ' .IP ! ISCOL IF NFA C@ 40 AND IF ." immediate" CR ENDIF ELSE PROMPT QUIT ENDIF ; : DECOMP FETCHW BEGIN NXTW ?TERMINAL IF PROMPT QUIT ENDIF AGAIN ; : DCP DECOMP ; : ZZ DECOMP ; ;S ( CONSTANT INFO DISPLAY 1/3 ) FORTH DEFINITIONS TBL XTRN 40 C, 0 C, 20 C, 60 C, CODE ASCINT BOT LDA, .A ROL, .A ROL, .A ROL, .A ROL, 03 # AND, TAY, BOT LDA, 9F # AND, XTRN ,Y ORA, BOT STA, NEXT JMP, C; : SYPE ( addr, straddr, cnt ) OVER + SWAP DO I C@ ASCINT OVER C! 1+ LOOP ; HERE DUP 3F + FFC0 AND SWAP - ALLOT 28 ARRAY BUF TBL DLIST 5070 , 42 C, BUF , 1 C, 0 , HERE 2 - CN DLPTCH --> ( CONSTANT INFO DISPLAY 2/3 ) ' ABORT 6 + @ VARIABLE ABORT1 ' QUIT A + @ VARIABLE QUIT1 : INIT 0 DMACTL C! DLST @ DUP C@ 1 - IF DUP 3 + DLPTCH ! 1 OVER C! DLIST SWAP 1+ ! ELSE DROP THEN 22 DMACTL C! ; : DSPLY BUF " TOS= " SYPE >R ASSEMBLER UP FORTH @ 6 + @ SP@ 10 + MIN SP@ BEGIN 2+ OVER OVER > WHILE R> OVER @ 0 <# # # # # #> SYPE 1+ >R REPEAT DROP DROP R> " fig-FORTH 1.4S" SYPE DROP ; : SSK DSPLY INIT CR BASE @ DUP A = IF 44 2C8 C! ELSE DUP 10 = IF 93 2C8 C! ELSE DUP 2 = IF F8 2C8 C! ELSE DUP 4 2C8 C! ENDIF ENDIF ENDIF DROP ; : FIX\ DROP ." " ; : STACKON ( HES MOD 12jun82 )( ' ABORT 6 + @ ABORT1 ! ) ( ' QUIT A + @ QUIT1 ! ) ' SSK CFA ' ABORT 6 + ! ' SSK CFA ' QUIT A + ! ' FIX\ CFA ' \ 40 + ! ; --> ( CONST. INFO. / CDUMP 3/3 ) : STACKOFF ABORT1 @ ' ABORT 6 + ! QUIT1 @ ' QUIT A + ! 2C5 @ 2C8 C@ 0 GR. 2C8 C! 2C5 ! ; : STON STACKON ; : STOF STACKOFF ; ( HES V.1.0 82AUG7 ) : CDUMP ( adr1 adr2 --- ) 1 2FE C! 1+ SWAP DO I HH ." :" SPACE I 8 0 DO DUP I + C@ EMIT 2 SPACES LOOP DROP ." \" CR 8 +LOOP 0 2FE C! ; ;S ( SINGLE DRIVE DUPSCR 1/2 ) ( by anonymous/HES 23jun82 ) 0 VARIABLE EBLK ( ENDING BLK ) 0 VARIABLE SBLK ( START. BLK ) 0 VARIABLE PSBLK : DISP ( -> DEST ADR INFRE RAM ) PSBLK @ B/BUF * HERE + ; : GTPAR ( SET UP DO AND PSBLK ) EBLK @ SBLK @ 0 PSBLK ! ; : MVIN ( MOVE BLOCKS INTO RAM ) GTPAR DO I BLOCK DISP B/BUF CMOVE 1 PSBLK +! LOOP ; : MOVOT ( WRITE RAM TO DISK ) 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 @ - FREE 400 / > IF ." TOO MANY " QUIT ENDIF CR MVIN ." INSERT DESTINATION DISK " CR ." RETURN TO CONTINUE " KEY DROP CR MOVOT ; --> ( COPIES UTILITY HES 2/2 ) ( 18jun82 ) FORTH DEFINITIONS : CPST CR ." ? Incorrect screen range" CR QUIT ; : CPNT CR ." scr# " SWAP DUP . ." --> " SWAP DUP . ; : CPMP EBLK @ SBLK @ - DUP PSBLK @ + PSBLK ! 1+ 0 DO EBLK @ I - PSBLK @ I - CPNT COPY LOOP ; : CPMD EBLK @ SBLK @ - 1+ 0 DO SBLK @ I + PSBLK @ I + CPNT COPY LOOP ; : COPIES PSBLK ! EBLK ! SBLK ! EBLK @ SBLK @ < IF CPST THEN PSBLK @ SBLK @ > IF CPMP ELSE CPMD ENDIF CR ; IMMEDIATE ;S ( FIND V.1.1 1/2 ) ( by R.Mansfield/COMPUTE! ) ( adapt.&enhanced HES 82aug7 ) FORTH DEFINITIONS HEX 0 VARIABLE 1STCHAR : ?CONSOL -2FE1 C@ 7 XOR ; : MATCH ( addr1 addr2 N --- F ) -DUP IF OVER + SWAP DO DUP C@ I C@ - IF 0= LEAVE ELSE 1+ THEN LOOP ELSE DROP 0= THEN ; : CHECKIT ( addr --- F ) PAD 1+ PAD C@ MATCH ; : HEADER CR ." Searching for " 22 EMIT SPACE PAD 1+ PAD C@ TYPE 22 EMIT CR CR ." on scr #" ; : MARKSTRING ( scr# addr --- scr# ) OVER BLOCK - C/L / CR DUP CR CR ." Found on LINE#" CR CR . SPACE OVER .LINE CR CR CR ." scr#" ; : ?STCK DEPTH 2 < IF 0 59 PHYSOFF @ - ENDIF ; --> ( FIND 2/2 ) CODE ?CHAR ( addr --- addr F ) 1 # LDA, SETUP JSR, N )Y LDA, 1STCHAR CMP, 0= IF, 1 # LDA, PHA, 0 # LDA, PUSH JMP, THEN, 0 # LDA, PHA, PUSH JMP, C; : ONEBLK ( scr# addr --- ) DUP 400 + SWAP DO I ?CHAR IF I CHECKIT IF I MARKSTRING ENDIF ENDIF LOOP DROP ; : GTWRD 22 WORD HERE DUP C@ 1+ PAD SWAP CMOVE ; : FIND ( scr#1 scr#2 text --- ) ?STCK GTWRD 0 SCR ! PAD 1+ C@ 1STCHAR ! HEADER 1+ SWAP DO I DUP DUP SPACE . BLOCK ONEBLK ?CONSOL IF CR LEAVE ENDIF LOOP CR CR ." Search ended" CR ; ;S ( VERS1.4S KERNEL ADD 1/1 ) ( REZ / HES 18jun82 ) ( Already in kernel, doc.only) FORTH DEFINITIONS HEX : NOT 0= ; : U. 0 D. ; : CN CONSTANT ; : (") R> DUP COUNT + >R COUNT ; : " COMPILE (") 22 WORD HERE C@ 1+ ALLOT ; IMMEDIATE : DEPTH EA SP@ - 2 / ; : .S CR DEPTH IF EA EA DEPTH 2 - 2* - SWAP DO I ? -2 +LOOP ELSE 1 MESSAGE ENDIF ; : SAVENFAs #LINKS 0 DO 1CFC 4 + I 4 * + @ 22 I 2* + +ORIGIN ! LOOP ; ( SETS MARGN,COLOR ON RESET ) ( HES 82AUG21 ) CODE V1.4S ( DOSINI VECTOR ) E4C0 JSR, ( APPL.HOOK ) 0 # LDA, 52 STA, ( MARGN ) 27 # LDA, 53 STA, ( " ) 8 # LDA, 2C5 STA, D0 # LDA, 2C6 STA, 93 # LDA, 2C8 STA, ( SCREEN COLORS ) RTS, C; ;S ( FORTH-65 ASSEMBLER 1/6 ) ( WFR-79JUN03 ) HEX VOCABULARY ASSEMBLER IMMEDIATE' ASSEMBLER 2 + DUP 20 +ORIGIN ! VOC-LINK ! ASSEMBLER DEFINITIONS ( LOCATE EXISTING REGISTERS ) FF CONSTANT XSAVE 0FB CONSTANT W 0FD CONSTANT UP F8 CONSTANT IP F0 CONSTANT N ( LOCATE EXISTING CODE PROCEEDURES ) ' (DO) 0E + CONSTANT POP ( FROM COMPUTATION STACK *) ' (DO) 0C + CONSTANT POPTWO ' LIT 13 + CONSTANT PUT ' LIT 11 + CONSTANT PUSH ' LIT 18 + CONSTANT NEXT ' EXECUTE NFA 11 - CONSTANT SETUP --> ( FORTH-65 ASSEMBLER 2/6 ) ( WFR-78OCT03 ) 0 VARIABLE INDEX -2 ALLOT 0909 , 1505 , 0115 , 8011 , 8009 , 1D0D , 8019 , 8080 , 0080 , 1404 , 8014 , 8080 , 8080 , 1C0C , 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 ! ; : ) F MODE ! ; : BOT ,X 0 ; ( ADDRESS BOTTOM OF STACK ) : SEC ,X 2 ; ( ADDRESS SECOND ITEM ON STACK ) : RP) ,X 101 ; ( ADDRESS BOTTOM OF RETURN STACK ) --> ( UPMODE, CPU 3/6 ) ( WFR-78OCT23 ) : UPMODE IF MODE C@ 8 AND 0= IF 8 MODE +! ENDIF ENDIF 1 MODE C@ 0F AND -DUP IF 0 DO DUP + LOOP ENDIF 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, A8 CPU TAY, BA CPU TSX, 8A CPU TXA, 9A CPU TXS, 98 CPU TYA, --> ( M/CPU, MULTI-MODE 4/6 ) ( OP-CODES WFR-79MAR26 ) : M/CPU DUP 1+ C@ 80 AND IF 10 MODE +! ENDIF OVER FF00 AND UPMODE UPMODE IF MEM CR LATEST ID. 3 ERROR ENDIF C@ MODE C@ INDEX + C@ + C, MODE C@ 7 AND IF MODE C@ 0F AND 7 < IF C, ELSE , ENDIF ENDIF MEM ; 1C6E 60 M/CPU ADC, 1C6E 20 M/CPU AND, 1C6E C0 M/CPU CMP, 1C6E 40 M/CPU EOR, 1C6E A0 M/CPU LDA, 1C6E 00 M/CPU ORA, 1C6E E0 M/CPU SBC, 1C6C 80 M/CPU STA, 0D0D 01 M/CPU ASL, 0C0C C1 M/CPU DEC, 0C0C E1 M/CPU INC, 0D0D 41 M/CPU LSR, 0D0D 21 M/CPU ROL, 0D0D 61 M/CPU ROR, 0414 81 M/CPU STX, 0486 E0 M/CPU CPX, 0486 C0 M/CPU CPY, 1496 A2 M/CPU LDX, 0C8E A0 M/CPU LDY, 048C 80 M/CPU STY, 0480 14 M/CPU JSR, 8480 40 M/CPU JMP, 0484 20 M/CPU BIT, --> ( ASSEMBLER CONDITIONALS 5/6) ( WFR-79MAR26 ) : BEGIN, HERE 1 ; IMMEDIATE : UNTIL, ?EXEC >R 1 ?PAIRS R> C, HERE 1+ - C, ; IMMEDIATE : IF, C, HERE 0 C, 2 ; IMMEDIATE : ENDIF, ?EXEC 2 ?PAIRS HERE OVER C@ IF SWAP ! ELSE OVER 1+ - SWAP C! ENDIF ; IMMEDIATE : ELSE, 2 ?PAIRS HERE 1+ 1 JMP, SWAP HERE OVER 1+ - SWAP C! 2 ; IMMEDIATE : NOT 20 + ; ( REVERSE ASSEMBLY TEST ) 90 CONSTANT CS ( ASSEMBLE TEST FOR CARRY SET ) D0 CONSTANT 0= ( ASSEMBLER TEST FOR EQUAL ZERO ) 10 CONSTANT 0< ( ASSEMBLE TEST FOR LESS THAN ZERO ) 90 CONSTANT >= ( ASSEMBLE TEST FOR GREATER OR EQUAL ZERO ) ( >= IS ONLY CORRECT AFTER SUB, OR CMP, ) CR --> ( USE OF ASSEMBLER 6/6 ) ( WFR-79APR28 ) : C; ( END OF CODE DEFINITION *) CURRENT @ CONTEXT ! ?EXEC ?CSP SMUDGE ; IMMEDIATE FORTH DEFINITIONS : CODE ( CREATE WORD AT ASSEMBLY CODE LEVEL *) ?EXEC CREATE [COMPILE] ASSEMBLER ASSEMBLER MEM !CSP ; IMMEDIATE DECIMAL ;S ( TILL figFORTH IS UP ) ' ASSEMBLER CFA ' ;CODE 8 + ! ( OVER-WRITE SMUDGE ) FORTH DEFINITIONS DECIMAL ;S LATEST 12 +ORIGIN ! ( TOP NFA ) HERE 28 +ORIGIN ! ( FENCE ) HERE 30 +ORIGIN ! ( DP ) ' ASSEMBLER 6 + 32 +ORIGIN ! ( VOC-LINK ) HERE FENCE ! ;S ( compile assembler 1/1 ) and editor SRC 7/6/80 ) BASE @ ( PRESERVE THE RADIX ) DECIMAL 31 WIDTH ! HEX 28 LOAD ( ASSEMBLER ) HEX 2F LOAD ( DECUS FORTH ADDS) HEX 27 LOAD ( VERS 1.4S KERNEL ) HEX 30 LOAD ( EDITOR & OTHER WORDS ) FORTH DEFINITIONS 25 CONSTANT LPWORDS 27 CONSTANT FORMAT DECIMAL LATEST 12 +ORIGIN ! ( TOP NFA ) HERE 28 +ORIGIN ! ( FENCE ) HERE 30 +ORIGIN ! ( DP ) HERE FENCE ! 1 WARNING ! ( DISK WARNINGS ) : TASK ; BASE ! ;S ( DECUS/FORTH MODS 1/1 ) : 1+! 1 SWAP +! ; : 1- 1 - ; : 0SET 0 SWAP ! ; : HD DUP 0A < IF 30 ELSE 37 ENDIF + EMIT ; : CHH DUP 0F0 AND 10 / HD 0F AND HD ; : CH? C@ CHH ; : HH DUP 0FF00 AND 100 / 0FF AND CHH CHH ; : H? @ HH ; : BDUMP 1+ SWAP DO I HH ." : " I 8 0 DO DUP I + CH? SPACE LOOP DROP ." \" CR 8 +LOOP ; : TBL ; : ALLOC DUP + ALLOT ; ( FOR RAM BASED SYSTEMS,) : ARRAY ; ;S ( FULL UTILITY LOAD REV F ) ( HES 82AUG18 ) BASE @ FORTH DEFINITIONS : VLIST ( SRC/HES 82AUG18 ) 52 @ 2701 52 ! CR #LINKS 0 DO CONTEXT @ I 4 * + @ HERE I I + + ! LOOP BEGIN #LINKS 0 DO HERE I I + + @ LOOP #LINKS 1 DO OVER OVER U< IF SWAP THEN DROP LOOP DUP IF #LINKS 0 DO HERE I I + + @ OVER = IF DUP PFA LFA @ HERE I I + + ! THEN LOOP THEN -DUP WHILE ID. 55 @ D < IF D 55 ! ELSE 55 @ 1A < IF 1A 55 ! ELSE CR THEN THEN REPEAT 52 ! CR ; HEX 31 LOAD ( CIO/GRAPH ) HEX 36 LOAD ( PON/POFF ) HEX 37 LOAD ( RS 232C ) HEX 39 LOAD ( DISPLLST ) FORTH DEFINITIONS HEX 10 LOAD ( EDITOR ) FORTH DEFINITIONS BASE ! NOVERIFY WARNON GO ;S ( fig-FORTH 1.4S MODS 1/1 ) ( HES 82JUN17 ) FORTH DEFINITIONS HEX : BELL C0 0 DO 8 D01F C! 6 0 DO LOOP 0 D01F C! 6 0 DO LOOP LOOP ; : BINARY 2 BASE ! ; : BIN BINARY ; : TASK ; ( ANTIC -> ) 0 VARIABLE TOFLAG : TO 1 TOFLAG ! ; : VAR TOFLAG @ IF ! ELSE @ THEN 0 TOFLAG ! ; : MSBYTE 0 100 U/ SWAP DROP ; : LSBYTE FF AND ; : >< DUP LSBYTE 100 * SWAP MSBYTE + ; CR ." CIO CALLS" CR 32 LOAD CR ." OS/HARDWARE" CR 33 LOAD CR ." GRAPH/SOUND" CR 34 LOAD FORTH DEFINITIONS : THERE MEMTOP @ ; : FREE THERE HERE - ; : OCTAL 8 BASE ! ; : OCT OCTAL ; HEX 12 VAR TMPHYS : SETPHYS PHYSOFF @ TO TMPHYS DUP PHYSOFF ! 1FB5 C! ; : RESPHYS TMPHYS DUP PHYSOFF ! 1FB5 C! ; : MSB MSBYTE ; : LSB LSBYTE ; ;S ( CIO CALL ROUTINES ) 340 VARIABLE IOC 0 VARIABLE IOB : IOCB 7 MIN 0 MAX 10 * DUP IOB ! 340 + IOC ! ; : .IOC @ IOC @ + ; 1 .IOC ICDNO 2 .IOC ICCOM 3 .IOC ICSTA 4 .IOC ICBAL 6 .IOC ICPTL 8 .IOC ICBLL A .IOC I1CAX B .IOC I2CAX CODE CIO TXA, PHA, IOB LDX, E456 JSR, PLA, TAX, NEXT JMP, C; CODE Get XSAVE STX, IOB LDX, E456 JSR, XSAVE LDX, PHA, 0 # LDA, PUSH JMP, C; : GET 7 ICCOM C! Get ; : CLOSE 0C ICCOM C! CIO ; : OPEN 3 ICCOM C! ICBAL ! I1CAX C! I2CAX C! CIO ; CODE ACIO XSAVE STX, BOT LDA, IOB LDX, E456 JSR, XSAVE LDX, POP JMP, C; ;S ( OS & HDW CONSTANTS 1/1 ) FORTH DEFINITIONS HEX D200 CN F1AUD D201 CN C1AUD D202 CN F2AUD D203 CN C2AUD D204 CN F3AUD D205 CN C3AUD D206 CN F4AUD D207 CN C4AUD D20F CN SKCTL D208 CN AUDCTL 230 CN DLST 22F CN DMACTL 14 CN RTCLK 2F0 CN CRSINH 2F4 CN CHBAS 2C4 CN COL0 2C5 CN COL1 2C6 CN COL2 2C7 CN COL3 2C8 CN COL4 D01F CN CONSOL 2FC CN CH 2BF CN BOTSC 52 CN LMARGN 2FB CN ATACHR 2E5 CN MEMTOP 4D CN ATRACT 4E CN DRKMSK 4F CN COLRSH D40A CN WSYNC ;S ( COLLEEN GRAPHICS 1/2 ) 3A53 VARIABLE S: 1 VARIABLE COLORC 0 VARIABLE Qbase : PBASE Qbase @ ; : GR. 1 IOCB CLOSE 0 ICBLL ! DUP F AND SWAP 30 AND 10 XOR 0C + S: OPEN MEMTOP @ 1 + F800 AND 800 - DUP Qbase ! 17F + MEMTOP ! ; : POS. 54 C! 55 ! ; 0 GR. : LOC. POS. GET ; : C. DUP COLORC ! ATACHR C! ; : SPB HIMEM @ F800 AND 800 - DUP Qbase ! 17F + HIMEM ! ; : PUT 0B ICCOM C! ACIO ; : PL. POS. COLORC @ PUT ; 2FD CN FILDAT : SE. SWAP 10 * + SWAP 2C4 + C! ; : DR. POS. 11 ICCOM C! COLORC C@ DUP ATACHR C! FILDAT C! CIO ; : GRAPHICS GR. ; : PLOT PL. ; : LOCATE LOC. ; : SETCOLOR SE. ; : COLOR C. ; : POSITION POS. ; : DRAWTO DR. ; : CLEAR 0 0 POS. 7D PUT ; : XIO18 DUP FILDAT C! ATACHR C! 12 ICCOM C! CIO ; --> ( SOUND CONTROL / P/M 2/2 ) : SOUND 3 D20F C! 0 D208 C! SWAP 10 * + 100 * + SWAP 2 * D200 + ! ; : PADDLE 270 + C@ ; : PTRIG 27C + C@ ; : STICK 278 + C@ ; : STRIG 284 + C@ ; : RND D20A C@ ; ( 22F CONSTANT DMACTL ) D01D CONSTANT GRACTL D407 CONSTANT PMBASE D01B CONSTANT PRIOR D016 CONSTANT VDELAY 2C0 CONSTANT COLPM 26F CONSTANT GPRIOR PBASE 1 - HIMEM ! : PLAYER Qbase 1+ C@ PMBASE C! 3 GRACTL C! 2 - IF 1C ELSE 0C ENDIF DMACTL @ E3 AND OR DMACTL C! ; : HPOS! D000 + C! ; ( H-posn plyr# -> ) : SIZE! D008 + C! ; ( size-code plyr# -> ) : COLPM! COLPM + C! ; ( color plyr# -> ) : NOPLY GRACTL 0SET D000 11 0 FILL ; ;S ( PON/POFF 1/1 ) ( HES 29jun82 ) FORTH DEFINITIONS 0 VARIABLE ECHR 0 VARIABLE EVTBL F ALLOT ( move E: vector table ) E400 ' EVTBL F CMOVE ( routine to send character ) ( to both P: & E: ) CODE EPUTC ECHR STA, PHA, TXA, PHA, ECHR LDA, EEA7 JSR, PLA, TAX, PLA, F6A4 JMP, C; FORTH DEFINITIONS ( sneak in EPUTC address ) ' EPUTC 1- ' EVTBL 6 + ! ( PON & POFF JUST SWITCH HATAB TABLE ADDRESSES ) : PON ' EVTBL 321 ! ; : POFF E400 321 ! ; ;S NOTE: the subroutine EPUTC will drive decompiler crazy, since it cannot find its end. ( RS232 SUPPORT 1/2 ) CODE SIO XSAVE STX, BOT LDA, E459 JSR, ( SIOV) XSAVE LDX, BOT STA, BOT 1+ STY, NEXT JMP, C; : SERR DUP 0< IF 0 100 U/ BASE @ DECIMAL ." SIO ERROR " . BASE ! QUIT ELSE DROP THEN ; CODE DORL XSAVE STX, 506 JSR, HERE 8 + JSR, XSAVE LDX, NEXT JMP, 0C ) JMP, C; : GETR: HERE 2E7 ! ( SET MEMLO ) FLUSH EMPTY-BUFFERS 150 300 ! ( DDEVIC,DUNIT) 403F 302 ! ( ? CMD,EXPECT DATA) 5 306 C! ( TIMEOUT) 500 304 ! ( BUFFER ADDR) 0C 308 ! ( LENGTH ) 0 30A ! ( AUXES ) 0 SIO SERR ( ERRORS?) 500 300 0C CMOVE 0 SIO SERR DORL ( RUN RELOCATOR ) 2E7 @ HERE - ALLOT HERE FENCE ! ; --> ( RS232 2/2 ) : R1: " R1: " DROP ; : R1OPD @@~@v@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@t@@Z@@b@@`@@B@@@@@@@@B@@B@@@@@A( LINE EDITING COMNDS 2/3 ) EDITOR DEFINITIONS : -MOVE ( MOVE IN BLOCK BUFFER ADDR FROM-2, LINE TO-1 *) LINE C/L CMOVE UPDATE ; : HL ( HOLD NUMBERED LINE AT PAD *) LINE PAD 1+ C/L DUP PAD C! CMOVE ; : BL ( ERASE LINE-1 WITH BLANKS *) LINE C/L BLANKS UPDATE ; : SL ( SPREAD MAKING LINE # BLANK *) DUP 1 - ( LIMIT ) #OFLINES 2 - ( FIRST TO MOVE ) DO I LINE I 1+ -MOVE -1 +LOOP BL ; : DL ( DELETE LINE-1, BUT HOLD IN PAD *) DUP HL #OFLINES 1 - DUP ROT DO I 1+ LINE I -MOVE LOOP BL ; : CL ( COPY LINE-2 OF SCREEN-1 TO PAD ) SCR @ >R SCR ! HL R> SCR ! ; --> ( LINE EDITING COMNDS 3/3 ) ( WFR-790105 ) : RL ( REPLACE ON LINE-1, FROM PAD ) PAD 1+ SWAP -MOVE ; : $ ( PUT FOLLOWING TEXT ON LINE-1 ) 1 TEXT RL ; : % ( INSERT TEXT FOLLOWING AFTER LINE-1 *) 1 TEXT 1+ DUP SL RL ; : IL ( INSERT PAD AFTER LINE-1 ) 1+ DUP SL RL ; : TL ( TYPE LINE BY #-1, SAVE ALSO IN PAD *) DUP . ." $ " DUP C/L * R# ! HL PAD 1+ C/L TYPE CR ; FORTH DEFINITIONS : COPY SWAP BLOCK SWAP BLOCK 400 CMOVE UPDATE FLUSH ; ;S ( VERS 1.4S MODS HES 1/3 ) FORTH DEFINITIONS HEX : HX HEX 93 2C8 C! ; DECIMAL : DX DECIMAL 68 712 C! ; : BX BINARY 248 712 C! ; HEX : BS 0008 2C5 ! ; : WS 0C00 2C5 ! ; : GS D008 2C5 ! ; : NS 94CA 2C5 ! ; EDITOR DEFINITIONS : LE EDIT LL ; : UE EDIT UL ; : N 8 PN SCR @ 1 + EDIT UL ; : P 4 PN SCR @ 1 - EDIT UL ; : L SCR @ EDIT UL ; : T 4 PN 9 PN ALT @ @ EDIT UL ; FORTH DEFINITIONS : EDT [COMPILE] EDITOR ; : UE [COMPILE] EDITOR EDITOR UE ; FORTH DEFINITIONS : LE [COMPILE] EDITOR EDITOR LE ; FORTH DEFINITIONS : L& HEX ( fast load ) 0 DUP WARNING ! DMACTL C! LOAD 22 DMACTL C! ; --> ( FAST EDIT WORDS 2/3 ) EDITOR DEFINITIONS : LIST EDLQ LIST ; : L. LIST ; ( ZIEGLER STUFF ) FORTH DEFINITIONS HEX : P SCR C@ 1- LIST ; : NL EMPTY-BUFFERS LIST ; : LS [COMPILE] EDITOR 1 + SWAP 27 53 C! DO I EDITOR TL LOOP ; : SAVE-BUFFERS FLUSH ; : ERASE-CORE EMPTY-BUFFERS ; : TRC NFA ID. ; : T ALT @ @ LIST ; CODE K XSAVE STX, TSX, 109 ,X LDA, PHA, 10A ,X LDA, XSAVE LDX, PUSH JMP, C; : ZCOLD 0 8 C! COLD ; 10 ARRAY CDAT 22 TEXT ( HES 14jul82 )" PAD 1+ CDAT 10 CMOVE : CDATE 1+ SWAP DO I BLOCK 10 + CDAT SWAP 1 CMOVE UPDATE FLUSH LOOP ; : L. LIST ; : SHOW 1+ SWAP DO I LIST LOOP ; : L SCR @ LIST ; : N SCR @ 1+ LIST ; --> ( ZIEGLER/STRIEPE V1.4S 3/3 ) FORTH DEFINITIONS : N->T SCR C@ S->D <# #S #> ; : ZERO-BLOCK SCR @ BLOCK DUP DUP 400 20 FILL " ( scr# empty block 1/1 ) ;S " ROT SWAP CMOVE 7 + N->T ROT SWAP CMOVE UPDATE FLUSH ; : LZERO 1+ SWAP DO I SCR ! ZERO-BLOCK LOOP ; EDITOR DEFINITIONS : ZERO-BLOCK EDLQ ZERO-BLOCK EDT UL ; ( FAST EDIT ENHANCEMENTS ) EDITOR DEFINITIONS : LOAD FLUSH DEPTH 0= IF SCR @ THEN LOAD ; : T. 9 PN 4 PN ALT @ @ EDIT LL ; : N. 9 PN SCR @ 1 + EDIT LL ; : P. 5 PN SCR @ 1 - EDIT LL ; : WIPE ZERO-BLOCK ; : DRAIN EMPTY-BUFFERS ; : W ."  to wipe, N to abort " KEY 4E NOT = IF WIPE THEN ; FORTH DEFINITIONS : DRAIN EMPTY-BUFFERS ; : WIPE ZERO-BLOCK ; ;S ( HIGH-LEVEL DISSASSEMBLER ) FORTH DEFINITIONS TASK DOG ' (;CODE) CFA CN .;CODE ' ;S CFA CN .;S ' BRANCH CFA CN .BR ' 0BRANCH CFA CN .0BR ' (DO) CFA CN .DO ' (LOOP) CFA CN .LOOP ' (+LOOP) CFA CN .+LOOP ' LIT CFA CN .LIT 0D6B CN .CLIT ' (.") CFA CN .(.") ' TASK CFA @ CN .: ' DOG CFA @ CN .DOES> ' COMPILE CFA CN .COMP 0 VARIABLE .IP ' BLK CFA @ CN .USR ' .;S CFA @ CN .CON ' .IP CFA @ CN .VAR 60 CN RTS, 40 CN RTI, --> ( HIGH-LEVEL DISSASSEMBLER ) : PRNAME 2+ NFA ID. ; : STRNG ( cfa--cfa prnt strng) DUP .(.") = IF PRNAME .IP @ DUP COUNT ROT OVER + 1+ .IP ! TYPE CR R> DROP ENDIF ; : LIT? ( cfa--cfa prints lit) DUP .LIT = IF PRNAME .IP @ @ . CR 2 .IP +! R> DROP ELSE DUP .CLIT = IF ." CLIT " DROP .IP @ C@ . CR 1 .IP +! R> DROP ENDIF ENDIF ; : COMP? DUP .COMP = IF PRNAME .IP @ @ PRNAME CR 2 .IP +! R> DROP ENDIF ; : PROMPT ." ok " CR ; : ENDEF ( cfa--cfa aborts@end) DUP .;CODE = OVER .;S = OR IF PRNAME CR PROMPT QUIT ENDIF ; : BRNCH ( cfa--cfa prnts dst) DUP .BR = OVER .0BR = OR OVER .LOOP = OR OVER .+LOOP = OR IF PRNAME ." to " .IP @ DUP @ + . CR 2 .IP +! R> DROP ENDIF ; --> ( DECOMP DISSASSEMBLER PBL 82) F CN OPTAB ( STD. $F ) 200 CN OPOFF 300 CN MODOFF : 1OP .IP @ DUP HH ." : " C@ 1 .IP +! DUP CHH SPACE ; ( --op) : INDX ( off base--addr) + B/BUF /MOD [ OPTAB B/SCR * ] LITERAL + BLOCK + ; : OPLUK ( op--opind modind #op) DUP + 0 INDX DUP C@ SWAP 1+ C@ 40 /MOD ; : OPANDP ( #bytes--) DUP -DUP IF .IP @ C@ CHH SPACE 1 - IF .IP @ 1+ C@ CHH ELSE 2 SPACES ENDIF ELSE 5 SPACES ENDIF ." - " -DUP IF 1 - IF .IP @ @ 2 ELSE .IP @ C@ 1 ENDIF .IP +! HH SPACE ELSE 5 SPACES ENDIF ; : MODP ( modind--) MODOFF INDX 2 TYPE SPACE ; : OPP ( opind--) OPOFF INDX 3 TYPE ." , " CR ; --> ( DECOMP DISSASSEMBLER PBL 82) : BR? ( mode #op--mode) OVER 10 = IF .IP @ DUP C@ CHH ." - " DUP C@ DUP 80 AND IF FF00 OR ENDIF 1+ + HH .IP +! SPACE ELSE OPANDP ENDIF ; : 1LINE 1OP OPLUK BR? MODP OPP ; : JMPEX ( --f test endef jmps) .IP @ C@ 4C = IF .IP @ 1+ @ DUP ASSEMBLER NEXT = OVER W 1 - = OR OVER POP = OR OVER PUSH = OR OVER PUT = OR SWAP POPTWO FORTH = OR DUP IF ENDIF ELSE 0 ENDIF ; : ;CEND .IP @ C@ DUP RTS, = SWAP RTI, = OR JMPEX OR ; : 1WRD BEGIN 1LINE ;CEND UNTIL 1LINE ; : CSEE 1WRD ; : DIS .IP ! 1WRD ; : NDIS .IP ! 0 DO 1LINE LOOP ; : ISCODE .IP @ DUP 2 - @ = IF ." primitive " CR 1WRD ELSE .IP @ CFA @ DUP 2 - @ SWAP .IP ! .;CODE = IF ." ;CODE word" CR ELSE ." odd entry point" CR ENDIF 1WRD ENDIF ; --> ( HIGH-LEVEL DISSASSEMBLER ) : ISCOL ( -- or ) .IP @ DUP CFA @ .: - IF DUP CFA @ DUP .DOES> = IF .IP @ @ .IP ! ." DOES> word" CR DROP 1 ELSE SWAP DROP DUP .CON = IF ." CONSTANT : " .IP @ @ HH CR DROP ELSE DUP .USR = IF ." USER variable " DROP CR ELSE .VAR = IF ." VARIABLE : " .IP @ DUP HH @ ." = " HH CR ELSE ISCODE ENDIF ENDIF ENDIF 0 ENDIF ELSE 1 ENDIF ; : NXTW 2 SPACES .IP @ DUP HH ." : " @ 2 .IP +! 2 SPACES LIT? BRNCH COMP? STRNG ENDEF PRNAME CR ; : FETCHW [COMPILE] ' .IP ! ISCOL IF NFA C@ 40 AND IF ." immediate" CR ENDIF ELSE PROMPT QUIT ENDIF ; : DECOMP FETCHW BEGIN NXTW ?TERMINAL IF PROMPT QUIT ENDIF AGAIN ; : DCP DECOMP ; : ZZ DECOMP ; ;S ( CONSTANT INFO DISPLAY 1/3 ) FORTH DEFINITIONS TBL XTRN 40 C, 0 C, 20 C, 60 C, CODE ASCINT BOT LDA, .A ROL, .A ROL, .A ROL, .A ROL, 03 # AND, TAY, BOT LDA, 9F # AND, XTRN ,Y ORA, BOT STA, NEXT JMP, C; : SYPE ( addr, straddr, cnt ) OVER + SWAP DO I C@ ASCINT OVER C! 1+ LOOP ; HERE DUP 3F + FFC0 AND SWAP - ALLOT 28 ARRAY BUF TBL DLIST 5070 , 42 C, BUF , 1 C, 0 , HERE 2 - CN DLPTCH --> ( CONSTANT INFO DISPLAY 2/3 ) ' ABORT 6 + @ VARIABLE ABORT1 ' QUIT A + @ VARIABLE QUIT1 : INIT 0 DMACTL C! DLST @ DUP C@ 1 - IF DUP 3 + DLPTCH ! 1 OVER C! DLIST SWAP 1+ ! ELSE DROP THEN 22 DMACTL C! ; : DSPLY BUF " TOS= " SYPE >R ASSEMBLER UP FORTH @ 6 + @ SP@ 10 + MIN SP@ BEGIN 2+ OVER OVER > WHILE R> OVER @ 0 <# # # # # #> SYPE 1+ >R REPEAT DROP DROP R> " fig-FORTH 1.4S" SYPE DROP ; : SSK DSPLY INIT CR BASE @ DUP A = IF 44 2C8 C! ELSE DUP 10 = IF 93 2C8 C! ELSE DUP 2 = IF F8 2C8 C! ELSE DUP 4 2C8 C! ENDIF ENDIF ENDIF DROP ; : FIX\ DROP ." " ; : STACKON ( HES MOD 12jun82 )( ' ABORT 6 + @ ABORT1 ! ) ( ' QUIT A + @ QUIT1 ! ) ' SSK CFA ' ABORT 6 + ! ' SSK CFA ' QUIT A + ! ' FIX\ CFA ' \ 40 + ! ; --> ( CONST. INFO. / CDUMP 3/3 ) : STACKOFF ABORT1 @ ' ABORT 6 + ! QUIT1 @ ' QUIT A + ! 2C5 @ 2C8 C@ 0 GR. 2C8 C! 2C5 ! ; : STON STACKON ; : STOF STACKOFF ; ( HES V.1.0 82AUG7 ) : CDUMP ( adr1 adr2 --- ) 1 2FE C! 1+ SWAP DO I HH ." :" SPACE I 8 0 DO DUP I + C@ EMIT 2 SPACES LOOP DROP ." \" CR 8 +LOOP 0 2FE C! ;