( ERROR MESSAGES ) EMPTY STACK DICTIONARY FULL HAS INCORRECT ADDRESS MODE ISN'T UNIQUE DISC RANGE ? FULL STACK DISC ERROR ! FILE OPEN ERROR OUT OF VIRTUAL RANGE FILE MAKE ERROR DISK WRITE ERROR DISK FILE CLOSE ERROR EXECUTION VARIABLE UNDEFINED COPYRIGHT COMPUPRO 1983 ( 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 ( DISK BOOT ) 0 SET_DRIVE HOME 100 SEEK HOME 0 WARNING ! ( DISK2 SOFTWARE MCS 81JUL03 ) HEX C8 CONSTANT ORG ( FIRST HARD DISK PORT ) ORG CONSTANT CTL ORG 1+ CONSTANT DATA D0 CONSTANT SEL ( SELECTOR CHANNEL PORT ) B CONSTANT SEC/TRK ( DISK CHARACTERISTICS ) 8 CONSTANT #HEADS F5 CONSTANT #TRKS 0 VARIABLE DMAXSEC 2 ALLOT SEC/TRK #HEADS * #TRKS U* DMAXSEC 2! 400 CONSTANT BYTE/SEC --> ( DISK2 SOFTWARE MCS 81JUL03 ) 2 VARIABLE DRIVE 0 VARIABLE HEAD 0 VARIABLE TRACK 0 VARIABLE CONTROL 0 VARIABLE SECTOR 5 CONSTANT NTRY 0 VARIABLE HDER 0 VARIABLE SKER 0 VARIABLE SFTER 0 CONSTANT DRIVE_STB 8 CONSTANT CYL 10 CONSTANT HD 18 CONSTANT SEC : SET ( DATA REG --- ) CTL P! DATA P! ; : WAIT_DONE BEGIN CTL P@ 80 AND 0= UNTIL ; : COMMAND ( OP --- ) 8 * C0 + DRIVE @ + CTL P! WAIT_DONE ; --> ( DISK2 SOFTWARE MCS 81JUL03 ) A0 CONSTANT STEP_IN 80 CONSTANT STEP_OUT : HOME 4 STEP_OUT OR DRIVE @ OR CTL P! 0 TRACK ! BEGIN CTL P@ 1 AND WHILE DATA P@ DROP 2 MSEC REPEAT ; CODE (SEEK) ( N --- ) D POP BEGIN DATA IN E DCR 0= UNTIL NEXT JMP END-CODE : SEEK ( TRK --- ) TRACK @ OVER TRACK ! - -DUP IF ( NEW ) DUP 0 > IF STEP_IN ELSE STEP_OUT ENDIF DRIVE @ OR CTL P! ABS (SEEK) BEGIN CTL P@ 4 AND 0= UNTIL 28 MSEC ENDIF ; --> ( DISK2 SOFTWARE MCS 81JUL03 ) : SET_DRIVE ( DRV --- ) DUP DRIVE ! PWR2 10 * HEAD @ OR DRIVE_STB SET ; : SET_TRACK DUP CYL SET SEEK ; : SET_HEAD DUP HD SET HEAD ! DRIVE @ SET_DRIVE ; : SET_SECTOR DUP SEC SET SECTOR ! ; --> ( DISK2 SOFTWARE MCS 81JUL03 ) A CONSTANT PRIORITY F PRIORITY - 20 OR CONSTANT SEL_BYTE HERE 4 ALLOT DUP 4 ERASE CONSTANT CHAN_BUF : LOAD_CHAN SEL P@ DROP 4 0 DO CHAN_BUF I + C@ SEL P! LOOP ; : SET_ADDR ( ADR --- ) 100 /MOD CHAN_BUF 1+ C! CHAN_BUF 2+ C! ; --> ( GODBOUT HARD DISK INTERFACE MCS 81JUN05 ) SEC/TRK #HEADS * CONSTANT SEC/CYL : T&SCALC ( D --- ) SEC/CYL U/ SET_TRACK SEC/TRK /MOD SET_HEAD SET_SECTOR ; --> ( GODBOUT HARD DISK INTERFACE MCS 81JUN05 ) : STAT. BASE @ HEX SWAP CR ." DISK ERROR " 2H. TRACK @ DUP . HEAD @ DUP . SECTOR @ DUP . SWAP ROT #HEADS * + SEC/TRK * + DECIMAL . CR BASE ! ; : TRY 0 DO LOAD_CHAN CONTROL @ CTL P! WAIT_DONE CTL P@ DUP 7E AND 2 - DUP DISK-ERROR ! DRIVE @ 0 SET_DRIVE SET_DRIVE IF STAT. ELSE DROP LEAVE ENDIF LOOP ; --> ( GODBOUT HARD DISK INTERFACE MCS 81JUN05 ): DHR/W ( ADDR BLOCK R/W --- ) >R T&SCALC SET_ADDR R> SEL_BYTE OVER IF 80 OR ENDIF CHAN_BUF 3 + C! ( SEL CTL BYTE ) IF C8 ELSE D0 ENDIF DRIVE @ OR CONTROL ! NTRY TRY DISK-ERROR @ IF ( ERROR ) TRACK @ HOME SEEK ( RECALIBRATE & SEEK ) NTRY TRY ENDIF DISK-ERROR @ 8 ?ERROR ; : HR/W ( ADDR BLOCK R/W --- ) 0 SWAP DHR/W ; DECIMAL --> HEX : RD SEL_BYTE 80 OR CHAN_BUF 3 + C! ; : WR SEL_BYTE CHAN_BUF 3 + C! ; : Y RD LIMIT SET_ADDR LOAD_CHAN 4 COMMAND ; : Z RD LIMIT SET_ADDR LOAD_CHAN 1 COMMAND ; : X CR ." STATUS = " BASE @ HEX CTL P@ . CR LIMIT DUMPLINE 63F0 DUMPLINE BASE ! ; : XX X LIMIT 400 RANGE DO I DUMP 100 +LOOP ; : W WR LIMIT SET_ADDR LOAD_CHAN 2 COMMAND ; DECIMAL ( PATCH FORTH TO HARD DISK ) : PATCH R> DROP HR/W ; ' PATCH CFA ' R/W ! ( PATCH FORTH TO FLOPPY AND HARD DISK ) HEX : MAGIC ( ADDR BLOCK FLAG -- ) R> DROP SWAP DUP 80 < IF ( FLOPPY ) [ ' R/W 2 + 1 ] AGAIN ELSE 80 - SWAP HR/W ENDIF ; ' MAGIC CFA ' R/W ! DECIMAL ( GODBOUT HARD DISK INTERFACE MCS 81JUN05 )HEX : TDATA ( C ADDR --- ) SEC/TRK 0 DO 2DUP C! 3 + LOOP 2DROP ; : SDATA ( ADDR --- ) SEC/TRK 1 - 0 DO ( FOR N - 1 SECTORS ) I 1+ OVER I 3 * + C! LOOP ( WRITE 1 - N ) SEC/TRK 1 - 3 * + 0 SWAP C! ; ( AND 0 ) : BUILD TRACK @ LIMIT TDATA HEAD @ LIMIT 1+ TDATA LIMIT 2 + SDATA ; : CALC SEC/TRK HEAD @ * SEC/TRK #HEADS TRACK @ * * + SECTOR @ + . ; : BELL 7 EMIT ; --> ( GODBOUT HARD DISK INTERFACE MCS 81JUN05 ) CODE (FORMAT) ( CNT CMD --- ) D POP H POP E A MOV C7 ANI CTL OUT ( SEND 0 COMMAND ) BEGIN CTL IN 80 ANI 0= UNTIL ( WAIT DONE ) BEGIN E A MOV CTL OUT ( SEND WRITE HEADER ) BEGIN CTL IN 80 ANI 0= UNTIL ( WAIT DONE ) L DCR 0= UNTIL NEXT JMP END-CODE ( LOOP CNT TIMES ) : FMTTRK LIMIT SET_ADDR SEL_BYTE CHAN_BUF 3 + C! LOAD_CHAN HEAD @ LIMIT 1+ TDATA SEC/TRK D8 DRIVE @ OR (FORMAT) ; : XFER 80 0 DO I I 80 + EDITOR COPY FORTH LOOP ; --> ( GODBOUT HARD DISK CONTROLLER ) : FMTCYL ( TRK --- ) CHR . EMIT SEEK TRACK @ LIMIT TDATA #HEADS 0 DO I SET_HEAD FMTTRK LOOP ; : FORMAT ( DRV --- ) SET_DRIVE HOME LIMIT 2 + SDATA #TRKS 0 DO I FMTCYL LOOP ; : J RP@ 6 + @ ; : WIPE LIMIT BYTE/SEC E5 FILL #TRKS 0 DO SEC/CYL 0 DO LIMIT I 0 SEC/CYL J U* D+ 0 DHR/W CHR . EMIT LOOP LOOP ; --> ( GODBOUT HARD DISK INTERFACE MCS 81JUN05 ) CODE (CHKFMT) ( CNT CMD --- ) D POP H POP E A MOV C7 ANI CTL OUT ( SEND TIMEOUT COMMAND ) BEGIN CTL IN 80 ANI 0= UNTIL ( WAIT DONE ) BEGIN E A MOV CTL OUT ( SEND READ HEADER ) BEGIN CTL IN 80 ANI 0= UNTIL ( WAIT DONE ) L DCR 0= UNTIL NEXT JMP END-CODE ( LOOP CNT TIMES ) : CHKFMT RD LOAD_CHAN SEC/TRK E0 DRIVE @ OR (CHKFMT) ; --> ( SECTOR UNIQUENESS ) HEX : WDATA 15 0 DO LIMIT 200 I FILL ( FILL WITH SECTOR NUMBER ) LIMIT 37 I + 0 HR/W ( WRITE THE SECTOR ) LOOP ; : RDATA 15 0 DO LIMIT 37 I + 1 HR/W LIMIT DUMP LOOP ; : -TEXT ( A1 A2 N ___ FLAG ) DUP 0 DO DROP OVER I + C@ OVER I + C@ - DUP IF LEAVE ENDIF LOOP SWAP DROP SWAP DROP ; --> ( DISK2 READ WRITE TEST SOFTWARE RLK 81SEP16 ) : DRWTEST ( DSECTOR ___ ) DUP LIMIT BYTE/SEC + SWAP 0 HR/W ( WRITE FROM LIMIT+400H ) DUP LIMIT SWAP 1 HR/W ( READ INTO LIMIT ) LIMIT DUP BYTE/SEC + BYTE/SEC -TEXT ( COMPARE SECTOR BYTES ) IF ." ERROR IN SECTOR NUMBER " . BELL ELSE DROP ENDIF ; : HEX-NIB DUP A < IF CHR 0 ELSE A - CHR A ENDIF + ; : DTEST ( TEST ENTIRE DISK ) LIMIT 800 RANGE DO I F AND HEX-NIB I C! LOOP ( WRITE DATA ) #TRKS 0 DO SEC/CYL 0 DO CR ." SECTOR " I J U* 2DUP D. DRWTEST LOOP ?TERMINAL IF LEAVE ENDIF LOOP ; DECIMAL ( DISK2 READ WRITE TEST SOFTWARE RLK 81SEP16 ) : RWTEST ( SECTOR ___ ) DUP LIMIT 400 + SWAP 0 HR/W ( WRITE FROM LIMIT+400H ) DUP LIMIT SWAP 1 HR/W ( READ INTO LIMIT ) [ LIMIT 3FF + ] LITERAL C@ FF = IF ." ERROR IN SECTOR NUMBER " . BELL ELSE DROP ENDIF ; : HEX-NIB DUP A < IF CHR 0 ELSE A - CHR A ENDIF + ; : DTEST ( TEST ENTIRE DISK ) LIMIT 800 RANGE DO I F AND HEX-NIB I C! LOOP ( WRITE DATA ) SEC/TRK #HEADS #TRKS * * SWAP DO CR ." SECTOR " I DUP . RWTEST ?TERMINAL IF LEAVE ENDIF LOOP ; ( GODBOUT HARD DISK INTERFACE MCS 81JUN05 ) CODE (FORMAT) ( CNT CMD --- ) D POP H POP E A MOV 10 ADI CTL OUT ( SEND TIMEOUT COMMAND ) BEGIN CTL IN 80 ANI 0= UNTIL ( WAIT DONE ) BEGIN E A MOV CTL OUT ( SEND WRITE HEADER ) BEGIN CTL IN 80 ANI 0= UNTIL ( WAIT DONE ) L DCR 0= UNTIL NEXT JMP END-CODE ( LOOP CNT TIMES ) : FMTTRK LIMIT SET_ADDR 2B CHAN_BUF 3 + C! LOAD_CHAN HEAD @ LIMIT 1+ TDATA SEC/TRK D8 DRIVE @ OR (FORMAT) ; : XFER 80 0 DO I I 80 + EDITOR COPY FORTH LOOP ; --> ( GODBOUT HARD DISK TEST ROUTINES ) HEX : FEW-FORMAT LIMIT 2 + SDATA 16 0 DO I FMTCYL LOOP ; : DATACHK ( DATA BYTE -- ) 400 0 DO LIMIT I + C@ OVER - IF CR CR ." BAD DATA" CR CR ABORT ENDIF LOOP ; : E5FL LIMIT 400 E5 FILL ; : 1AFL LIMIT 400 1A FILL ; : FEW-WIPE 500 C DO LIMIT I 0 HR/W CHR . EMIT ?TERMINAL IF LEAVE ENDIF LOOP ; : T 0 SET_DRIVE HOME LIMIT 1000 1 HR/W FEW-FORMAT E5FL FEW-WIPE LIMIT D 1 HR/W LIMIT DUMP E5 DATACHK 1AFL FEW-WIPE LIMIT D 1 HR/W LIMIT DUMP 1A DATACHK FMTTRK ( TRASH TRACK) BELL ; \ BILL'S EXTRAS SCREEN DECIMAL 9 LOAD 20 LOAD 30 LOAD : LD LIMIT DUMP ; : CLD CHKFMT LIMIT DUMP ; : CTLSEE HEX CTL P@ . DECIMAL ; : ERASER LIMIT 400 ERASE ; : BADFIND 21560 0 DO LIMIT I 1 HR/W CHR . EMIT LOOP ; ( DISK2 READ WRITE TEST SOFTWARE RLK 81SEP16 ) : RWTEST ( SECTOR ___ ) DUP LIMIT 400 + SWAP 0 HR/W ( WRITE FROM LIMIT+400H ) DUP LIMIT SWAP 1 HR/W ( READ INTO LIMIT ) LIMIT DUP 400 + 400 -TEXT ( COMPARE 1024 BYTES ) IF ." ERROR IN SECTOR NUMBER " . ELSE DROP ENDIF ; : DTEST ( TEST ENTIRE DISK ) LIMIT 800 55 FILL ( DATA TO BE WRITEN ) SEC/TRK #HEADS #TRKS * * 0 DO CR ." SECTOR " I DUP . RWTEST LOOP ; DECIMAL ( SELECTOR CHANNEL DEBUG ) HEX F0 CONSTANT SEL 0 CONSTANT DISK : SET ( ADDR CTL --- ) SEL P@ DROP ( INIT FOR FOUR BYTES ) 0 SEL P! SWAP 100 /MOD SEL P! SEL P! SEL P! ; ( W/R IO/M U/D WAIT P3 P2 P1 P0 = CONTROL BYTE ) : RDLIM 0 LIMIT A0 SET ; DECIMAL  Í Õ