( LOAD SCREEN FOR UTILITIES CRC VER = 29941) : THRU 1+ SWAP DO I U. I LOAD ?TERMINAL IF LEAVE THEN LOOP ; 248 256 THRU EXIT ( CASE STATEMENT CRC VER = 7982) : !CSP SP@ CSP ! ; : 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] THEN 4 ; IMMEDIATE : ENDCASE 4 ?PAIRS COMPILE DROP BEGIN SP@ CSP @ = 0 = WHILE 2 [COMPILE] THEN REPEAT CSP ! ; 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 ; : 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 DUP ID. SPACE SPACE PFA 4 - @ DUP NOT PAUSE ?TERMINAL OR UNTIL DROP ; DECIMAL ( 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 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* 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 ; : INDEX ( FROM TO --- LISTS LINE 0 OF SCREENS) BEGIN DUP ROT DUP .INDEX DUP ROT < WHILE 1+ SWAP REPEAT DDROP ; ( 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) : .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 ; : 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 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 ! 0 BEGIN MORE WHILE BL OVER COUNT + C! COUNT DISPOSE REPEAT DROP R> >IN ! R> BLK ! ; : VER SCR @ VERIFY U. ; ( 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 ?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 ; : 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 ; : 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 ! ( N B L GOTO-XY CRC VER = 13142) : N 1 SCR +! ; : 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 ; : 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 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 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 ; ( 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) DEPTH 2 < IF DUP THEN SWAP PAGE 0 5 GOTO-XY BEGIN DUP SCR ! SCR @ DUP CR ." CLEARING SCR#-->" 3 .R CLEAR FLUSH 1+ DDUP < ?TERMINAL IF CR ." Aborted" ABORT THEN UNTIL SCR ! DROP CR ." Done" QUIT ; ( LOAD SCREEN FOR FORTH LINE EDITOR CRC VER = 7952) 258 275 THRU EXIT ( <MATCH> CRC VER = 25092) WARNING @ 0 WARNING ! : <MATCH> ( ADDR-3, ADDR-2, COUNT-1 ---- FLAG) ?DUP IF OVER + SWAP DO DUP C@ I C@ - 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) >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 LOOP DDROP ( CADDR-2, BLEFT-1 OR 0-2, OFFSET-1) SWAP 0= SWAP ; ( LINE CRC VER = 36396) BASE @ HEX : LINE ( RELATIVE TO SCR, LEAVE ADDRESS OF LINE) DUP FFF0 AND ABORT" NOT ON CURRENT EDITING SCREEN" SCR @ <LINE> DROP ; BASE ! ( #LOCATE CRC VER = 4570) VOCABULARY EDITOR IMMEDIATE BASE @ HEX EDITOR DEFINITIONS : #LOCATE ( ---- CURSOR OFFSET-2, LINE-1) R# @ C/L /MOD ; BASE ! ( #LEAD #LAG -MOVE BUF-MOVE CRC VER = 27808) : #LEAD ( ---- CURSOR ADDR-2, OFFSET TO CURSOR-1) #LOCATE LINE SWAP ; : #LAG ( ---- CURSOR ADDR-2, COUNT AFTER CURSOR-1) #LEAD DUP >R + C/L R> - ; : -MOVE ( MOVE FROM ADDR-2 TO LINE-1 ----) LINE C/L CMOVE UPDATE ; : BUF-MOVE ( MOVE TEXT, IF ANY, TO BUFFER-1 ----) HERE C@ IF PAD SWAP C/L 1+ CMOVE ELSE DROP THEN ; ( >LINE# FIND-BUF INSERT-BUF CRC VER = 59275) BASE @ HEX : >LINE# ( CONVERT CURRENT CURSOR POSITION TO LINE#) #LOCATE SWAP DROP ; : FIND-BUF ( BUFFER USED FOR ALL SEARCHES) PAD 50 + ; : INSERT-BUF ( BUFFER USED FOR ALL INSERTIONS) FIND-BUF 50 + ; BASE ! ( 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 ; : <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> ; : 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 T L CRC VER = 14701) BASE @ HEX : DISPLAY-CURSOR ( ----) CR SPACE #LEAD TYPE 5E EMIT #LAG TYPE #LOCATE 2 .R SPACE DROP ; : T ( TYPE LINE#-1) C/L * R# ! DISPLAY-CURSOR ; : L ( LIST CURRENT SCREEN) PAGE SCR @ LIST DISPLAY-CURSOR ; BASE ! ( N B <TOP> SEEK-ERROR CRC VER = 39959) : N ( SELECT NEXT SEQUENTIAL SCREEN) 1 SCR +! ; : B ( SELECT PREVIOUS SEQUENTIAL SCREEN) -1 SCR +! ; : <TOP> ( RESET CURSOR TO TOP OF BLOCK) 0 R# ! ; : SEEK-ERROR ( OUTPUT ERROR MSG IF NO MATCH) <TOP> FIND-BUF HERE C/L 1+ CMOVE HERE COUNT TYPE ." NONE" QUIT ; ( <R> P CRC VER = 19509) BASE @ HEX : <R> ( REPLACE CURRENT LINE WITH INSERT BUFFER) >LINE# INSERT-BUF 1+ SWAP -MOVE ; : P ( FOLLOWING TEXT IN INSERT BUFFER AND LINE) 5E TEXT INSERT-BUF BUF-MOVE <R> ; BASE ! ( 1LINE CRC VER = 17269) : 1LINE ( SCAN CURRENT LINE FOR MATCH WITH FIND BUFFER) ( UPDATE CURSOR, RETURN BOOLEAN ) #LAG FIND-BUF COUNT MATCH R# +! ; ( <SEEK> <DELETE> CRC VER = 24004)BASE @ HEX : <SEEK> ( FIND BUFFER MATCH OVER FULL SCREEN, ELSE ERROR) 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) #LEAD + SWAP CMOVE R> BLANK UPDATE ; ( FILL FROM END OF TEXT) BASE ! ( <F> F <E> E CRC VER = 1004) BASE @ HEX : <F> ( FIND OCCURANCE OF FOLLOWING TEXT) 5E TEXT FIND-BUF BUF-MOVE <SEEK> ; : F ( FIND AND DISPLAY FOLLOWING TEXT) <F> DISPLAY-CURSOR ; : <E> ( ERASE BACKWARDS FROM CURSOR) FIND-BUF C@ <DELETE> ; : E ( ERASE AND DISPLAY LINE) <E> DISPLAY-CURSOR ; BASE ! ( D TILL CRC VER = 32395) BASE @ HEX : D ( FIND, DELETE, AND DISPLAY FOLLOWING TEXT) <F> E ; : TILL ( DELETE FROM CURSOR TO TEXT END) #LEAD + 5E TEXT FIND-BUF BUF-MOVE 1LINE 0= IF SEEK-ERROR THEN #LEAD + SWAP - <DELETE> DISPLAY-CURSOR ; BASE ! ( COUNTER BUMP CRC VER = 39717) BASE @ HEX VARIABLE COUNTER 0 COUNTER ! : BUMP ( THE LINE NUMBER AND HANDLE PAGING) 1 COUNTER +! COUNTER @ 38 > IF 0 COUNTER ! CR CR 0C EMIT THEN ; BASE ! ( S CRC VER = 31910) BASE @ HEX : S ( FROM CURRENT TO SCREEN-1 FOR STRING) 0C EMIT 5E TEXT 0 COUNTER ! FIND-BUF BUF-MOVE SCR @ DUP >R DO I SCR ! <TOP> BEGIN 1LINE IF DISPLAY-CURSOR SCR ? BUMP THEN 3FE R# @ < ?TERMINAL IF 1 ELSE 0 THEN OR UNTIL PAUSE ?TERMINAL IF KEY DROP LEAVE THEN LOOP R> SCR ! ; BASE ! ( I U CRC VER = 20178)BASE @ HEX : I ( INSERT TEXT WITHIN LINE) 5E TEXT ( LOAD INSERT BUFFER WITH TEXT) 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) : U ( INSERT FOLLOWING TEXT UNDER CURRENT LINE) C/L R# +! <SPREAD> P ; BASE ! ( R M CRC VER = 35806) : R ( REPLACE FOUND TEXT WITH INSERT BUFFER) <E> I ; : M ( MOVE FROM CURRENT LINE ON CURRENT SCREEN) SCR @ >R ( TO SCREEN-2, UNDER LINE-1) R# @ >R ( SAVE ORIGINAL SCREEN AND CURSOR LOCATION) >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) 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 = 44093) 278 306 THRU EXIT ( CODE & NEXT CRC VER = 35989)( COPYRIGHT 1982 MICHAEL M RUBENSTEIN ) ( VERSION 1.0, MODIFIED FOR MVP FORTH) FORTH DEFINITIONS HEX VOCABULARY ASSEMBLER ASSEMBLER DEFINITIONS HERE SP@ 1400 - DP ! : <> = 0= ; : IN >IN ; : 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 1+ ALLOT DUP A0 TOGGLE HERE 1 - 80 TOGGLE LATEST , CURRENT @ ! HERE 2+ , DDROP ; : <BUILDS CREATE ; DECIMAL ( ASSEMBLER -- SINGLE REGISTER DEFINITIONS CRC VER = 57759)HEX VARIABLE .REG1 VARIABLE .REG2 VARIABLE .PFX : (.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 ! ; : (IX) (HL) .IX ; : (IY) (HL) .IY ; 1 WARNING ! DECIMAL ( ASSEMBLER -- DBL & SPEC. REG DEFINITIONS CRC VER = 12864)HEX 20 .REGDEF BC 21 .REGDEF DE 22 .REGDEF HL 23 .REGDEF SP 23 .REGDEF AF : IX HL .IX ; : IY HL .IY ; 30 .REGDEF (BC) 31 .REGDEF (DE) 40 .REGDEF II 48 .REGDEF R 50 .REGDEF (SP) 60 .REGDEF () 70 .REGDEF AF' 71 .REGDEF (C) 80 .REGDEF NZ 84 .REGDEF PO 81 .REGDEF Z 85 .REGDEF PE 82 .REGDEF NC 86 .REGDEF P 87 .REGDEF M : (ENDOP) 0 .REG1 ! 0 .REG2 ! 0 .PFX ! ; DECIMAL ( ASSEMBLER -- HELPER FUNCTIONS CRC VER = 21834)HEX : AERROR? SWAP F0 AND <> IF 31 ERROR THEN ; : (IPFX) .PFX @ ?DUP IF C, THEN ; : (IOFFSET) .PFX @ IF DUP -128 < OVER 127 > OR IF 32 ERROR THEN C, THEN ; : (ZPFX) ED C, ; : (LSHIFT) SWAP ?DUP IF 0 DO DUP + LOOP THEN ; : (REG1) .REG1 @ 0F AND (LSHIFT) ; : (REG2) .REG2 @ 0F AND (LSHIFT) ; : 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 .REG1 @ RREG? (IPFX) 40 3 (REG2) OR 0 (REG1) OR C, (IOFFSET) ; : (LDA,?) .REG1 @ F0 AND 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 31 ERROR ENDCASE ; DECIMAL ( ASSEMBLER -- LD CONTINUED CRC VER = 17327)HEX : (LDRP,?) .REG2 @ CASE 22 OF .REG1 @ 60 = IF (IPFX) 2A C, , ELSE 31 ERROR THEN ENDOF 23 OF .REG1 @ CASE 22 OF (IPFX) F9 C, ENDOF 60 OF (ZPFX) 7B C, , ENDOF 31 ERROR ENDCASE ENDOF .REG1 @ (NN)? (ZPFX) 4B 4 (REG2) OR C, SWAP , ENDCASE ; : (LDZ,?) .REG1 @ 17 = IF (ZPFX) 47 0 (REG2) OR C, ELSE 31 ERROR THEN ; DECIMAL ( ASSEMBLER -- LD CONTINUED CRC VER = 13416)HEX : (LD(NN),?) .REG1 @ CASE 17 OF 32 C, , ENDOF 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 20 OF (IPFX) 01 4 (REG1) OR C, , ENDOF 31 ERROR ENDCASE ; DECIMAL ( ASSEMBLER -- LD CONTINUED CRC VER = 44666)HEX : (LD(RP),?) .REG1 @ 17 = IF 02 4 (REG2) OR C, ELSE 31 ERROR THEN ; DECIMAL EXIT ( ASSEMBLER -- LD CONTINUED CRC VER = 64437)HEX : LD, .REG2 @ F0 AND CASE 0 OF (LD?,N) ENDOF 10 OF .REG2 @ 17 = IF (LDA,?) ELSE (LDS,S) THEN ENDOF 20 OF (LDRP,?) ENDOF 30 OF (LD(RP),?) ENDOF 40 OF (LDZ,?) ENDOF 60 OF (LD(NN),?) ENDOF 31 ERROR ENDCASE (ENDOP) ; DECIMAL ( ASSEMBLER -- POP & PUSH CRC VER = 13075)HEX : (POPPUSH) .REG1 @ RPREG? (IPFX) 4 (REG1) OR C, (ENDOP) ; : POP, C1 (POPPUSH) ; : PUSH, C5 (POPPUSH) ; DECIMAL EXIT ( ASSEMBLER -- ADC & SBC CRC VER = 59517)HEX : (ADCSBC) .REG2 @ FF AND CASE 0 OF .REG1 @ 17 = IF DROP 46 OR C, C, ELSE 31 ERROR THEN ENDOF 17 OF .REG1 @ RREG? DROP (IPFX) 0 (REG1) OR C, (IOFFSET) ENDOF 22 OF .REG1 @ RPREG? .PFX @ IF 31 ERROR THEN SWAP DROP (ZPFX) 4 (REG1) OR C, ENDOF 31 ERROR ENDCASE (ENDOP) ; DECIMAL ( ASSEMBLER -- ADC & SBC CONTINUED, ADD CRC VER = 38654)HEX : ADC, 88 4A (ADCSBC) ; : SBC, 98 42 (ADCSBC) ; : 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 IF RREG? (IPFX) 0 (REG1) OR C, (IOFFSET) ELSE 46 OR C, C, THEN (ENDOP) ; : AND, A0 (AOP) ; : CP, B8 (AOP) ; : OR, B0 (AOP) ; : SUB, 90 (AOP) ; : XOR, A8 (AOP) ; DECIMAL ( ASSEMBLER -- BIT OPERATIONS CRC VER = 56578)HEX : (BITOP) .REG2 @ IF 31 ERROR THEN .PFX @ IF ROT ELSE SWAP THEN DUP -1 > OVER 9 < AND IF (IPFX) CB C, .PFX @ IF ROT C, THEN 3 SWAP (LSHIFT) OR 0 (REG1) OR C, ELSE 32 ERROR THEN (ENDOP) ; : BIT, 40 (BITOP) ; : 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) ; 3F DEFOP CCF, BA DEFZOP INDR, A9 DEFZOP CPD, A2 DEFZOP INI, B9 DEFZOP CPDR, B2 DEFZOP INIR, A1 DEFZOP CPI, A8 DEFZOP LDD, B1 DEFZOP CPIR, B8 DEFZOP LDDR, 2F DEFOP CPL, A0 DEFZOP LDI, 27 DEFOP DAA, B0 DEFZOP LDIR, F3 DEFOP DI, 44 DEFZOP NEG, 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 ( ASSEMBLER -- OPS WITH NO OPERAND CONTINUED CRC VER = 65355)HEX B3 DEFZOP OTIR, 4D DEFZOP RETI, 45 DEFZOP RETN, 17 DEFOP RLA, 07 DEFOP RLCA, 6F DEFZOP RLD, 1F DEFOP RRA, 0F DEFOP RRCA, 67 DEFZOP RRD, 37 DEFOP SCF, DECIMAL ( ASSEMBLER -- INC & DEC CRC VER = 29940)HEX : (INCDEC) .REG2 @ IF 31 ERROR THEN .REG1 @ F0 AND 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) ; : INC, 04 03 (INCDEC) ; DECIMAL ( ASSEMBLER -- EX CRC VER = 18693)HEX : EX, .REG2 @ CASE 23 OF .REG1 @ 70 = IF 08 C, ELSE 31 ERROR THEN ENDOF 21 OF .REG1 @ 22 = IF EB C, ELSE 31 ERROR THEN ENDOF 50 OF .REG1 @ 22 = IF (IPFX) E3 C, ELSE ERROR THEN ENDOF 31 ERROR ENDCASE (ENDOP) ; DECIMAL ( ASSEMBLER -- IM CRC VER = 16065)HEX : IM, CASE 0 OF 46 ENDOF 1 OF 56 ENDOF 2 OF 5E ENDOF 32 ERROR ENDCASE (ZPFX) C, (ENDOP) ; DECIMAL EXIT ( ASSEMBLER -- IN CRC VER = 3473 )HEX : IN, .REG1 @ CASE 60 OF .REG2 @ 17 = IF DB C, C, ELSE 31 ERROR THEN ENDOF 71 OF .REG2 @ RREG? (ZPFX) 40 3 (REG2) OR C, ENDOF ENDCASE (ENDOP) ; DECIMAL EXIT ( ASSEMBLER -- OUT CRC VER = 50691)HEX : OUT, .REG2 @ CASE 60 OF .REG1 @ 17 = IF D3 C, C, ELSE 31 ERROR THEN ENDOF 71 OF .REG1 @ RREG? (ZPFX) 41 3 (REG1) OR C, ENDOF ENDCASE (ENDOP) ; DECIMAL EXIT ( ASSEMBLER -- SHIFTS AND ROTATES CRC VER = 59387)HEX : (SHIFT) .REG2 @ IF 31 ERROR THEN .REG1 @ RREG? (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) ; : SLA, 20 (SHIFT) ; : SRA, 28 (SHIFT) ; : SRL, 38 (SHIFT) ; DECIMAL ( ASSEMBLER -- RST CRC VER = 3386 )HEX : RST, .REG1 @ .REG2 @ OR IF 31 ERROR THEN DUP DUP 38 AND = IF C7 OR C, ELSE 32 ERROR THEN (ENDOP) ; DECIMAL EXIT ( ASSEMBLER -- CALL & JP CRC VER = 35700)HEX : (CALLJP) .REG2 @ IF 33 ERROR THEN .REG1 @ IF SWAP DROP .REG1 @ 11 = IF 83 .REG1 ! THEN 3 (REG1) OR C, ELSE DROP C, THEN , (ENDOP) ; : CALL, CD C4 (CALLJP) ; : JP, .REG1 @ 16 = IF .REG2 @ IF 33 ERROR THEN (IPFX) E9 C, (ENDOP) ELSE C3 C2 (CALLJP) THEN ; DECIMAL ( ASSEMBLER -- JR CRC VER = 20296)HEX : (JR) HERE - 1- DUP -128 < OVER 127 > OR IF 32 ERROR THEN C, (ENDOP) ; : JR, .REG2 @ IF 33 ERROR THEN .REG1 @ CASE 0 OF 18 ENDOF 80 OF 20 ENDOF 81 OF 28 ENDOF 82 OF 30 ENDOF 11 OF 38 ENDOF 33 ERROR ENDCASE C, (JR) ; DECIMAL ( ASSEMBLER -- DJNZ & RET CRC VER = 48671)HEX : DJNZ, .REG1 @ .REG2 @ OR IF 33 ERROR THEN 10 C, (JR) ; : RET, .REG2 @ IF 33 ERROR THEN .REG1 @ 11 = IF 83 .REG1 ! THEN .REG1 @ IF C0 3 (REG1) OR ELSE C9 THEN C, (ENDOP) ; DECIMAL EXIT ( ASSEMBLER -- CONTROL FUNCTIONS CRC VER = 13676)HEX VARIABLE (ASTACK) 20 ALLOT VARIABLE (AINDEX) : (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) ! ; : ELSE, 0 JP, THEN, (APOP) ! HERE 2- (APUSH) ; DECIMAL ( ASSEMBLER -- CONTROL FUNCTIONS CONTINUED CRC VER = 39399)HEX : DO, HERE (APUSH) ; : LOOP, (APOP) DJNZ, ; : BEGIN, HERE (APUSH) ; : UNTIL, (APOP) JP, ; : WHILE, 0 .REG1 @ 11 IF 83 .REG1 ! THEN .REG1 @ 1 XOR .REG1 ! 0 JP, HERE 2- (APUSH) ; : REPEAT, (APOP) (APOP) SWAP JP, HERE SWAP ! ; DECIMAL EXIT ( ASSEMBLER -- FORTH VOCABULARY INTERFACE CRC VER = 46556)HEX : NEXT, (APOP) CONTEXT ! C3 C, 144 , SMUDGE ; 0 CONSTANT ASMTOP HERE ' ASMTOP ! DP ! ( RESET DICT POINTER TO VALUE BEFORE ASM ) FORTH DEFINITIONS : CODE [ ASSEMBLER ] CONTEXT @ ASSEMBLER (ENDOP) 0 (AINDEX) ! (APUSH) CREATE1 ; FORTH DEFINITIONS DECIMAL
