(:2K 𩓍ЩЍЩR     S `I0ݭ  s4`D3BULL#2#2)@10V11p1(12Y(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ȃ@10T;12H2O322DEFINITIONf|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(TBgw"0ALLO=0ARRAg0w0:|:)NO9('U](0C 0("=@0D18 ">1DEPT8 -m1."v1 (8 8 v1m-C0-%Mf[(8  e!51SAVENFA]M8 8 f8 |8 "fC0 1V1.42 R'SЍ`1#SECK%2CALLD:2 SHLK p1DKI8 8 8 82=N !ERROR 8 ]|%R'SЍ`1r/8 e9 | ]92#SECL2CALLD2 SHLK 1DKI8 8 8 2=N1MSBYT]8  %2LSBYT8 ]2>=$38 % 31IO1PI3IO1S3IOC8 T]l8 =W38 @M303.IOg w|M3|]3ICDNσ33ICCO̓33ICST33ICBÃ33ICPT̃33ICBL̃33I1CA؃3 3I2CA؃3 92CI4HY3 VhLR Y(Ge,4Y3 VHLK &4GE8 3*44CLOS8 34>4OPEu333 4( SCREEN INDEX REV H 1/1 ) ;S ̠Š٠9ӠϠΠҠΠӠ̠00/00 SCREEN INDEX 01/01 SOURCE CREDITS 02/06 ERROR MESSAGES 007/0A SYSTEM SETUP / BOOTMAKER 0B/0E SUPERCLONE 0F/0F DECOMP DISSEMBLER DATA ŠҠ10/10 EDITOR LOADER 11/14 SCREEN EDITOR 15/17 LINE EDITOR 18/1A EDITOR ADDITIONS 61B/22 DECOMP/STACKDSP/CDMP/PATCH23/24 COPIES/DUPLICATE 25/26 FIND 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/3A PLAYER/MISSILE 3B/3B LINK/SETPHYS 3D/3E LPWORDS 340/44 FORMATTED LIST PROGRAM 45/4A CHARSETS/CASE 4B/4F FORTH79/VAR/SETSYS/BDUMP * fig-FORTH MODEL *E Through the courtesy ofJ 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 - 10/16/82 XL Mods - John Stanley 18Jun85 RELEASE 1.4S REV.H 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 DRIVE 2 LINK/UNLINK Further distribution must 'include the above notice. Abort.4 IOCB already open.. Non-existant device., IOCB is write-only.- !Invalid command (for this device) Device or file not open.( Bad IOCB #6 IOCB is read-only/ End Of File5 Truncated Record0 Device Timeout2 !Device NAK (Negative AcKnowledge) Serial Bus input framing error" Cursor out of range- Serial Bus data-frame overrun# %Serial Bus data-frame checksum error. Device-done error/ Read-after-write compare error" #Function not implemented in handler Insufficient RAM0 0( ERROR MESSAGES ) 135 159 9 8 7 10 ;S empty stack5 dictionary full1 has incorrect address mode& isn't uniquet disc range ??3 full stack !4 disc error !t THIS IS IT6 HELP ME!8 ( ERROR MESSAGES ), #compilation only, use in definition execution only2 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 )A #below lower bound of virtual memory 'disc compiler assembly error in mode of can't find in TARGET, target redef.3 !T: error, is it paired with T; ? above virtual memory bounds& ( SYS/BOOTMKR 82AUG22 1/4 ) 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;G 9: DKIO 301 ! ( CMD, DRIVE # ) 30A ! ( SECT. # ) 304 ! S( 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 ! Y52 302 C! SECIO ; : FORMAT ." FORMAT DRIVE " DUP . ." -ARE YOU SURE?" 0 PAD ! PAD 1 8EXPECT PAD C@ 59 ( Y) = IF 2100 OR PAD 0 ROT DKIO ELSE DROP THEN ; x0 VARIABLE BOOT ( ->CODE ) --> ( SYS SET UP/BOOTMKR 2/4 ) : 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 ) zASSEMBLER 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, 9ENDIF, 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/4 ) ( 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/4 )% : 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! ;D : HOOK ( hooks your assembly ) ( routine into WARMSTRT ) ( ->use HOOK word ) [COMPILE] ' ' V1.4S 1+ ! ;# : UNHOOK ( restore vector ) E4C0 ' V1.4S 1+ ! ;h $CR ." system words now available" CR; ;S= ( SIO DISK HNDLR 1/2 ) HX 0 DMACTL C! : CLNDSP ." }" C 4 POS. ." ҠŠ" ;& CODE SIO XSAVE STX, BOT LDA, E459 JSR, XSAVE LDX, BOT STY, BOT 1+ STA, NEXT JMP, C; : SERR DUP 0< IF 0 100 U/ BASE @ DECIMAL ." ERROR " SWAP . BASE ! THEN DROP ; 246 CONSTANT DSKTIM [: DSIO ( DISK HNDLR VIA SIO ) ( BADDR AUXS UNIT-CMD DATFLG ) 303 C! ( SET DATA-FLAG ) 9301 ! ( DUNIT,CMD) 31 300 C! ( DEVICE) 30A ! ( AUXES ) 304 ! ( BUFER-ADDR ) 0 SIO ;" : DIO DSKTIM @ 306 C! 80 308 ! ( BUFLEN) DSIO ; : RDSEC 5200 OR 40 DIO ; : WTSEC 5700 OR 80 DIO ; : PTSEC 5000 OR 80 DIO ; %: FORMAT PAD 0 ROT 2100 OR 40 DIO ; ^: STATUS 4 308 ! 1 306 ! 2EA 0 ROT 5300 OR 40 DSIO SERR ; : BAILOUT CONSOL C@ 2 AND 0= ;! --> ( BADSEC WORDS ) TBL GRBGSECT 38A0 , B9 C, 8C , 99 C, 180 , 88 C, F710 , 60 C, 20 C, D76 , 390 , 4C C, 924 , 20 C, E85 , 20 C, F32 , 20 C, E0A , 20 C, E8A , 20 C, FCD , 20 C, CCF , 57A9 , 85 , 3FA2 , 1370 , 2C C, 380 , F910 , DAA9 , 385 , CA C, F410 , %2FA9 , 85 , 4C C, B7D , 4C C, B87 , (40 ARRAY ZERO-SECT ZERO-SECT 80 ERASE CODE SIO XSAVE STX, E459 JSR, 0< IF, 1 # LDA, ELSE, 0 # LDA, ENDIF, PHA, 0 # LDA, XSAVE LDX, PUSH JMP, C; 1: 1ERR? IF ." CAN'T DOWNLOAD" CR ABORT THEN ; w: 2ERR? IF ." CAN'T WRITE BAD" ." SECTOR" CR ABORT THEN ; : BINIT 2001 301 ! ( DOWNLOAD TO D1: ) GRBGSECT 304 ! 580 DUP 303 C! 308 ! 7 306 C! 31 300 C! SIO 1ERR? ; BINIT : BADSEC 30A ! FF01 301 ! ZERO-SECT 304 ! 80 DUP 303 +C! 308 ! 7 306 C! 31 300 C! SIO 2ERR? ; --> ( SUPER-CLONE WORDS ) 180 ARRAY BDSECTS : WSTRT ." PRESS START " CR BEGIN CONSOL C@ 1 AND END [BEGIN CONSOL C@ 1 AND 0= END 0 4D C! 5 A POS. ." DOING IT..." ; : GSRC 0 GR. 2 C 4 SE. 10 8 POS. ." READING" ; : GDST 0 GR. 2 3 4 SE. 10 8 POS. ." WRITING" ; : RSOME ( START SECT., CNT ) :0 DO I 80 * PAD + OVER 2 RDSEC FE AND BDSECTS I + C! BAILOUT IF LEAVE ENDIF 1+ LOOP DROP ; : WSOME ( START SECT., CNT ) r0 DO DUP I BDSECTS + C@ IF BADSEC ELSE I 80 * PAD + SWAP 1 PTSEC 1 = 0= IF 8 ERROR THEN THEN 1+ LOOP DROP ; Q: COPY-SOME ( START, CNT ) OVER OVER GSRC RSOME GDST WSOME ; 0 VARIABLE ROOM U: SUPER-CLONE2 ." SOURCE DISK IN DRIVE #2" CR ." DESTINATION IN DRIVE #1" CR WSTRT YHIMEM @ PAD - 80 / ROOM ! 1 2D0 BEGIN DUP 0 > WHILE OVER OVER ROOM @ MIN COPY-SOME 8ROOM @ - SWAP ROOM @ + SWAP REPEAT DROP DROP 0 GR. ; --> ( SUPER-CLONE WORDS 3/3 )) 180 ARRAY BDSECTS 8: WSTRT ." PRESS " KEY CR DROP ." Doing it " ;( : CLNMSG CR =." Source disk in Dr 2," CR ." Destin disk in Dr.1," CR ;! : RSOME ( START SECT., CNT ) :0 DO I 80 * PAD + OVER 2 RDSEC FE AND BDSECTS I + C! BAILOUT IF LEAVE ENDIF 1+ LOOP DROP ; : WSOME ( START SECT., CNT ) r0 DO DUP I BDSECTS + C@ IF BADSEC ELSE I 80 * PAD + SWAP 1 WTSEC 1 = 0= IF 8 ERROR THEN THEN 1+ LOOP DROP ; V: COPY-SOME ( START, CNT ) OVER OVER SPACE RSOME SPACE WSOME ; 0 VARIABLE ROOM : CLONE lCLNMSG WSTRT HIMEM @ PAD - 80 / ROOM ! 1 2D0 BEGIN DUP 0 > WHILE OVER OVER ROOM @ MIN COPY-SOME JROOM @ - SWAP ROOM @ + SWAP REPEAT DROP DROP CR BELL ; : BADM WSTRT >2D1 1 DO I BADSEC LOOP ; 0 GR. GS DMACTL C! BASE ! ;S !iDi@ @oiB i PiF iH H*i*i WD@@x@uBxxPF HxH xHDH@c@lHBcTHc$PHF HHcH0H HcD@rB{T'PF HD@@@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 ) 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) HEX 11 LOAD ( SCREEN EDIT ) 18 LOAD ( ENHANCEMENTS ) 23 LOAD ( copies/backup ) 25 LOAD ( FIND WORD ) 3D LOAD ( PRINTER WORDS ) 4D LOAD ( SYS WORDS ) 3F LOAD ( PNS STUFF ) : VERIFY 57 245E C! ; : NOVERIFY 50 245E C! ; : SYS 0 DMACTL C! 7 LOAD 22 7DMACTL C! ; : CLONE B LOAD ; CODE GOBOOT E477 JMP, C; : GO STACKON GS ; : ZV VLIST ; : WARNON 1 WARNING ! ; : WARNOFF 0 WARNING ! ; ;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, 7DRKMSK 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@ MF 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 8 SOUND LOOP 0 SNDOFF THEN ; --> !( SCREEN ED. DLSETMOD 2/4 ) ( JDS 18JUN85 ) 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 @ VARIABLE KBDVC CODE KCHK 54 LDA, 10 # CMP, 0< IF, D209 LDA, C # CMP, 0= IF, PLA, RTI, THEN, 9THEN, KBDVC ) JMP, C; CODE EDKIS SEI, 209 LDA, C4 # CMP, >= IF, KBDVC 1+ STA, [208 LDA, KBDVC STA, THEN, ' KCHK LSB # LDA, 208 STA, ' KCHK MSB # LDA, 209 STA, #CLI, NEXT JMP, C; CODE EDKIQ SEI, KBDVC LDA, 208 STA, KBDVC 1 + 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 ! CHRST C@ CHBAS C! ; : 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 ;D L: .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# 30 DUP 2FE C! 2F0 C! 6 PN ; : LL 200 ULL 10 .L# 0 DUP 2FE C! 2F0 C! 7 PN ; -->6 ( SCREEN EDITOR 1.4S 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 : COPY FORTH COPY ; : FLUSH FORTH FLUSH ; : FH FLUSH ;2 : 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 HEXH : 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 DMINUS AND IF ." NOT ON SCREEN" ABORT ENDIF ( KEEP ON THIS SCREEN ) SCR @ (LINE) DROP ;C : WHERE V( PRINT SCREEN # AND IMAGE OF ERROR *) DUP B/SCR / DUP SCR ! ." SCR # " . 5SWAP C/L /MOD C/L * ROT BLOCK + CR C/L TYPE = ( 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 ;c : $ ( PUT FOLLOWING TEXT ON LINE-1 ) 1 TEXT RL ;l : % '( INSERT TEXT FOLLOWING AFTER LINE-1 *) 1 TEXT 1+ DUP SL RL ; : IL 1( 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, 9: COPY SWAP BLOCK SWAP BLOCK 400 CMOVE UPDATE FLUSH ; ;S ( VERS 1.4S MODS HES 1/3 ) FORTH DEFINITIONS HEX r: HX HEX 93 2C8 C! ; DECIMAL : DX DECIMAL 68 712 C! ; : BX BINARY 248 712 C! ; HEX : BS 0006 2C5 ! ; : WS 0A00 2C5 ! ; : GS D006 2C5 ! ; : NS 94CA 2C5 ! ; EDITOR DEFINITIONS : LE EDIT LL ; : UE EDIT UL ; Y: 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 ; : SL DUP SL 10 < IF UL ELSE LL THEN ;. 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 ) ( ZIEGLER/STRIEPE STUFF ) FORTH DEFINITIONS HEX 3: L. LIST ; : L SCR @ LIST ; : N SCR @ 1+ LIST ; : P SCR @ 1- LIST ; : NL EMPTY-BUFFERS LIST ; w: SHOW 1+ SWAP DO I LIST LOOP ; : 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 ; PCODE K XSAVE STX, TSX, 109 ,X LDA, PHA, 10A ,X LDA, XSAVE LDX, PUSH JMP, C; : EMPTY 0 8 C! COLD ; D ARRAY CDAT 22 TEXT ... ." PAD 1+ CDAT C CMOVE : DATE 1+ SWAP DO I BLOCK 11 + CDAT SWAP C CMOVE UPDATE FLUSH LOOP ; +: NEWDATE CR ." DATE: " CDAT C TYPE ."  " QUIT ; \: DATE: 9B TEXT PAD 1+ CDAT C CMOVE ; EDITOR DEFINITIONS : DATE SCR @ BLOCK 11 + CDAT ASWAP C CMOVE UPDATE UL ; : LIST EDLQ LIST ; : L. LIST ; --> 3( 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 5EDLQ ZERO-BLOCK EDT UL ; : NUL EMPTY-BUFFERS UL ; : NLL EMPTY-BUFFERS LL ; : LOAD FLUSH DEPTH 0= IF SCR @ THEN LOAD ; t: 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 .IP0 ' 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. ;+ y: 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 ;1 N: COMP? DUP .COMP = IF PRNAME .IP @ @ PRNAME CR 2 .IP +! R> DROP ENDIF ;2 : PROMPT 0 2FE ! ." 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) M: INDX ( off base--addr) + B/BUF /MOD [ OPTAB B/SCR * ] LITERAL + BLOCK + ;3 J: OPLUK ( op--opind modind #op) DUP + 0 INDX DUP C@ SWAP 1+ C@ 40 /MOD ;6 [: 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 ;3 1: OPP ( opind--) OPOFF INDX 3 TYPE ." , " CR ;/ -->= V( DECOMP DISSASSEMBLER PBL 82) : BR? ( mode #op--mode) OVER 10 = IF .IP @ DUP C@ CHH Y." - " DUP C@ DUP 80 AND IF FF00 OR ENDIF 1+ + HH .IP +! SPACE ELSE OPANDP ENDIF ; : 1LINE 1OP OPLUK BR? MODP OPP ; h: 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 ;+ 6: ;CEND .IP @ C@ DUP RTS, = SWAP RTI, = OR JMPEX OR ;* 7: 1WRD BEGIN 1LINE ;CEND UNTIL 1LINE ; : CSEE 1WRD ;) 3: 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 vELSE .VAR = IF ." VARIABLE : " .IP @ DUP HH @ ." = " HH CR ELSE ISCODE ENDIF ENDIF ENDIF 0 ENDIF ELSE 1 ENDIF ;H : NXTW 2 SPACES .IP @ DUP HH O." : " @ 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 ;" 3: DECOMP 1 2FE C! FETCHW BEGIN NXTW ?TERMINAL IF PROMPT QUIT ENDIF AGAIN ;% : ZZ DECOMP ; ;S 3( CONSTANT INFO DISPLAY 1/3 ) FORTH DEFINITIONS- HEX 4E LOAD4 TBL XTRN 40 C, 0 C, 20 C, 60 C,! CODE ASCINT BOT LDA, 7.A ROL, .A ROL, .A ROL, .A ROL, 03 # AND, TAY, BOT LDA, 9F # AND, XTRN ,Y ORA, BOT STA, NEXT JMP, C;) 5: SYPE ( addr, straddr, cnt ) OVER + SWAP DO I C@ ASCINT OVER C! 1+ LOOP ; HERE DUP 3F + FFC0 AND SWAP - ALLOT3 28 ARRAY BUF4 TBL DLIST 5070 , 42 C, BUF , 1 C, 0 ,% HERE 2 - CN DLPTCH. -->= s( 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 CHRST C@ CHBAS C! ;- ': STACKON ( HES MOD 12jun82 ) ' 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.2.0 82SEP9 ;) :  ( FETCHES LETTERS AND ! ) 7E TEXT 10 0 DO DUP PAD 1+ I + C@ SWAP I + C! LOOP DROP PAD FIX QUIT ;# : CDUMP ( adr1 adr2 --- ) 1 2FE C! 1+ SWAP DO I HH ."  " I 10 0 DO DUP I + C@ EMIT LOOP DROP SPACE 7E EMIT CR 10 +LOOP 0 2FE C! ; : PATCH \ new old --- JAP AUG82 [COMPILE] ' CFA [COMPILE] ' DUP >R ! ' ;S CFA R> 2+ ! ; \ Debugging ML rout HES17OCT82 CODE JMP \ INDIRECT JMP/ML DEBUG BOT LDA, N STA, BOT 1+ LDA, N 1+ STA, N ) JMP, C; CODE JSR \ INDIRECT JSR/ML DEBUG XSAVE STX, ' JMP JSR, XSAVE LDX, POP JMP, C; ;S ( ONE DRIVE.DUPSCR/COPS1/2 ) ( by anonymous/HES 23jun82 ) 0 VARIABLE EBLK ( ENDING BLK ) 0 VARIABLE SBLK ( START. BLK ) 0 VARIABLE PSBLK y: DISP ( -> DEST ADR INFRE RAM ) PSBLK @ B/BUF * HERE 20 + + ; : GTPAR ( SET UP DO AND PSBLK ) EBLK @ SBLK @ 0 PSBLK ! ; W: 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 @ + FSWAP 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 20 - 400 / )> IF ." TOO MANY " QUIT ENDIF CR MVIN O." INSERT DESTINATION DISK " CR ." RETURN TO CONTINUE " KEY DROP CR MOVOT ; --> ( COPIES HES 2/2 ) ( 82JUN18 / 82AUG14 ) FORTH DEFINITIONSm 4: CPST CR ." ? Incorrect screen range" CR QUIT ; : CPNT CR ." scr# " SWAP DUP . T." --> " 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 b1/2 ) ( by R.Mansfield/COMPUTE! ) ( adapt.&enhanced HES 82aug7 ) FORTH DEFINITIONS HEX) 0 VARIABLE 1STCHAR, T: ?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 )% 5CODE ?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;$ 1: ONEBLK ( scr# addr --- ) DUP 400 + SWAP DO I ?CHAR IF I CHECKIT IF I MARKSTRING ENDIF ENDIF LOOP DROP ;0 : 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 ) ( OREZ / HES 15sep82 ) ( Already in kernel, doc.only) FORTH DEFINITIONS HEX 4F LOAD : NOT 0= ; : U. 0 D. ; : CN CONSTANT ;1 X: (") 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 ; ( .HES 82AUG21 ) CODE V1.4S ( DOSINI VECTOR ) E4C0 JSR, ( APPL.HOOK ) :0 # LDA, 52 STA, ( MARGN ) 27 # LDA, 53 STA, ( " ) ;6 # LDA, 2C5 STA, D0 # LDA, 2C6 STA, 93 # LDA, 2C8 STA, ( SCREEN COLORS ) RTS, C;J ;S ( FORTH-65 ASSEMBLER 1/6 ) ( WFR-79JUN03 ) HEX= @VOCABULARY ASSEMBLER IMMEDIATE' ASSEMBLER 2 + DUP 20 +ORIGIN ! VOC-LINK ! ASSEMBLER DEFINITIONS ( LOCATE EXISTING REGISTERS )" PFF CONSTANT XSAVE 0FB CONSTANT W 0FD CONSTANT UP F8 CONSTANT IP F0 CONSTANT NW %( LOCATE EXISTING CODE PROCEEDURES ) b' (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 -->9 ( FORTH-65 ASSEMBLER 2/6 ) ( WFR-78OCT03 ) 0 VARIABLE INDEX -2 ALLOT$ o0909 , 1505 , 0115 , 8011 , 8009 , 1D0D , 8019 , 8080 , 0080 , 1404 , 8014 , 8080 , 8080 , 1C0C , 801C , 2C80 ,4 2 VARIABLE MODE/ 0: .A 0 MODE ! ; : # 1 MODE ! ; : MEM 2 MODE ! ; O: ,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 ) -->Z ( UPMODE, CPU 3/6 ) ( WFR-78OCT23 )D ?: UPMODE IF MODE C@ 8 AND 0= IF 8 MODE +! ENDIF ENDIF 51 MODE C@ 0F AND -DUP IF 0 DO DUP + LOOP ENDIF OVER 1+ @ AND 0= ;d +: CPU C@ C, MEM ; 400 CPU BRK, 18 CPU CLC, D8 CPU CLD, 58 CPU CLI, 4B8 CPU CLV, CA CPU DEX, 88 CPU DEY, E8 CPU INX, 4C8 CPU INY, EA CPU NOP, 48 CPU PHA, 08 CPU PHP, 468 CPU PLA, 28 CPU PLP, 40 CPU RTI, 60 CPU RTS, 438 CPU SEC, F8 CPU SED, 78 CPU SEI, AA CPU TAX, 4A8 CPU TAY, BA CPU TSX, 8A CPU TXA, 9A CPU TXS, 98 CPU TYA,0 -->} _( M/CPU, MULTI-MODE 4/6 ) ( OP-CODES WFR-79MAR26 ) : M/CPU ( 3DUP 1+ C@ 80 AND IF 10 MODE +! ENDIF OVER 3FF00 AND UPMODE UPMODE IF MEM CR LATEST ID. 3 ERROR ENDIF C@ MODE C@# 3INDEX + C@ + C, MODE C@ 7 AND IF MODE C@ 40F AND 7 < IF C, ELSE , ENDIF ENDIF MEM ;H :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 E: 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@ fIF SWAP ! ELSE OVER 1+ - SWAP C! ENDIF ; IMMEDIATE : ELSE, 2 ?PAIRS HERE 1+ 1 JMP, 2SWAP HERE OVER 1+ - SWAP C! 2 ; IMMEDIATE : NOT 20 + ; +( REVERSE ASSEMBLY TEST ) 90 CONSTANT CS 1( ASSEMBLE TEST FOR CARRY SET ) D0 CONSTANT 0= 3( ASSEMBLER TEST FOR EQUAL ZERO ) 10 CONSTANT 0< d( ASSEMBLE TEST FOR LESS THAN ZERO ) 90 CONSTANT >= ( ASSEMBLE TEST FOR GREATER OR EQUAL ZERO ) 4( >= IS ONLY CORRECT AFTER SUB, OR CMP, ) CR -->x ( USE OF ASSEMBLER 6/6 ) ( WFR-79APR28 ) : C; W( END OF CODE DEFINITION *) CURRENT @ CONTEXT ! ?EXEC ?CSP SMUDGE ; IMMEDIATEE FORTH DEFINITIONS. : CODE '( CREATE WORD AT ASSEMBLY CODE LEVEL *) #?EXEC CREATE [COMPILE] ASSEMBLER ASSEMBLER MEM !CSP ; IMMEDIATE 'DECIMAL ;S ( TILL figFORTH IS UP ) b' ASSEMBLER CFA ' ;CODE 8 + ! ( OVER-WRITE SMUDGE ) FORTH DEFINITIONS DECIMAL ;S #LATEST 12 +ORIGIN ! ( TOP NFA ) !HERE 28 +ORIGIN ! ( FENCE ) HERE 30 +ORIGIN ! ( DP )" 2' ASSEMBLER 6 + 32 +ORIGIN ! ( VOC-LINK ) HERE FENCE ! ;S- ( compile assembler 1/1 ) ; /: ALLOC DUP + ALLOT ; ( FOR RAM BASED SYSTEMS,) : ARRAY ;$ ;S :( FULL UTILITY LOAD REV H HES ) FORTH DEFINITIONS HEX ;( VLIST patches HES17OCT82 ) : v1 ( patch beginning ) 1 2FE C! ; : v2 ( patch SPACE after ID.) 55 @ D < IF D 55 ! ELSE 55 @ 1A < IF 1A 55 ! ELSE CR THEN THEN ; : v3 ( patch last CR ) CR 0 2FE C! ; ' v1 CFA ' VLIST 6 + ! ' DUP CFA ' VLIST 55 + ! ' v2 CFA ' VLIST 95 + ! ' v3 CFA ' VLIST 9B + ! ;800 ' DR1 2 + ! ( FX DR1 - 810) HEX 4C LOAD ( VAR/VALUE ) HEX 4A LOAD ( PICK/ROLL ) HEX 45 LOAD ( CASE ) HEX 46 LOAD ( CHRSET ) HEX 4B LOAD ( FIG 79 ) HEX 31 LOAD ( CIO/GRAPH ) HEX 36 LOAD ( PON/POFF ) HEX 37 LOAD ( RS 232C ) HEX 39 LOAD ( DISPLLST ) HEX 3B LOAD ( DRIVE LINK) HEX 10 LOAD ( EDITOR ) FORTH DEFINITIONS NOVERIFY GO 1 CHR ;Sd !( 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 ; HEX : OCTAL 8 BASE ! ; : OCT OCTAL ; HEX. : TASK ;) 1: MSBYTE 0 100 U/ SWAP DROP ; : LSBYTE FF AND ; =: MSB MSBYTE ; : LSB LSBYTE ; : >< 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 - ;+ ;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 fCODE 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 ;' 1: OPEN 3 ICCOM C! ICBAL ! I1CAX C! I2CAX C! CIO ; 0CODE 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 )$ 33A53 VARIABLE S: 1 VARIABLE COLORC 0 VARIABLE Qbase : PBASE Qbase @ ; +: GR. 1 IOCB CLOSE 0 ICBLL ! DUP F AND SWAP 630 AND 10 XOR 0C + S: OPEN MEMTOP @ 1 + F800 AND 800 - 0DUP 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. ; Z: 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@ ; 1( 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 ) ( JDS 18jun85 ) FORTH DEFINITIONS E406 @ 1+ VARIABLE EOUTC E436 @ 1+ VARIABLE POUTC 0 VARIABLE ECHR 0 VARIABLE EVTBL F ALLOT 1( routine to send character ) ( to both P: & E: !) CODE PPUTC POUTC ) JMP, RTS, C; CODE EPUTC ECHR STA, PHA, TXA, PHA, OECHR LDA, ' PPUTC JSR, PLA, TAX, PLA, EOUTC ) JMP, C; FORTH DEFINITIONS/ : PON E406 @ 1+ EOUTC ! E436 @ 1+ POUTC ! E400 ' EVTBL F CMOVE ' EPUTC 1- ' EVTBL 6 + ! ' EVTBL 321 ! ; : POFF E400 321 ! ;+ ;S> NOTE: the subroutine EPUTC will drive decompiler crazy, since it cannot find its end.6 ( 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 @ 8DECIMAL ." 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 ) kFLUSH EMPTY-BUFFERS 150 300 ! ( DDEVIC,DUNIT) 403F 302 ! ( ? CMD,EXPCT DATA) 5 306 C! ( TIMEOUT) 500 304 ! ( BUFFER ADDR) 0C 308 ! ( LENGTH ) 0 30A ! ( AUXES ) 0 SIO SERR ( ERRORS?) U500 300 0C CMOVE 0 SIO SERR DORL ( RUN RELOCATOR ) 2E7 @ HERE - ALLOT HERE FENCE ! ;, : R1: " R1: " DROP ;, ;S ( other words not needed )# --> ( RS232 2/2 )d !: R1OPEN 0 8 R1: OPEN ICSTA CH? ; !: RYPE -DUP IF 1 IOCB 0B ICCOM C! ICBLL ! ICBAL ! CIO 20 ICCOM C! 0 I1CAX ! CIO ELSE DROP THEN ; : CRR 0A9B SP@ 2 RYPE DROP ; 8: REMIT SP@ 1 RYPE DROP ; : SET9600 1 IOCB 0E I1CAX ! 24 ICCOM C! R1: ICBAL ! CIO ICSTA CH? ;/ : LINER SCR @ (LINE) -TRAILING RYPE ; 100 VARIABLE LSPD/ ": LISTR DUP SCR ! CRR " SCR#" RYPE 70 <# #S #> RYPE CRR 10 0 DO I 0 <# # # #> RYPE I LINER CRR LOOP ; ;S ( DISPLAY LIST STUFF 1/1 ) HEX 0 VARIABLE 3BYT 0 VARIABLE DLADR : DINST DLADR @ C@ DUP 0F AND IF $DUP 0F AND 1 = IF 40 AND IF ." JVB " &ELSE ." JMP " ENDIF DLADR 1+! DLADR @ *@ DUP DLADR ! HH 3BYT 0SET ELSE DUP 0F AND 8 OVER < IF ." MAP" ELSE ." CHR" !ENDIF 7 AND . DUP 10 AND IF ." H" !THEN DUP 20 AND IF ." V" THEN DUP 80 AND IF ." I" ENDIF DUP 0B0# AND IF DUP 40 AND IF ." ," ENDIF $ENDIF 40 AND IF 3 DLADR @ 1+ H? ELSE !1 ENDIF 3BYT ! ENDIF ELSE ." BLK" DUP 80 AND IF ." I," ENDIF 70# AND 10 / . 1 3BYT ! ENDIF CR$ 3BYT @ DLADR +! ; ;S, U( PLAYER/MISS.STUFF-RZ 1/1 ) HEX 0 VARIABLE 0VP 64 VARIABLE 0HP 0 VARIABLE 0VPOLD ( : SPB HIMEM @ 1+ F800 AND 800 - DUP Qbase ! 17F + HIMEM ! ; ) >: GETPS 0VP ! ROT BLOCK ROT + Qbase @ 400 + 0VP @ + ROT CMOVE ; : SPLAY 0 0 HPOS! 7 GR. SPB Qbase 1+ C@ PMBASE C! 2A 0 COLPM! 0 0 SIZE! 3E D400 C! 3E DMACTL C! 3 GRACTL C! 1C 20 8 64 GETPS ; <: CLRPM Qbase @ 800 ERASE ; : MOVEH 0 STICK F XOR C AND DUP IF 2 / 3 - ENDIF 0HP @ + DUP 0HP ! 0 HPOS! ; : VPOS! 0VPOLD @ 9C00 + DUP 39800 8 CMOVE 8 ERASE 9C00 + 9800 SWAP 8 CMOVE ; : MOVEV 0 STICK F XOR X3 AND DUP IF 2 * 3 - ENDIF -DUP IF 0VP @ DUP 0VPOLD ! + DUP 0VP ! VPOS! ENDIF ; : RUNIT BEGIN MOVEH MOVEV 2FC C@ FF = NOT END ; : B/H DUP HEX ."  'HEX =" . DECIMAL ." DEC.=" . BIN QUIT ; HEX ;S& \ 3B DRIVE LINK 1/1 : r/w 301 C@ 1 = IF @ ELSE DROP 0 ENDIF ;3 : UNLINK EMPTY-BUFFERS DR0 ' r/w CFA ' R/W B1 + ! ;$ : LINK EMPTY-BUFFERS DR0 +' @ CFA ' R/W B1 + ! ; 1A VAR TMPHYS0 \ SETS BOTH DRIVES. : SETPHYS 1FB5 C@ 1FCE C@ 100 * + TO TMPHYS DUP =LSB 1FB5 C! MSB 1FCE C! DR0 ; : RESPHYS TMPHYS @ DUP LSB 1FB5 C! MSB 1FCE C! DR0 ; ;S \ scr# 3C empty block 1/1 ;S ( LINE PRINTER WORDS 1/2 ) ( 0181 SRC ) 3A50 VARIABLE P: CODE PCIO XSAVE STX, 70 # LDX, E456 JSR, XSAVE LDX, TYA, PHA, PUSH JMP, C; 0 VARIABLE LPCNT : PERR? DUP 0< IF FF AND ." P: ERROR " ERROR THEN DROP ; 7: LPOPEN 3 3B2 C! P: 3B4 ! 2 3B8 ! 8 3BA ! PCIO PERR? ; : LYP1 3B8 ! 3B4 ! 0B 3B2 C! PCIO PERR? ; : LPEMIT SP@ 1 LYP1 DROP ; : LPCR 9B LPEMIT 1 LPCNT +! ; : LYPE DUP IF DUP 50 > IF 1 LPCNT +! THEN LYP1 ELSE DROP DROP THEN 20 SP@ 1 LYP1 DROP ; : CRLP LPCR LPCNT @ 3D > IF LPCR LPCR LPCR LPCR 0 LPCNT ! THEN ; -: FFLP CRLP BEGIN LPCNT @ WHILE CRLP REPEAT ; N: SHRINK 1B LPEMIT 14 LPEMIT CRLP ; : EXPAND 1B LPEMIT 13 LPEMIT CRLP ; : .CLP 0 <# # # #> LYPE ; : .LP 0 <# #S #> LYPE ; : LINELP DUP .CLP SCR @ (LINE) -TRAILING 1 MAX LYPE CRLP ; 4353 VARIABLE SCR# 2052 , 2023 , : LISTLP DUP SCR ! SCR# 6 LYPE .LP LPCR B/SCR B/BUF * C/L / 0 DO I LINELP LOOP ; --> 0( LINE PRINTER WORDS 2/2 ) ( 1/27/81 SRC ) <: LPSPC 0 DO 20 LPEMIT LOOP ; : SHOWLP 1+ SWAP C/L 20 = IF DO CRLP SCR# 6 LYPE I .LP 1F LPSPC SCR# 6 LYPE I 1+ .LP CRLP I 20 0 DO DUP SCR ! I .CLP I SCR @ (LINE) LYPE 5 LPSPC DUP 1+ SCR ! I LINELP LOOP DROP 2 +LOOP ,ELSE DO CRLP I LISTLP LOOP ENDIF FFLP ;2 : LPINDEX 1+ SWAP DO I .LP &0 I (LINE) -TRAILING LYPE LPCR LOOP ;W ;Sa X\ pns TRANSLATOR HES 16SEP82 1/1\ moves screens from drive 2 to \ same place on drive 1. FORTH DEFINITIONS HEX \ Expects byte on TOS : translate ( n --- n ) DUP 0= IF 20 + \  ELSE DUP DUP \ lwr case 60 > SWAP 7B < AND IF 20 - ENDIF ENDIF ;& !\ Expects buffer address on TOS \ : trnsblk ( adr1 --- ) 3FF 0 DO DUP I + DUP C@ translate SWAP C! LOOP DROP ; *\ Expexts source destin scr TOS : PNSCOPY ( n1 n2 --- ) =SWAP BLOCK DUP trnsblk SWAP BLOCK 400 CMOVE UPDATE FLUSH ;A EDITOR DEFINITIONS. : PNS EDLQ SCR @ BLOCK trnsblk UPDATE EDT UL ;! FORTH DEFINITIONS : DR2 800 + ; ;S ( FORMATTED LIST PROG. 1/5 )% 3VOCABULARY FORMY IMMEDIATE FORMY DEFINITIONS pBASE @ OCTAL 40 CN SPACBYT 54 CN COMCHR : IARRAY 0 VARIABLE -2 ALLOT ; : 0> DUP 0= IF DROP 0 ELSE 0< 0= THEN ; 0 VARIABLE INDENT 106 CN FCONS 111 CN ICONS 0 VARIABLE TLFLG 0 VARIABLE KERKNT 100 CN MAXLIN : NXSPACE >R 1+ >R 0 R> R> DO SPACBYT I C@ = IF DROP I LEAVE THEN LOOP ; : NXNSPACE >R 1+ >R 0 R> R> DO SPACBYT I C@ = 0= IF" xDROP I LEAVE THEN LOOP ; : GTNXWD DUP IF + OVER SWAP NXSPACE ELSE DROP THEN DUP IF OVER SWAP NXNSPACE DUP IF OVER OVER yNXSPACE DUP IF OVER - ELSE DROP OVER OVER - 1+ THEN ELSE DUP THEN ELSE DUP THEN ; : TORLCR TLFLG @ IF CRLP ELSE CR THEN KERKNT 0SET ; : TORLY DUP 1+ KERKNT +! TLFLG @ IF LYPE ELSE TYPE SPACE THEN ; : DOIND INDENT @ 0> IF INDENT @ 0 DO 0 0 TORLY LOOP THEN ; : PRWORD DUP 1+ KERKNT @ + MAXLIN > IF TORLCR THEN KERKNT @ 0= IF DOIND THEN OVER OVER TORLY ; : 1SET 1 SWAP ! ; --> 5( FORMATTED LIST PROG. 2/5 ) : ( 51 WORD 6 ALLOT ; v: IA IARRAY ; IA L1G 10 , ( :) ( CODE) ( ,CODE) ( SUBROUTINE) ( IA) ( IARRAY) ( LABEL) ( TBL) IA L2G 2 , ( ;) ( C;) 9IA L3G 2 , ( NXT,) ( NEXT,) IA L4G 6 , ( IF) ( DO) ( IF,) 6( CASE) ( BEGIN) ( BEGIN,) IA L5G 3 , ( ELSE,) ( ELSE) k( WHILE) IA L6G 16 , ( THEN,) ( THEN) ( END,) ( END) ( SOB,) ( BACK) ( UNTIL) ( AGAIN) ( REPEAT) ( ENDIF,) Q( UNTIL,) ( LOOP) ( +LOOP) ( ENDIF) IA L7G 7 , ( CONSTANT) ( IR) ( VARIABLE) "( CN) ( ARRAY) ( INTEGER) ( ORCON) 0IA L8G 1 , ( () IA L9G 3 , ( LD,) ( ST,) ( LOAD) IA LAG 1 , ( ;CODE)- /: CMPWORD DUP >R C@ OVER = R> SWAP IF >R OVER ,R> SWAP OVER DUP C@ DUP 4 > IF DROP 4 THEN 0 )DO I OVER + 1+ C@ >R OVER R> SWAP I + C@ = 0= IF 0 LEAVE THEN LOOP' *0= IF DROP DROP 0 THEN ELSE 0 THEN ; --> P( FORMATTED LIST PROG. 3/5 ) : GSCAN DUP @ SWAP 2+ SWAP 0 DO CMPWORD IF LEAVE ,0 ELSE 6 + THEN LOOP IF 0 ELSE DROP 1 THEN ; !: NEWCR KERKNT @ IF TORLCR THEN ; $: DUPBC OVER >R >R OVER R> SWAP R> ; -: FINDCHAR SWAP >R SWAP 1+ R> DO DUP I C@ = 'IF DROP I LEAVE 0 THEN LOOP IF 0 THEN ; : PRNEWL PRWORD TORLCR ; 5: >= OVER OVER = IF DROP DROP 1 ELSE > THEN ; --> M( FORMATTED LIST PROG. 4/5 ) : EL1G NEWCR INDENT 0SET PRWORD GTNXWD PRNEWL 10 INDENT ! ; !: EL2G NEWCR PRNEWL INDENT 0SET ; : EL3G NEWCR PRNEWL ;+ !: EL4G NEWCR PRNEWL 2 INDENT +! ; .: EL5G NEWCR -2 INDENT +! PRNEWL 2 INDENT +! ; ": EL6G NEWCR -2 INDENT +! PRNEWL ; ): EL7G PRWORD GTNXWD PRNEWL INDENT 0SET ; : EL8G DUPBC 51 FINDCHAR DUP& 5IF SWAP DROP OVER - 1+ PRNEWL ELSE DROP PRWORD THEN ; : EL9G PRNEWL ;1 !: ELAG NEWCR 10 INDENT ! PRNEWL ; 2: ASSWRD DUP 4 >= IF OVER OVER + 1- C@ COMCHR = IF +OVER DUP C@ ICONS = SWAP 1+ C@ FCONS = AND *IF 2 ELSE 1 THEN ELSE 0 THEN ELSE 0 THEN ; -->= V( FORMATTED LIST PROG. 5/5 ) : PRCWRD L1G GSCAN IF EL1G ELSE L2G GSCAN IF EL2G ELSE 7L3G GSCAN IF EL3G ELSE L4G GSCAN IF EL4G ELSE L5G GSCAN 5IF EL5G ELSE L6G GSCAN IF EL6G ELSE L7G GSCAN IF EL7G 2ELSE L8G GSCAN IF EL8G ELSE L9G GSCAN IF EL9G ELSE +LAG GSCAN IF ELAG ELSE ASSWRD IF ASSWRD 2 = IF EL4G ELSE PRNEWL THEN ELSE PRWORD THEN THEN THEN THEN THEN THEN THEN THEN THEN THEN THEN ; : FORLST TORLCR DUP TLFLG @ IF LISTLP ELSE (TORLCR LIST THEN TORLCR TORLCR DUP BLK ! wBLOCK DUP 1777 + SWAP KERKNT 0SET INDENT 0SET 0 BEGIN GTNXWD DUP IF PRCWRD THEN DUP 0= END DROP DROP DROP BLK 0SET ; 8: ASTER TORLCR 40 0 DO 52 SP@ 1 TORLY DROP LOOP TORLCR ; 5: FORSHW 1+ OVER DO ASTER I FORLST TORLCR LOOP DROP ; FORTH DEFINITIONS : FLST FORMY TLFLG 0SET FORLST ; : FLSTLP FORMY TLFLG 1SET FORLST FFLP ; : FSHW FORMY TLFLG 0SET FORSHW ; : FSHWLP FORMY TLFLG 1SET FORSHW FFLP ; ;S ( CASE 1/1 ) FORTH DEFINITIONS HEX : CASE ?COMP CSP @ !CSP 4 ; IMMEDIATE : OF 4 ?PAIRS COMPILE OVER COMPILE = COMPILE 0BRANCH HERE 0 , COMPILE DROP 5 ; IMMEDIATE : ENDOF 5 ?PAIRS COMPILE BRANCH HERE 0 , SWAP 2 [COMPILE] ENDIF 4 ; IMMEDIATE =: ENDCASE 4 ?PAIRS COMPILE DROP BEGIN SP@ CSP @ = 0= WHILE 2 [COMPILE] ENDIF REPEAT CSP ! ; IMMEDIATE+ ;S "( CHARACTERSET SPACE ALLOC 1/1 ) ( HES 82SEP01 ) ( NOTE: THIS SCREEN IS LOCATION DEPENDENT FOR CHRSETSPACE TO WORK ) E000 CONSTANT CH0 ( STD CHAR ) 3400 CONSTANT CH1 ( SET #1 ) 3800 CONSTANT CH2 ( SET #2 ) 3C01 DP ! ( reserve space ) 02F4 C@ VARIABLE CHRST 1( storage area of desired set ) BLK @ DUP DUP 1+ BLOCK CH1 400 CMOVE 1+ BLOCK CH2 400 CMOVE 8( reserve next two screens ) ( 0 - 2 CHARSET SELECT ) : CHR ( n --- ) CASE 0 OF CH0 ENDOF 1 OF CH1 ENDOF 2 OF CH2 ENDOF ENDCASE 100 / DUP CHRST C! 02F4 C! ;* ( PRINT CHAR SET ) : .CHRSET 1 2FE C! FF 0 DO I EMIT LOOP 0 2FE C! CR ;' ;S< 8fffffff>`<|fl0fF68of;880  00f< 80 0 ~~`0 0`f``f<ffffbx`bbx``||ff~fff xlxxl```bv~nf`<|<fffff<fff<<f<f`f< |v000|000`~`|fff8<f<`lxxl8<fff`<|~fff;bt8|lf<|~L2~<~~<8x8 V0888ffwffff>`<|fl0fF68of;888>x|f<>>``~pppww``|l`cc>66wwcc0 0 ~~`0 0`ccooo`?33sss~ffgggg`cc~ffwww``pp``pppc`oggssssss n~fflggg000ppp~gwggggwogggccgggccpppccggg~ffwww`ssgGggggo>gggogsss>ggggggfl7g@`0 xx6c 6>R8pp8? :ww<~~~<x`x`~<~~<0~0 ~ <~~<gc000gg?```??gg?>g~`??gg>|p``~css8<gg<``lnxlg88>fwkcffff>ccc>>3c~``>sc<70pp0c~ l gggg?cc3>ck?7g<D 15 0 DO OVER OVER D+ LOOP SWAP DROP ;$ : 2@ DUP 2+ @ SWAP @ ;( : 2! OVER OVER ! 2+ SWAP DROP ! ;/ : 2DROP DROP DROP ; : 2DUP OVER OVER ;' : 2OVER 4 PICK 4 PICK ; : 2ROT 6 ROLL 6 ROLL ; : 2SWAP 84 ROLL 4 ROLL ; : 2VARIABLE VARIABLE 0 , ; : D0= OR 0= ; : D- DMINUS D+ ;' : D= D- D0= ; : D< ROT OVER OVER = IF 0ROT ROT D- 0< SWAP SWAP ELSE SWAP < SWAP DROP SWAP DROP THEN ; : EXIT COMPILE [COMPILE] ;S ; IMMEDIATE : DMIN 2OVER 2OVER D< IF 2DROP 3ELSE 2SWAP 2DROP THEN ; : DMAX 2OVER 2OVER D< IF 2SWAP THEN DROP ; ;S ( VAR / VALUE ANTIC,HES1/1 )% 0 VARIABLE TO-FLAG. CODE TO ( --- ) 1 # LDA, TO-FLAG STA, NEXT JMP, C; : VAR CONSTANT ;CODE TO-FLAG LDA, 0= IF, 2 # LDY, W )Y LDA, PHA, INY, W )Y LDA, PUSH JMP, ELSE, 0 # LDA, TO-FLAG STA, 0 ,X LDA, 2 # LDY, W )Y STA, 1 ,X LDA, INY, W )Y STA, 0E5D JMP, THEN, C; : VALUE 0 VAR ;0 ;S '( V1.4S ACCESS WORDS 1/1 ) ( HES )y : 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! ;d : HOOK ( hooks your assembly ) ( routine into WARMSTRT ) ( ->use HOOK word ) [COMPILE] ' ' V1.4S 1+ ! ;# : UNHOOK ( restore vector ) E4C0 ' V1.4S 1+ ! ;' ;S ( CDUMP / BDUMP 12SEP82 1/1 )C : BDUMP ( Redefined...HES ) 1 2FE C! :1+ SWAP DO I HH SPACE I 8 0 DO DUP I + CH? SPACE LOOP DROP ." " CR 8 +LOOP 0 2FE C! ;o : FIX DROP ." " ;P : ( For BDUMP ) 10 0 DO SP@ E + I - @ SP@ 12 + @ I 2 / + C! 2 +LOOP ." " 6DROP DROP DROP DROP DROP DROP FIX DROP DROP QUIT ;) ;S ( \ V1.4S HL/HES 12SEP82 1/1 )# : TBL ;' : ALLOC DUP + ALLOT ;* : ARRAY ;" : \ ( Ignores rest of line, used as comment -) IN @ C/L / 1+ C/L * IN ! ; IMMEDIATE6 ;S]