( LOAD SCREEN FOR UTILITIES CRC VER = 765 ) : THRU 1+ SWAP DO I U. I LOAD ?TERMINAL IF LEAVE THEN LOOP ; EXIT ( CASE STATEMENT CRC VER = 7982) : !CSP SP@ CSP ! ; : ENDOF 5 ?PAIRS COMPILE BRANCH HERE 0 , SWAP 2 [COMPILE] THEN 4 ; IMMEDIATE ( PAUSE COPY FLUSH DSWAP ID. VLIST CRC VER = 62358) : PAUSE ?TERMINAL IF KEY DROP 1000 0 DO LOOP BEGIN ?TERMINAL UNTIL KEY DROP 2000 0 DO LOOP THEN ; 136 144 THRU : CASE ?COMP CSP @ !CSP 4 ; IMMEDIATE : OF 4 ?PAIRS COMPILE OVER COMPILE = COMPILE 0BRANCH HERE 0 , COMPILE DROP 5 ; IMMEDIATE : ENDCASE 4 ?PAIRS COMPILE DROP BEGIN SP@ CSP @ = 0 = WHILE 2 [COMPILE] THEN REPEAT CSP ! ; IMMEDIATE : COPY OFFSET @ + SWAP BLOCK 2- ! UPDATE ; : FLUSH SAVE-BUFFERS ; : DSWAP 4 ROLL 4 ROLL ; HEX : ID. COUNT 1F AND TYPE ; : VLIST C/L OUT ! CONTEXT @ @ BEGIN C/L OUT @ - OVER C@ 1F AND 4 + < IF CR 0 OUT ! THEN ( SAVE-FORTH CRC VER = 23595): SAVE-FORTH FREEZE 13 0 SYSCALL DROP 14 0 SYSCALL DROP CR CR ." FILE NAME ? ---" PAD 33 0 FILL PAD 1+ 11 BLANK QUERY 0 DO DUP 26 SWAP SYSCALL DROP 21 PAD SYSCALL DROP 128 + LOOP DROP 16 PAD SYSCALL DROP ; ( .INDEX INDEX .SS .SL .SR .S CRC VER = 58176) : .INDEX CR DUP SCR ! U. 1 0 DO I 3 .R SPACE I SCR @ .LINE LOOP ; ( NON-DESTRUCTIVE STACK DISPLAY --- DEFAULT SET TO .SR) 0 CONSTANT .SS ( .S LEFT OR RIGHT SWITCH) : .SL 0 ' .SS ! ; ( .S WITH TOP OF STACK ON LEFT) DUP ID. SPACE SPACE PFA 4 - @ DUP NOT PAUSE ?TERMINAL OR UNTIL DROP ; DECIMAL 46 WORD COUNT 8 MIN PAD 1+ SWAP CMOVE BL WORD COUNT 3 MIN PAD 9 + SWAP CMOVE 19 PAD SYSCALL DROP 22 PAD SYSCALL DROP 256 HERE 0 256 U/MOD SWAP DROP 1+ 2/ 2* 2* : INDEX ( FROM TO --- LISTS LINE 0 OF SCREENS) BEGIN DUP ROT DUP .INDEX DUP ROT < WHILE 1+ SWAP REPEAT DDROP ; : .SR -1 ' .SS ! ; ( .S WITH TOP OF STACK ON RIGHT) : .S CR DEPTH IF .SS IF SP@ S0 2- ELSE SP@ S0 SWAP THEN DO I @ 0 D. 2 .SS +- +LOOP ELSE ." EMPTY STACK" THEN CR ; .SR ( CHECKSUM FOR HAND-ENTERED SOURCE SCREENS CRC VER = 18123): ACCUMULATE ( OLDCRC\CHAR -- NEWCRC) 256 * XOR 8 0 DO DUP 0< IF 16386 XOR DUP + 1+ ELSE DUP + THEN LOOP ; THEN ; ( CAREFUL; LOOPS ON ADDRESSES) : MORE ( -- ADR F) BL WORD DUP C@ 2 < OVER 1+ C@ 33 < AND NOT ; : VERIFY ( SCR# -- CRCVALUE) BLK @ >R >IN @ >R BLK ! 0 >IN ! ( LIST NLIST LISTP NLISTP O-PAGE CRC VER = 65379)0 WARNING ! : LIST PAGE CR DUP SCR ! ." SCR #" U. 16 0 DO CR I 3 .R SPACE I SCR @ .LINE : LISTP ( PUTS A PAUSE INTO LIST, FOR NLISTP -- BELOW) PAGE CR DUP SCR ! ." SCR #" U. 16 0 DO CR I 3 .R SPACE I SCR @ .LINE ?TERMINAL IF LEAVE THEN LOOP CR KEY DROP ; ( N B L GOTO-XY CRC VER = 13142) : N 1 SCR +! ; : DISPOSE ( CRCVALUE\ADR\LEN -- NEWCRCVALUE) OVER DUP C@ 40 = SWAP 1+ C@ BL = AND OVER 1 = AND IF ( COMMENT; SKIP IT) DDROP 41 WORD DROP ELSE 1+ OVER + SWAP DO I C@ ACCUMULATE LOOP 0 BEGIN MORE WHILE BL OVER COUNT + C! COUNT DISPOSE REPEAT DROP R> >IN ! R> BLK ! ; : VER SCR @ VERIFY U. ; ?TERMINAL IF LEAVE THEN LOOP CR ; : NLIST ( FROM TO --- LISTS SCREENS WITHOUT PAUSING) BEGIN DUP ROT DUP LIST DUP ROT < WHILE 1+ SWAP REPEAT DDROP ; : NLISTP ( FROM TO --- LISTS SCREENS, PAUSES UNTIL KEY IS HIT) BEGIN DUP ROT DUP LISTP DUP ROT < WHILE 1+ SWAP REPEAT DDROP ; 1 WARNING ! : O-PAGE 26 EMIT ; ' O-PAGE CFA 'PAGE ! : B -1 SCR +! ; : L PAGE SCR @ LIST ; : GOTO-XY 27 EMIT 61 EMIT 32 + EMIT 32 + EMIT ; : ASCII ( ASCII VALUE OF THE NEXT KEY HIT IS PUT ON THE STACK) BL WORD 1+ C@ [COMPILE] LITERAL ; IMMEDIATE ( SCR#X-->Y COPYF CRC VER = 54584): SCR#X-->Y CR 2 PICK SCR ! ." SCR#" SWAP 3 .R 1 0 ." -->" DO 3 .R SPACE I SCR @ .LINE LOOP ; THEN ROT ROT SWAP DDUP = IF ROT ROT 2 PICK PAGE 0 6 GOTO-XY SCR#X-->Y SWAP DUP 1+ SCR ! SWAP COPY FLUSH ELSE PAGE 0 6 GOTO-XY ( WIPE CRC VER = 12104): WIPE ( N1 N2 -- CLEAR SCREENS N1 THROUGH N2 OR N1 -- CLEAR SCREEN N1 CLEAR STACK BEFORE WIPING ... HIT ANY KEY TO ABORT) CLEAR FLUSH 1+ DDUP < ?TERMINAL IF CR ." Aborted" ABORT THEN UNTIL SCR ! DROP CR ." Done" QUIT ; : COPYF ( COPIES SCR# N1 THRU N2 TO N3 THRU ? OR SCR# N1 TO N2 .... BOTH WITH FLUSH CLEAR STACK BEFORE COPYING...HIT ANY KEY TO ABORT) DEPTH 3 < IF DDUP ROT DROP BEGIN SWAP 2 PICK 4 PICK DDUP SCR#X-->Y COPY FLUSH ROT 1+ SWAP ROT 1+ DUP SCR ! DDUP < ?TERMINAL IF CR ." Aborted" ABORT THEN UNTIL DROP DROP DROP THEN CR ." Done" QUIT ; DEPTH 2 < IF DUP THEN SWAP PAGE 0 5 GOTO-XY BEGIN DUP SCR ! SCR @ DUP CR ." CLEARING SCR#-->" 3 .R ( LOAD SCREEN FOR FORTH LINE EDITOR CRC VER = 64669) 146 163 THRU ( <MATCH> CRC VER = 25092) WARNING @ 0 WARNING ! IF 0= LEAVE ELSE 1+ THEN LOOP ELSE DROP 0= THEN ; ( MATCH CRC VER = 27930) : MATCH ( CURSOR ADDR-4, BYTES LEFT-3, STRING ADDR-2) ( STRING COUNT-1, ---- FLAG-2, CURSOR OFFSET-1) EXIT : <MATCH> ( ADDR-3, ADDR-2, COUNT-1 ---- FLAG) ?DUP IF OVER + SWAP DO DUP C@ I C@ - >R >R DDUP R> R> DSWAP OVER + SWAP ( CADDR-6, BLEFT-5, $ADDR-4, $LEN-3, CADDR+BLEFT-2, CADDR-1) DO DDUP I SWAP <MATCH> IF >R DDROP R> - I SWAP - 0 SWAP 0 0 LEAVE ( CADR, BLEFT, $ADDR, $LEN OR 0, OFFSET, 0, 0) THEN ( LINE CRC VER = 36396) BASE @ HEX SCR @ <LINE> DROP ; BASE ! ( #LOCATE CRC VER = 4570) VOCABULARY EDITOR IMMEDIATE BASE @ HEX BASE ! LOOP DDROP ( CADDR-2, BLEFT-1 OR 0-2, OFFSET-1) SWAP 0= SWAP ; : LINE ( RELATIVE TO SCR, LEAVE ADDRESS OF LINE) DUP FFF0 AND ABORT" NOT ON CURRENT EDITING SCREEN" EDITOR DEFINITIONS : #LOCATE ( ---- CURSOR OFFSET-2, LINE-1) R# @ C/L /MOD ; ( #LEAD #LAG -MOVE BUF-MOVE CRC VER = 27808) : #LEAD ( ---- CURSOR ADDR-2, OFFSET TO CURSOR-1) #LOCATE LINE SWAP ; : -MOVE ( MOVE FROM ADDR-2 TO LINE-1 ----) LINE C/L CMOVE UPDATE ; : BUF-MOVE ( MOVE TEXT, IF ANY, TO BUFFER-1 ----) ( >LINE# FIND-BUF INSERT-BUF CRC VER = 59275) BASE @ HEX : FIND-BUF ( BUFFER USED FOR ALL SEARCHES) PAD 50 + ; ( <HOLD> <KILL> <SPREAD> X CRC VER = 41917)BASE @ HEX : <HOLD> ( MOVE LINE-1 FROM BLOCK TO INSERT BUFFER) LINE INSERT-BUF 1+ C/L DUP INSERT-BUF C! CMOVE ; : #LAG ( ---- CURSOR ADDR-2, COUNT AFTER CURSOR-1) #LEAD DUP >R + C/L R> - ; HERE C@ IF PAD SWAP C/L 1+ CMOVE ELSE DROP THEN ; : >LINE# ( CONVERT CURRENT CURSOR POSITION TO LINE#) #LOCATE SWAP DROP ; : INSERT-BUF ( BUFFER USED FOR ALL INSERTIONS) FIND-BUF 50 + ; BASE ! : <KILL> ( ERASE LINE-1 WITH BLANKS) LINE C/L BLANK UPDATE ; : <SPREAD> ( SPREAD, MAKING LINE# BLANK) >LINE# DUP 0E DO I LINE I 1+ -MOVE -1 +LOOP <KILL> ; ( DISPLAY-CURSOR T L CRC VER = 14701) BASE @ HEX : T ( TYPE LINE#-1) C/L * R# ! DISPLAY-CURSOR ; : L ( LIST CURRENT SCREEN) ( N B <TOP> SEEK-ERROR CRC VER = 39959) : N ( SELECT NEXT SEQUENTIAL SCREEN) 1 SCR +! ; : <TOP> ( RESET CURSOR TO TOP OF BLOCK) 0 R# ! ; : SEEK-ERROR ( OUTPUT ERROR MSG IF NO MATCH) : X ( DELETE LINE# FROM BLOCK, PUT IN INSERT BUFFER) >LINE# DUP <HOLD> 0F DUP ROT DO I 1+ LINE I -MOVE LOOP <KILL> ; BASE ! : DISPLAY-CURSOR ( ----) CR SPACE #LEAD TYPE 5E EMIT #LAG TYPE #LOCATE 2 .R SPACE DROP ; PAGE SCR @ LIST DISPLAY-CURSOR ; BASE ! : B ( SELECT PREVIOUS SEQUENTIAL SCREEN) -1 SCR +! ; <TOP> FIND-BUF HERE C/L 1+ CMOVE HERE COUNT TYPE ." NONE" QUIT ; ( <R> P CRC VER = 19509) BASE @ HEX : P ( FOLLOWING TEXT IN INSERT BUFFER AND LINE) 5E TEXT INSERT-BUF BUF-MOVE <R> ; ( 1LINE CRC VER = 17269) ( <SEEK> <DELETE> CRC VER = 24004)BASE @ HEX : <SEEK> ( FIND BUFFER MATCH OVER FULL SCREEN, ELSE ERROR) : <R> ( REPLACE CURRENT LINE WITH INSERT BUFFER) >LINE# INSERT-BUF 1+ SWAP -MOVE ; BASE ! : 1LINE ( SCAN CURRENT LINE FOR MATCH WITH FIND BUFFER) ( UPDATE CURSOR, RETURN BOOLEAN ) #LAG FIND-BUF COUNT MATCH R# +! ; BEGIN 3FF R# @ < IF SEEK-ERROR THEN 1LINE UNTIL ; : <DELETE> ( BACKWARDS AT CURSOR BY COUNT-1) >R #LAG + R@ - ( SAVE BLANK FILL LOCATION) #LAG R@ NEGATE R# +! ( BACK AT CURSOR) ( <F> F <E> E CRC VER = 1004) BASE @ HEX : <F> ( FIND OCCURANCE OF FOLLOWING TEXT) 5E TEXT <F> DISPLAY-CURSOR ; : <E> ( ERASE BACKWARDS FROM CURSOR) FIND-BUF C@ <DELETE> ; ( D TILL CRC VER = 32395) BASE @ HEX #LEAD + 5E TEXT FIND-BUF BUF-MOVE 1LINE 0= IF SEEK-ERROR THEN #LEAD + SWAP - <DELETE> #LEAD + SWAP CMOVE R> BLANK UPDATE ; ( FILL FROM END OF TEXT) BASE ! FIND-BUF BUF-MOVE <SEEK> ; : F ( FIND AND DISPLAY FOLLOWING TEXT) : E ( ERASE AND DISPLAY LINE) <E> DISPLAY-CURSOR ; BASE ! : D ( FIND, DELETE, AND DISPLAY FOLLOWING TEXT) <F> E ; : TILL ( DELETE FROM CURSOR TO TEXT END) DISPLAY-CURSOR ; BASE ! ( COUNTER BUMP CRC VER = 39717) BASE @ HEX 38 > IF 0 COUNTER ! CR CR 0C EMIT THEN ; BASE ! ( S CRC VER = 31910) BASE @ HEX <TOP> BEGIN 1LINE IF DISPLAY-CURSOR SCR ? BUMP THEN 3FE R# @ < ?TERMINAL IF 1 ELSE 0 THEN OR ( I U CRC VER = 20178)BASE @ HEX : I ( INSERT TEXT WITHIN LINE) 5E TEXT ( LOAD INSERT BUFFER WITH TEXT) VARIABLE COUNTER 0 COUNTER ! : BUMP ( THE LINE NUMBER AND HANDLE PAGING) 1 COUNTER +! COUNTER @ : S ( FROM CURRENT TO SCREEN-1 FOR STRING) 0C EMIT 5E TEXT 0 COUNTER ! FIND-BUF BUF-MOVE SCR @ DUP >R DO I SCR ! UNTIL PAUSE ?TERMINAL IF KEY DROP LEAVE THEN LOOP R> SCR ! ; BASE ! INSERT-BUF BUF-MOVE ( IF ANY) INSERT-BUF COUNT #LAG ROT OVER MIN >R R@ R# +! ( BUMP CURSOR) R@ - >R ( CHARACTERS TO SAVE) DUP HERE R@ CMOVE ( FROM OLD CURSOR TO HERE) HERE #LEAD + R> CMOVE ( HERE TO CURSOR LOCATION) R> CMOVE UPDATE ( PAD TO OLD CURSOR) DISPLAY-CURSOR ; ( LOOK AT NEW LINE) ( R M CRC VER = 35806) : R ( REPLACE FOUND TEXT WITH INSERT BUFFER) <E> I ; >LINE# <HOLD> ( MOVE CURRENT LINE TO INSERT BUFFER) SWAP SCR ! ( SET NEW SCREEN #) 1+ C/L * R# ! ( TEXT IS STORED UNDER REQUESTED LINE) <SPREAD> <R> ( STORE INSERT BUFFER IN NEW SCREEN) : U ( INSERT FOLLOWING TEXT UNDER CURRENT LINE) C/L R# +! <SPREAD> P ; BASE ! : M ( MOVE FROM CURRENT LINE ON CURRENT SCREEN) SCR @ >R ( TO SCREEN-2, UNDER LINE-1) R# @ >R ( SAVE ORIGINAL SCREEN AND CURSOR LOCATION) R> C/L + R# ! ( SET ORIGINAL CURSOR TO NEXT LINE) R> SCR ! ; ( RESTORE ORIGINAL SCREEN) FORTH DEFINITIONS ( VALUE ON STACK) WARNING ! ( LOAD SCREEN FOR Z80 ASSEMBLER CRC VER = 13126) 166 194 THRU ( CODE & NEXT CRC VER = 35989)( COPYRIGHT 1982 MICHAEL M RUBENSTEIN ) ( VERSION 1.0, MODIFIED FOR MVP FORTH) FORTH DEFINITIONS HEX VOCABULARY ASSEMBLER : ERROR NOOP ; : CREATE1 BL WORD DUP DUP 1+ C@ 0 = ABORT" ATTEMPTED TO REDEFINE NULL" DUP CONTEXT @ @ <FIND> IF DDROP WARNING @ IF DUP COUNT TYPE SPACE ." ISN'T UNIQUE" THEN THEN HERE DUP C@ WIDTH @ MIN ( ASSEMBLER -- SINGLE REGISTER DEFINITIONS CRC VER = 57759)HEX VARIABLE .REG1 VARIABLE .REG2 VARIABLE .PFX EXIT ASSEMBLER DEFINITIONS HERE SP@ 1400 - DP ! : <> = 0= ; : IN >IN ; 1+ ALLOT DUP A0 TOGGLE HERE 1 - 80 TOGGLE LATEST , CURRENT @ ! HERE 2+ , DDROP ; : <BUILDS CREATE ; DECIMAL : (.REGDEF) .REG1 @ .REG2 ! .REG1 ! ; : .REGDEF <BUILDS , DOES> @ (.REGDEF) ; 0 WARNING ! ( TO HALT ERROR MESSAGES WHEN LOADING) 10 .REGDEF B 11 .REGDEF C 12 .REGDEF D 13 .REGDEF E 14 .REGDEF H 15 .REGDEF L 16 .REGDEF (HL) 17 .REGDEF A : .IX DD .PFX ! ; : .IY FD .PFX ! ; ( ASSEMBLER -- DBL & SPEC. REG DEFINITIONS CRC VER = 12864)HEX 20 .REGDEF BC 21 .REGDEF DE 22 .REGDEF HL 23 .REGDEF SP 23 .REGDEF AF 60 .REGDEF () 70 .REGDEF AF' 71 .REGDEF (C) 80 .REGDEF NZ 84 .REGDEF PO 81 .REGDEF Z 85 .REGDEF PE ( ASSEMBLER -- HELPER FUNCTIONS CRC VER = 21834)HEX : AERROR? SWAP F0 AND <> IF 31 ERROR THEN ; : (IPFX) .PFX @ ?DUP IF C, THEN ; : (ZPFX) ED C, ; : (LSHIFT) SWAP ?DUP IF 0 DO DUP + LOOP THEN ; : (REG1) .REG1 @ 0F AND (LSHIFT) ; : (REG2) .REG2 @ 0F AND (LSHIFT) ; : (IX) (HL) .IX ; : (IY) (HL) .IY ; 1 WARNING ! DECIMAL : IX HL .IX ; : IY HL .IY ; 30 .REGDEF (BC) 31 .REGDEF (DE) 40 .REGDEF II 48 .REGDEF R 50 .REGDEF (SP) 82 .REGDEF NC 86 .REGDEF P 87 .REGDEF M : (ENDOP) 0 .REG1 ! 0 .REG2 ! 0 .PFX ! ; DECIMAL : (IOFFSET) .PFX @ IF DUP -128 < OVER 127 > OR IF 32 ERROR THEN C, THEN ; : RREG? 10 AERROR? ; : ZREG? 40 AERROR? ; : RPREG? 20 AERROR? ; : (SP)? 50 AERROR? ; : (RPREG)? 30 AERROR? ; : (NN)? 60 AERROR? ; DECIMAL ( ASSEMBLER -- LD CRC VER = 58163)HEX : (LDS,S) .REG1 @ 16 = .REG2 @ 16 = AND IF 31 ERROR THEN CASE 10 OF (LDS,S) ENDOF 30 OF 0A 4 (REG1) OR C, ENDOF 40 OF (ZPFX) 57 0 (REG1) OR C, ENDOF 60 OF 3A C, , ENDOF ( ASSEMBLER -- LD CONTINUED CRC VER = 17327)HEX : (LDRP,?) .REG2 @ CASE 22 OF .REG1 @ 60 = 60 OF (ZPFX) 7B C, , ENDOF 31 ERROR ENDCASE ENDOF .REG1 @ (NN)? (ZPFX) 4B 4 (REG2) OR C, SWAP , ( ASSEMBLER -- LD CONTINUED CRC VER = 13416)HEX : (LD(NN),?) .REG1 @ CASE 17 OF 32 C, , ENDOF .REG1 @ RREG? (IPFX) 40 3 (REG2) OR 0 (REG1) OR C, (IOFFSET) ; : (LDA,?) .REG1 @ F0 AND 31 ERROR ENDCASE ; DECIMAL IF (IPFX) 2A C, , ELSE 31 ERROR THEN ENDOF 23 OF .REG1 @ CASE 22 OF (IPFX) F9 C, ENDOF ENDCASE ; : (LDZ,?) .REG1 @ 17 = IF (ZPFX) 47 0 (REG2) OR C, ELSE 31 ERROR THEN ; DECIMAL 22 OF (IPFX) 22 C, , ENDOF .REG1 @ RPREG? (ZPFX) 43 4 (REG1) OR C, SWAP , ENDCASE ; : (LD?,N) .REG1 @ F0 AND CASE 10 OF (IPFX) 06 3 (REG1) OR C, .PFX @ IF SWAP C, THEN C, ENDOF ( ASSEMBLER -- LD CONTINUED CRC VER = 44666)HEX : (LD(RP),?) .REG1 @ 17 = IF 02 4 (REG2) OR C, ( ASSEMBLER -- LD CONTINUED CRC VER = 64437)HEX : LD, .REG2 @ F0 AND CASE 0 OF (LD?,N) ENDOF 30 OF (LD(RP),?) ENDOF 40 OF (LDZ,?) ENDOF 60 OF (LD(NN),?) ENDOF 31 ERROR ENDCASE 20 OF (IPFX) 01 4 (REG1) OR C, , ENDOF 31 ERROR ENDCASE ; DECIMAL ELSE 31 ERROR THEN ; DECIMAL EXIT 10 OF .REG2 @ 17 = IF (LDA,?) ELSE (LDS,S) THEN ENDOF 20 OF (LDRP,?) ENDOF (ENDOP) ; DECIMAL ( ASSEMBLER -- POP & PUSH CRC VER = 13075)HEX : (POPPUSH) .REG1 @ RPREG? (IPFX) 4 (REG1) OR C, DECIMAL EXIT ( ASSEMBLER -- ADC & SBC CRC VER = 59517)HEX : (ADCSBC) .REG2 @ FF AND CASE 0 OF .REG1 @ 17 = C, (IOFFSET) ENDOF 22 OF .REG1 @ RPREG? .PFX @ IF 31 ERROR THEN SWAP DROP (ZPFX) 4 (REG1) OR C, ( ASSEMBLER -- ADC & SBC CONTINUED, ADD CRC VER = 38654)HEX : ADC, 88 4A (ADCSBC) ; : SBC, 98 42 (ADCSBC) ; (ENDOP) ; : POP, C1 (POPPUSH) ; : PUSH, C5 (POPPUSH) ; IF DROP 46 OR C, C, ELSE 31 ERROR THEN ENDOF 17 OF .REG1 @ RREG? DROP (IPFX) 0 (REG1) OR ENDOF 31 ERROR ENDCASE (ENDOP) ; DECIMAL : ADD, .REG2 @ 22 = IF .REG1 @ RPREG? (IPFX) 09 4 (REG1) OR C, (ENDOP) ELSE 80 0 (ADCSBC) THEN ; DECIMAL EXIT ( ASSEMBLER -- A OPERATIONS CRC VER = 24956)HEX : (AOP) .REG2 @ IF 31 ERROR THEN .REG1 @ ?DUP : CP, B8 (AOP) ; : OR, B0 (AOP) ; : SUB, 90 (AOP) ; : XOR, A8 (AOP) ; ( ASSEMBLER -- BIT OPERATIONS CRC VER = 56578)HEX : (BITOP) .REG2 @ IF 31 ERROR THEN .PFX @ IF ROT ELSE SWAP THEN 0 (REG1) OR C, ELSE 32 ERROR THEN (ENDOP) ; : BIT, 40 (BITOP) ; IF RREG? (IPFX) 0 (REG1) OR C, (IOFFSET) ELSE 46 OR C, C, THEN (ENDOP) ; : AND, A0 (AOP) ; DECIMAL DUP -1 > OVER 9 < AND IF (IPFX) CB C, .PFX @ IF ROT C, THEN 3 SWAP (LSHIFT) OR : RES, 80 (BITOP) ; : SET, C0 (BITOP) ; DECIMAL ( ASSEMBLER -- OPS WITH NO OPERANDS CRC VER = 17104)HEX : DEFOP <BUILDS C, DOES> @ C, (ENDOP) ; : DEFZOP <BUILDS C, DOES> (ZPFX) @ C, (ENDOP) ; B1 DEFZOP CPIR, B8 DEFZOP LDDR, 2F DEFOP CPL, A0 DEFZOP LDI, 27 DEFOP DAA, B0 DEFZOP LDIR, F3 DEFOP DI, 44 DEFZOP NEG, ( ASSEMBLER -- OPS WITH NO OPERAND CONTINUED CRC VER = 65355)HEX B3 DEFZOP OTIR, 4D DEFZOP RETI, 1F DEFOP RRA, 0F DEFOP RRCA, 67 DEFZOP RRD, 37 DEFOP SCF, ( ASSEMBLER -- INC & DEC CRC VER = 29940)HEX : (INCDEC) .REG2 @ IF 31 ERROR THEN .REG1 @ F0 AND 3F DEFOP CCF, BA DEFZOP INDR, A9 DEFZOP CPD, A2 DEFZOP INI, B9 DEFZOP CPDR, B2 DEFZOP INIR, A1 DEFZOP CPI, A8 DEFZOP LDD, FB DEFOP EI, 0 DEFOP NOP, D9 DEFOP EXX, AB DEFZOP OUTD, 76 DEFOP HALT, BB DEFZOP OTDR, AA DEFZOP IND, A3 DEFZOP OUTI, DECIMAL 45 DEFZOP RETN, 17 DEFOP RLA, 07 DEFOP RLCA, 6F DEFZOP RLD, DECIMAL CASE 10 OF DROP (IPFX) 3 (REG1) OR C, (IOFFSET) ENDOF 20 OF SWAP DROP (IPFX) 4 (REG1) OR C, ENDOF 31 ERROR ENDCASE (ENDOP) ; : DEC, 05 0B (INCDEC) ; ( ASSEMBLER -- EX CRC VER = 18693)HEX : EX, .REG2 @ CASE 23 OF .REG1 @ 70 = ENDOF 50 OF .REG1 @ 22 = IF (IPFX) E3 C, ELSE ERROR THEN ENDOF ( ASSEMBLER -- IM CRC VER = 16065)HEX : IM, CASE 0 OF 46 ENDOF 1 OF 56 ENDOF DECIMAL EXIT : INC, 04 03 (INCDEC) ; DECIMAL IF 08 C, ELSE 31 ERROR THEN ENDOF 21 OF .REG1 @ 22 = IF EB C, ELSE 31 ERROR THEN 31 ERROR ENDCASE (ENDOP) ; DECIMAL 2 OF 5E ENDOF 32 ERROR ENDCASE (ZPFX) C, (ENDOP) ; ( ASSEMBLER -- IN CRC VER = 3473 )HEX : IN, .REG1 @ CASE 60 OF .REG2 @ 17 = ENDOF ENDCASE (ENDOP) ; DECIMAL ( ASSEMBLER -- OUT CRC VER = 50691)HEX : OUT, .REG2 @ CASE 60 OF .REG1 @ 17 = ENDOF ENDCASE (ENDOP) ; DECIMAL ( ASSEMBLER -- SHIFTS AND ROTATES CRC VER = 59387)HEX : (SHIFT) .REG2 @ IF 31 ERROR THEN .REG1 @ RREG? IF DB C, C, ELSE 31 ERROR THEN ENDOF 71 OF .REG2 @ RREG? (ZPFX) 40 3 (REG2) OR C, EXIT IF D3 C, C, ELSE 31 ERROR THEN ENDOF 71 OF .REG1 @ RREG? (ZPFX) 41 3 (REG1) OR C, EXIT (IPFX) CB C, .PFX @ IF SWAP C, THEN 0 (REG1) OR C, (ENDOP) ; : RL, 10 (SHIFT) ; : RLC, 0 (SHIFT) ; : RR, 18 (SHIFT) ; : RRC, 08 (SHIFT) ; ( ASSEMBLER -- RST CRC VER = 3386 )HEX : RST, .REG1 @ .REG2 @ OR IF 31 ERROR THEN DECIMAL EXIT ( ASSEMBLER -- CALL & JP CRC VER = 35700)HEX : (CALLJP) .REG2 @ IF 33 ERROR THEN .REG1 @ THEN , (ENDOP) ; : CALL, CD C4 (CALLJP) ; : JP, .REG1 @ 16 = IF .REG2 @ IF 33 ERROR THEN : SLA, 20 (SHIFT) ; : SRA, 28 (SHIFT) ; : SRL, 38 (SHIFT) ; DECIMAL DUP DUP 38 AND = IF C7 OR C, ELSE 32 ERROR THEN (ENDOP) ; IF SWAP DROP .REG1 @ 11 = IF 83 .REG1 ! THEN 3 (REG1) OR C, ELSE DROP C, (IPFX) E9 C, (ENDOP) ELSE C3 C2 (CALLJP) THEN ; DECIMAL ( ASSEMBLER -- JR CRC VER = 20296)HEX : (JR) HERE - 1- DUP -128 < OVER 127 > OR CASE 0 OF 18 ENDOF 80 OF 20 ENDOF 81 OF 28 ENDOF 82 OF 30 ENDOF ( ASSEMBLER -- DJNZ & RET CRC VER = 48671)HEX : DJNZ, .REG1 @ .REG2 @ OR IF 33 ERROR THEN 10 C, (JR) ; IF C0 3 (REG1) OR ELSE C9 THEN C, (ENDOP) ; ( ASSEMBLER -- CONTROL FUNCTIONS CRC VER = 13676)HEX VARIABLE (ASTACK) 20 ALLOT VARIABLE (AINDEX) IF 32 ERROR THEN C, (ENDOP) ; : JR, .REG2 @ IF 33 ERROR THEN .REG1 @ 11 OF 38 ENDOF 33 ERROR ENDCASE C, (JR) ; DECIMAL : RET, .REG2 @ IF 33 ERROR THEN .REG1 @ 11 = IF 83 .REG1 ! THEN .REG1 @ DECIMAL EXIT : (APUSH) (AINDEX) @ DUP 20 > IF 34 ERROR THEN (ASTACK) + ! 2 (AINDEX) +! ; : (APOP) (AINDEX) @ DUP IF 2- DUP (AINDEX) ! (ASTACK) + @ ELSE 35 ERROR THEN ; : IF, 0 JP, HERE 2- (APUSH) ; : THEN, HERE (APOP) ! ; ( ASSEMBLER -- CONTROL FUNCTIONS CONTINUED CRC VER = 39399)HEX : DO, HERE (APUSH) ; : LOOP, (APOP) DJNZ, ; 0 JP, HERE 2- (APUSH) ; : REPEAT, (APOP) (APOP) SWAP JP, HERE SWAP ! ; DECIMAL ( ASSEMBLER -- FORTH VOCABULARY INTERFACE CRC VER = 46556)HEX : NEXT, (APOP) CONTEXT ! DP ! ( RESET DICT POINTER TO VALUE BEFORE ASM ) FORTH DEFINITIONS : CODE [ ASSEMBLER ] CONTEXT @ ASSEMBLER (ENDOP) 0 (AINDEX) ! (APUSH) CREATE1 ; : ELSE, 0 JP, THEN, (APOP) ! HERE 2- (APUSH) ; DECIMAL : BEGIN, HERE (APUSH) ; : UNTIL, (APOP) JP, ; : WHILE, 0 .REG1 @ 11 IF 83 .REG1 ! THEN .REG1 @ 1 XOR .REG1 ! EXIT C3 C, 144 , SMUDGE ; 0 CONSTANT ASMTOP HERE ' ASMTOP ! FORTH DEFINITIONS DECIMAL
