# 3 ********* fig-FORTH MODEL ********* Through the courtesy of FORTH INTEREST GROUP P. O. BOX 1105 SAN CARLOS, CA. 94070 RELEASE 1 WITH COMPILER SECURITY AND VARIABLE LENGTH NAMES # 4 ( ERROR MESSAGES ) EMPTY STACK DICTIONARY FULL HAS INCORRECT ADDRESS MODE ISN'T UNIQUE DISC RANGE ? FULL STACK DISC ERROR ! (READ ERROR ?) DISC DOOR OPEN/NO DISC DISC IS WRITE PROTECTED DISC ISN'T FORMATTED NO DISC ! ABC80 CAS-1 (1982.06.10) # 5 ( 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 # 6 ( print&DUMP load, WHERE, ASCII ) DECIMAL 8 LOAD 12 LOAD : WHERE ( PRINT SCR# AND IMAGE OF ERROR ) DUP B/SCR / DUP SCR ! ." SCR # " DECIMAL . SWAP C/L /MOD C/L * ROT BLOCK + CR C/L TYPE CR HERE C@ - SPACES 127 EMIT QUIT ; : ASCII ( transform ascii char to its number equivalent ) BL WORD HERE 1+ C@ /COMPILE/ LITERAL ; IMMEDIATE ( FD III/3 page 72 ) --> # 7 ( LOADED-BY EDIT POLYED ASM ) FORTH DEFINITIONS DECIMAL : LOADED-BY @ LOAD ; 15 LOADED-BY POLYED ( poly-FORTH) PAGE CR ." POLYED for poly-FORTH editor" CR CR 1 DENSITY ! CR CR ." DENSITY set for double " CR CR ;S # 8 (  print screen ) FORTH DEFINITIONS DECIMAL : LINEADDR ( N -- SCRADR-2,MEM-1) >R 0 R CURADDR R> 40 * HERE + ; :  XCUR C@ YCUR C@ ( SAVE CURSOR) ( SAVE COPY OF SCREEN ) 24 0 DO ( TRANSFER LINE-BY-LINE) I LINEADDR 40 CMOVE LOOP ( TRANSFER FINISHED) PR-ON 24 0 DO ( PRINT OUT SCREEN) 10 SPACES I LINEADDR SWAP DROP 40 TYPE CR LOOP ( PRINTING FINISHED) PR-OFF 24 0 DO ( RESTORE SCREEN) I LINEADDR SWAP 40 CMOVE LOOP ( SCREEN RESTORED) YCUR C! XCUR C! ; ;S # 9 ( PINDEX ) FORTH DEFINITIONS DECIMAL : PINDEX ( FIRST SCR-2, LAST SCR-1 -- ) PR-ON 1+ SWAP DO 10 SPACES I 3 .R 2 SPACES 0 I (LINE) TYPE CR LOOP CR 10 SPACES 15 MESSAGE PR-OFF ; ;S # 10 ( PRINT-BLOCKS ) FORTH DEFINITIONS DECIMAL : PRINT-BLOCKS ( FIRST BLK#-2 LAST BLK#-1 -- ) PR-ON ( START THE PRINTER) CR 1+ SWAP DO 0 #CR ! 10 SPACES ." SCR #" I 3 .R CR CR I SCR ! 21 0 DO 10 SPACES I 2 .R 2 SPACES I SCR @ .LINE CR LOOP CR 10 SPACES 15 MESSAGE 36 #CR @ DO CR LOOP ?TERMINAL IF ( KEY HAS BEEN PRESSED) KEY DROP LEAVE THEN LOOP PR-OFF ; ;S # 11 ( DR0->DR1, DR1->DR0 for backup ) FORTH DEFINITIONS DECIMAL : DISPLACEMENT ( -- between drives) DRIVE @ DR1 OFFSET @ SWAP IF DR1 ELSE DR0 THEN ; : ?FLUSH ( block# -- ) #BUFF MOD 0= IF FLUSH THEN ; : DR0->DR1 ( first-block#, last# -) DISPLACEMENT ROT ROT 1+ SWAP DO DUP I BLOCK 2 - +! UPDATE I ?FLUSH LOOP DROP FLUSH ; : DR1->DR0 ( first#, last# -- ) 1+ SWAP DO DR1 I DUP DUP BLOCK 2 - ! UPDATE ?FLUSH LOOP FLUSH ; ;S # 12 ( DUMP 1 of 3 ) FORTH DEFINITIONS DECIMAL : CARRAY 2 + ; 8 CARRAY DMPTXT : BLANKTXT DMPTXT 8 BLANKS ; 0 VARIABLE TXTCOUNT 16 VARIABLE OLDBASE : ASCIIS ( N -- N or BLANK ) DUP 32 < IF ( NO-PRINTING ) DROP 46 ( REPLACE WITH BLANK ) ELSE DUP 127 > IF ( NON-PRINTING ) DROP 46 ( REPLACE WITH BL ) THEN THEN ; : ADDR ( N -- ) 0 OUT ! U. 5 OUT @ - SPACES ; : TXT ( -- ) DMPTXT 2 - 10 TYPE BLANKTXT CR ; --> # 13 ( DUMP 2 of 3 ) FORTH DEFINITIONS DECIMAL : DUMPA ( START-ADDR-2,#-1 -- ) PAGE OVER + SWAP BASE @ OLDBASE ! DUP 8 MOD DUP 0< IF 8 + THEN DUP IF ( NOT START OF LINE ) OVER ADDR DUP 3 * SPACES THEN TXTCOUNT ! HEX DO TXTCOUNT @ 0= IF OLDBASE @ BASE ! I ADDR HEX THEN I C@ DUP 3 .R ASCIIS DMPTXT TXTCOUNT @ + C! TXTCOUNT DUP @ 1+ 8 MOD DUP 0= IF TXT THEN SWAP ! LOOP TXTCOUNT @ -DUP IF 8 SWAP - 3 * SPACES TXT THEN OLDBASE @ BASE ! ; --> # 14 ( DUMP 3 of 3 ) FORTH DEFINITIONS DECIMAL : DUMP ( START-ADDR-2,#-1 -- ) PAGE OVER + SWAP BASE @ OLDBASE ! 0 TXTCOUNT ! HEX DO TXTCOUNT @ 0= IF OLDBASE @ BASE ! I ADDR HEX THEN I C@ DUP 3 .R ASCIIS DMPTXT TXTCOUNT @ + C! TXTCOUNT DUP @ 1+ 8 MOD DUP 0= IF TXT THEN SWAP ! LOOP TXTCOUNT @ -DUP IF 8 SWAP - 3 * SPACES TXT THEN OLDBASE @ BASE ! ; ;S DUMP presents a memory dump directly as requested. DUMPA adjusts the dump so that the starting address is evenly divisible by 8. Bob 82.06.07 # 15 ( LOADING SCREEN FOR poly-ED ) DECIMAL 16 LOAD 17 LOAD ( MATCH ) 18 LOAD 19 LOAD ( COMMON BLOCKS ) 20 LOAD 21 LOAD 22 LOAD 23 LOAD 24 LOAD 25 LOAD 26 LOAD 27 LOAD 28 LOAD 29 LOAD 30 LOAD FORTH DEFINITIONS DECIMAL ;S # 16 ( (MATCH- ) FORTH DEFINITIONS DECIMAL : (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 ; ;S # 17 ( MATCH ) FORTH DEFINITIONS DECIMAL : MATCH ( cursor adr-4, bytes left-3, string adr-2, string count-1 --- flag-2, cursor offset-1 ) >R >R 2DUP R> R> 2SWAP OVER + SWAP DO 2DUP I SWAP (MATCH) IF >R 2DROP R> - I SWAP - 0 SWAP 0 0 LEAVE THEN LOOP 2DROP SWAP 0= SWAP ; ;S # 18 ( TEXT LINE ) FORTH DEFINITIONS DECIMAL : TEXT ( ACCEPT FOLLOWING TEXT TO PAD ) HERE C/L 1+ BLANKS WORD HERE PAD C/L 1+ CMOVE ; : LINE ( RELATIVE TO SCR, LEAVE ADDRESS OF LINE ) DUP 20 > IF ." NOT ON CURRENT EDIT SCREEN" QUIT THEN SCR @ (LINE) DROP ; ;S # 19 ( #LOCATE #LEAD #LAG -MOVE ) VOCABULARY EDITOR IMMEDIATE EDITOR DEFINITIONS DECIMAL : #LOCATE ( -- CURSOR OFFSET-2, LINE-1 ) R# @ C/L /MOD ; : #LEAD ( -- LINE ADDR-2, COUNT AFTER CURSOR-1 ) #LOCATE LINE SWAP ; : #LAG ( -- CURSOR ADR-2, COUNT AFTER CURSOR-1 ) #LEAD DUP >R + C/L R> - ; : -MOVE ( MOVE FROM ADR-2, TO LINE-1 ) LINE C/L CMOVE UPDATE ; ;S # 20 ( BUF-MOVE, >LINE#, FIND&INSERT-BF) EDITOR DEFINITIONS HEX : BUF-MOVE ( MOVE TEXT TO BUFFER-1, IF ANY) PAD 1+ C@ IF PAD SWAP C/L 1+ CMOVE ELSE DROP THEN ; : >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 + ; DECIMAL ;S # 21 ( (HOLD-, (KILL-, (SPREAD-, X ) EDITOR DEFINITIONS DECIMAL : (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 BLANKS UPDATE ; : (SPREAD) ( SPREAD, MAKING LINE-1 BLANK ) >LINE# DUP 1 - 19 DO I LINE I 1+ -MOVE -1 +LOOP (KILL) ; : X ( DELETE LINE# FROM BLOCK, PUT IN INSERT BUFFER ) >LINE# DUP (HOLD) 20 DUP ROT DO I 1+ LINE I -MOVE LOOP (KILL) ; ;S # 22 ( DISPLAY-CURSOR, T, L, N, B ) EDITOR DEFINITIONS DECIMAL : DISPLAY-CURSOR ( - ) CR SPACE #LEAD TYPE 127 EMIT #LAG TYPE #LOCATE . DROP ; : T ( TYPE LINE#-1 ) C/L * R# ! 0 DISPLAY-CURSOR ; : L ( LIST CURRENT SCREEN ) SCR @ LIST ; : N ( SELECT NEXT SEQUENTIAL SCR ) 1 SCR +! ; : B ( SELECT PREVIOUS SEQUENTIAL SCREEN ) -1 SCR +! ; ;S # 23 ( (TOP-, SEEK-ERROR, (R-, P ) EDITOR DEFINITIONS DECIMAL : (TOP) ( RESET CURSOR TO TOP OF BLOCK ) 0 R# ! ; : SEEK-ERROR ( OUTPUT ERROR MESS- AGE IF NO MATCH ) (TOP) FIND-BUF HERE C/L 1+ CMOVE HERE COUNT TYPE ." NONE" QUIT ; : (R) ( REPLACE CURRENT LINE WITH INSERT BUFFER ) >LINE# INSERT-BUF 1+ SWAP -MOVE ; : P ( FOLLOWING TEXT IN INSERT BUFFER AND LINE ) 127 TEXT INSERT-BUF BUF-MOVE (R) ; ;S # 24 ( WIPE, COPY, 1LINE ) EDITOR DEFINITIONS DECIMAL : WIPE ( CLEAR CURRENT SCREEN ) SCR @ BLOCK DUP 768 BLANKS 0 SWAP ! UPDATE ; : COPY ( COPY SCREEN-2 ONTO SCREEN-1 ) B/SCR * OFFSET @ + SWAP B/SCR * B/SCR OVER + SWAP DO DUP FORTH I BLOCK 2 - ! 1+ UPDATE LOOP DROP FLUSH ; : 1LINE ( SCAN CURRENT LINE FOR MATCH WITH FIND BUFFER UPDATE CURSOR, RETURN BOOLEAN ) #LAG FIND-BUF COUNT MATCH R# +! ; ;S # 25 ( (SEEK-, (DELETE- ) EDITOR DEFINITIONS DECIMAL : (SEEK) ( FIND BUFFER MATCH OVER FULL SCREEN, ELSE ERROR) BEGIN 755 R# @ < IF SEEK-ERROR THEN 1LINE UNTIL ; : (DELETE) ( BACKWARDS AT CURSOR BY COUNT-1 ) >R #LAG + R - ( SAVE BLANK FILL LOCATION ) #LAG R MINUS R# +! ( BACK UP CURSOR ) #LEAD + SWAP CMOVE R> BLANKS UPDATE ; ( FILL FROM END OF TEXT) ;S # 26 ( (F-, F, (E-, E ) EDITOR DEFINITIONS DECIMAL : (F) ( FIND OCCURANCE OF FOLLOW- ING TEXT ) 127 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 ; ;S # 27 ( D, TILL, COUNTER, BUMP ) EDITOR DEFINITIONS DECIMAL : D ( FIND, DELETE, AND DISPLAY FOLLOWING TEXT ) (F) E ; : TILL ( DELETE FROM CURSOR TO TEXT END ) #LEAD + 127 TEXT FIND-BUF BUF-MOVE 1LINE 0= IF SEEK-ERROR THEN #LEAD + SWAP - (DELETE) DISPLAY-CURSOR ; : BUMP ( THE LINE AND HANDLE PAGING) #CR @ 56 > IF CR CR 15 MESSAGE ?PR IF 73 #CR @ DO CR LOOP THEN 0 #CR ! THEN ; ;S # 28 ( S, U ) EDITOR DEFINITIONS DECIMAL : S ( FROM CURRENT TO SCREEN-1 FOR STRING ) PAGE 127 TEXT 0 #CR ! FIND-BUF BUF-MOVE SCR @ DUP >R DO I SCR ! (TOP) BEGIN 1LINE IF DISPLAY-CURSOR SCR ? BUMP THEN 755 R# @ < UNTIL LOOP R> SCR ! ; : U ( INSERT FOLLOWING TEXT UNDER CURRENT LINE ) C/L R# +! (SPREAD) P ; ;S # 29 ( I, R, M ) EDITOR DEFINITIONS DECIMAL : I ( INSERT TEXT WITHIN LINE ) 127 TEXT ( LOAD INSERT BUFF ) INSERT-BUF BUF-MOVE 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 ( REPLACE FOUND TEXT WITH INSERT BUFFER ) (E) I ; ;S # 30 ( M, K ) EDITOR DEFINITIONS DECIMAL : M ( MOVE FROM CURRENT LINE ON CURRENT SCREEN TO SCREEN-2 UNDER LINE-1 ) SCR @ >R R# @ >R >LINE# (HOLD) SWAP SCR ! 1+ C/L * R# ! (SPREAD) (R) R> C/L + R# ! R> SCR ! ; : K ( PUT CONTENTS OF FIND BUFFER INTO INSERT BUFFER ) FIND-BUF PAD 132 CMOVE PAD INSERT-BUF 66 CMOVE ; : )! ( put right parenthesis on comment line ) SCR @ BLOCK R# @ C/L / 1+ C/L * 2 - + DUP 41 SWAP C! 1+ 32 SWAP C! ; ;S # 31 ( READ.SECTOR ) FORTH DEFINITIONS DECIMAL ( sector#, track# -- buff.addr ) : READ.SECTOR TRACK ! SEC ! OFFSET @ IF 1 DRIVE ! THEN SET-DRIVE SEC-READ 62720 ; ;S This definition will read a desired sector and track into the input buffer and leave the input buffers address on the stack. Set the de- sired drive (DR0 or DR1) before using this function. A double density disc must be treat- ed as if it had 80 tracks with sec- tors 0-7 on each track. 1982.05.25 # 32 ( WRITE.SECTOR ) FORTH DEFINITIONS DECIMAL : WRITE.SECTOR ( sector#, track# -- buff-addr ) TRACK ! SEC ! OFFSET @ IF 1 DRIVE ! THEN SET-DRIVE USE DUP @ SWAP 62720 SWAP ! SEC-WRITE USE @ SWAP USE ! ; ;S # 33 ( DOUBLE#IN, SINGLE#IN ) FORTH DEFINITIONS DECIMAL : DOUBLE#IN CR ." Input number " QUERY ( get # in TIB ) HERE BL WORD ( transfer to HERE ) NUMBER ; ( change to number ) ( and put on stack ) : SINGLE#IN DOUBLE#IN DROP ; ;S # 34 ( NON-DESTRUCTIVE STACK PRINT ) FORTH DEFINITIONS : DEPTH SP@ S0 @ - ; : .S CR DEPTH IF SP@ 2 - S0 @ 2 - DO I @ . -2 +LOOP ELSE ." EMPTY " THEN ; ;S # 35 ( BRODIE'S LETTER F ) FORTH DEFINITIONS DECIMAL : STAR 42 EMIT ; : STARS 0 DO STAR LOOP ; : MARGIN CR 10 SPACES ; : BLIP MARGIN STAR ; : BAR MARGIN 4 STARS ; : F PAGE BAR BLIP BLIP BAR BLIP BLIP BLIP CR ; ;S # 36 ( to be continued ) CR ." fig-FORTH editor and assembler " CR ." will come on the next casset te" CR ;S Some FORTH-79 definitions : CREATE 0 VARIABLE -2 ALLOT ; : WORD WORD HERE ; : 1- 1 - ; : 2- 2 - ; The above definition of CREATE will will work with Brodie's examples. 1982.06.10 Bob