\ DISK3 - High Level Driver - Load Screen 17Oct83map1 24 +THRU EXIT \ DISK3-1 - RESET ATTN INIT IOPB PV DRIVER 23sep83mapHEX VARIABLE DRIVE : RESET ( -- ) 1 90 P! ; : ATTN ( -- ) 0 90 P! ; DECIMAL CREATE IOPB 16 ALLOT : INIT (S -- ) RESET IOPB 80 DUP 16 ERASE 13 + ! ( BOOT TO IOPB ) IOPB 16 ERASE ( CLEAR IOPB ) IOPB DUP 13 + ! ( IOPB TO SELF ) 0 DRIVE ! ; : PV CREATE IOPB + , DOES> @ ; 0 PV CMND 1 PV STAT 2 PV ARG0 10 PV DATA 13 PV LINK 2 PV DRV : ARG ( n -- a ) ARG0 + ; \ DISK3-1 - DRIVE STAT. EXEC INIT X 17Oct83map: STAT. ( -- ) CR ." Error Status = " STAT C@ . CR ; : (EXEC) ( N -- ) CMND C! 0 STAT C! DRIVE @ DRV C! ATTN BEGIN STAT C@ KEY? OR UNTIL ; : EXEC ( N -- ) (EXEC) STAT C@ 255 - IF STAT. KEY? ABORT" PROGRAM ABORTED" THEN ; : SET-DRIVE ( n -- ) DUP DRV C! DRIVE ! ; \ DISK3-1 - NOOP STATUS SELECT SPECIFY HOME SEEK 11Oct83map: NOOP ( -- ) 0 EXEC ; : VERSION ( -- ) 1 EXEC ; : GLOBALS ( mode #trys #drives -- ) 3 ARG C! 2 ARG C! 1 ARG C! 2 EXEC ; : SPECIFY ( adr -- ) DATA ! 3 EXEC ; : SET-MAP ( adr -- ) DATA ! 4 EXEC ; : HOME ( -- ) 5 EXEC ; : SEEK ( cylinder -- ) 1 ARG ! 6 EXEC ; : READ-HEAD ( adr -- ) DATA ! 7 EXEC ; : NR/W ( address block r/w-flag count -- ) 6 ARG ! 1 ARG C! 2 ARG ! 0 4 ARG ! DATA ! 8 EXEC ; : RELOC ( -- ) 9 EXEC ; : FORMAT ( addr gap3 fill head -- ) 3 ARG C! 2 ARG C! 1 ARG C! DATA ! 10 EXEC ; \ Variables 17Oct83map: STATUS ( -- ) 12 EXEC ; : SELECT ( cable -- ) 1 ARG C! 13 EXEC ; : EXAMINE ( FR TO N -- ) 4 ARG ! DATA ! 2 ARG ! 14 EXEC ; : MODIFY ( fr to n -- ) 4 ARG ! 2 ARG ! DATA ! 15 EXEC ; VARIABLE MAXTRK VARIABLE #HEADS VARIABLE HEAD 9 CONSTANT SEC/TRK \ rds wrs 13Oct83mapHEX CREATE BUF 800 ALLOT : RD ( n -- ) BUF SWAP 1 1 NR/W ; : WR ( n -- ) BUF SWAP 0 1 NR/W ; : WRS ( last+1 first -- ) ?DO I . BUF B/BUF I FILL I WR LOOP ; : RDS ( last+1 first -- ) DO I . I RD LOOP ; : RH ( -- ) BUF READ-HEAD BUF DLN ; DECIMAL : TR/W ( address sec track r/w-flag count -- ) 6 ARG ! 1 ARG C! 4 ARG ! 2 ARG ! DATA ! 8 EXEC ; : TRD ( sec track -- ) BUF -ROT 1 1 TR/W ; : TWR ( sec track -- ) BUF -ROT 0 1 TR/W ; : tr trd buf dln ; : tw twr buf dln ; \ Q540 26Sep83map: MSEC ( n -- n ) 202 * ; : USEC ( N -- N ) 202 1000 */ ; CREATE Q540 ( STEP-RATE ) 0 USEC , ( SETTLE-TIME ) 0 USEC , ( BYTE/SEC ) 1024 , ( SEC/TRK ) 9 , ( TRK/CYL ) 8 DUP #HEADS ! , ( CYL/DRV ) 512 DUP MAXTRK ! , ( PRECOMP ) 256 , ( REDUCE ) 512 , ( SKEW-FACTOR ) 1 , ( RESERVED ) 0 , ( POSITION ) 0 , \ Tools 11Oct83map: EX ( adr -- ) BUF C/L EXAMINE BUF C/L DUMP ; : ST ( -- ) INIT Q540 SPECIFY HOME ; : DD 16 DUMP ; : B. BUF DD ; : IO. IOPB DD ; : R ( n -- ) RD B. ; : WW ( byte sector -- ) swap BUF B/BUF ROT FILL WR ; : W ( sector -- ) dup ww ; : t ( byte -- ) buf b/buf bounds do i c@ over <> if i buf - u. then key? ?leave loop drop ; : tt ( byte sector -- ) 2dup ww rd t ; : ts ( sector -- ) 256 0 do cr i . i over tt 1+ key? ?leave loop drop ; \ DISK3 - FMTBUF FMTTRK 11Oct83mapHEX E5 CONSTANT FILLCHAR 10 CONSTANT GAP3 DECIMAL CREATE FMTBUF SEC/TRK 8 * ALLOT : FMTTRK ( cylinder head -- ) CR ." FMTTRK " OVER . DUP . DUP HEAD ! FMTBUF 3 + SEC/TRK 0 DO I OVER C! 4 + LOOP DROP FMTBUF 2 + SEC/TRK 4 * BOUNDS DO DUP I C! 4 +LOOP DROP FMTBUF SEC/TRK 4 * BOUNDS DO DUP I ! 4 +LOOP DROP FMTBUF GAP3 FILLCHAR HEAD @ FORMAT ; \ DISK3 - FMTCYL FMTDSK 11Oct83map: FMTCYL ( cylinder -- ) CR ." FMTCYL " DUP . DUP SEEK #HEADS @ 0 DO DUP I FMTTRK KEY? ?LEAVE LOOP DROP ; : FMTDSK ( 0 -- ) SET-DRIVE MAXTRK @ 0 DO I FMTCYL KEY? ?LEAVE LOOP ; \ more tools 11Oct83map: R2 ( -- ) 2 Q540 18 + ! Q540 SPECIFY ; : R0 ( -- ) 0 Q540 18 + ! Q540 SPECIFY ; : BM ( -- ) BUF 256 -1 FILL 0 BUF ! 0 BUF 2+ ! BUF SET-MAP ; : RES ( n -- ) DUP Q540 18 + ! Q540 SPECIFY BUF 256 -1 FILL BUF SWAP 2* ERASE BUF SET-MAP ; \ ST412 06may83mcs CREATE ST412 ( STEP-RATE ) 30 USEC , ( SETTLE-TIME ) 0 MSEC , ( SECTOR-SIZE ) 1024 8 / , ( SEC/CYL ) 9 4 * , ( SEC/TRK ) 9 , ( MAXTRK ) 306 , ( PRECOMP ) 128 , ( REDUCE ) 306 , ( SKEW-FACTOR ) 1 , \ ST506-1K 06may83mcs CREATE ST506-1K ( STEP-RATE ) 3 MSEC , ( SETTLE-TIME ) 0 MSEC , ( SECTOR-SIZE ) 1024 8 / , ( SEC/CYL ) 9 4 * , ( SEC/TRK ) 9 , ( MAXTRK ) 153 , ( PRECOMP ) 128 , ( REDUCE ) 128 , ( SKEW-FACTOR ) 1 , \ CMI 5619 19 MEG DRIVE 30MAR83RLK CREATE CM5619 ( STEP-RATE ) 2 MSEC , ( SETTLE-TIME ) 0 MSEC , ( SECTOR-SIZE ) 1024 8 / , ( SEC/CYL ) 9 6 * , ( SEC/TRK ) 9 , ( MAXTRK ) 306 , ( PRECOMP ) 150 , ( REDUCE ) 306 , ( SKEW-FACTOR ) 1 , \ ATASI 3046 46 MEG DRIVE 06may83mcs create A3046 ( STEP-RATE ) 3 USEC , ( SETTLE-TIME ) 0 MSEC , ( SECTOR-SIZE ) 1024 8 / , ( SEC/CYL ) 9 7 * , ( SEC/TRK ) 9 , ( MAXTRK ) 645 , ( PRECOMP ) 320 , ( REDUCE ) 645 , ( SKEW-FACTOR ) 1 , 645 maxtrk ! \ 603SE 11O06may83mcs CREATE 603SE ( STEP-RATE ) 2 MSEC , ( SETTLE-TIME ) 0 MSEC , ( SECTOR-SIZE ) 1024 8 / , ( SEC/CYL ) 9 4 * , ( SEC/TRK ) 9 , ( MAXTRK ) 230 , ( PRECOMP ) 192 , ( REDUCE ) 192 , ( SKEW-FACTOR ) 1 , \ test words 17Oct83mapHEX : TST ST ( INITIALIZE) CR CR ." FORMAT FIRST TWO CYLINDERS" 0 FMTCYL 1 FMTCYL ( FORMAT CYLS 1 & 2) CR CR ." READ FIRST 100 SECTORS" CR 100 0 RDS CR CR ." WR, RD AND CHK SECS 1 TO 10 WITH 1A'S " CR 10 0 DO I . 1A I TT LOOP CR CR ." SHOW RESULTS OF LAST CHK" BUF 50 dump CR CR ." WR, RD AND CHK SECS 1 TO 10 WITH E5'S" CR 10 0 DO I . E5 I TT LOOP CR CR ." SHOW RESULTS OF LAST CHK" BUF 50 dump CR CR ." PRECOMP AREA TEST " CR 19F FMTCYL 1A0 FMTCYL CR CR ." RD SECS WAY THE HELL OUT THERE!" CR 753A 7530 RDS CR CR CR CR 07 emit ." OKEY DOKEY" ; decimal \ test words 17Oct83map: DEX DECIMAL ; HEX 4406 CONSTANT IN-DPH 4000 CONSTANT IN-RAM : GET-RAM IN-RAM BUF 800 EXAMINE ; : GET-DPH IN-DPH BUF 100 EXAMINE ; DEX