Retro1.org codex

PDISK 
* /---   FILE TYPE = E
* /---   BLOCK      DISK       00 000   81/04/22  15.45 
          IDENT  DISK 
          TITLE  DISK        FLOPPY DISK ROUTINES 
          TITLE  COMMENTS 
* 
*       ****************************************************
* 
* 
* 
*       ASSUMED CONSTANTS - 16 SECTORS/SPACE
*                         - 128 BYTES/PHYSICAL SECTOR 
* 
* 
*       DEFINITION SECTOR       (ABSOLUTE SECTOR 0) 
*       BYTES 00-09   DF.LABL   *DEFINITION*
*             10      DF.TYPE   DISKETTE TYPE 
*             11-12   DF.DSP    DIRECTORY SPACE NUMBER
*             13      DF.DNSP   NUMBER DIRECTORY SPACES 
*             14      DF.DTRK   DIRECTORY 1ST TRACK  NUMBER 
*             15      DF.DSEC   DIRECTORY 1ST SECTOR NUMBER 
*             16      DF.ST     SECTORS / TRACK 
*             17      DF.TD     TRACKS / DISKETTE 
*             18-19   DF.SPD    SPACES / DISKETTE 
*             20-21   DF.SSP    SYSTEM FILE SPACE NUMBER
*             22      DF.SNSP   NUMBER SYSTEM FILE SPACES 
*             23      DF.STRK   SYS FILE 1ST TRACK  NUMBER
*             24      DF.SSEC   SYS FILE 1ST SECTOR NUMBER
*             25-34   DF.BLSN   BOOTSTRAP LESSON NAME 
*             35      DF.INSP   NUMBER INTERP FILE SPACES 
*             36      DF.REL    DISKETTE RELEASE LEVEL
*             37      DF.YEAR   DISKETTE START YEAR 
*             38      DF.MON    DISKETTE START MONTH
*             39      DF.DAY    DISKETTE START DAY
*             40      DF.PUB    PUBLISHED DISKETTE FLAG(S)
*             41      DF.SS     SECTORS PER SPACE 
*             42-51   DF.PART   PART NUMBER 
*             52-61   DF.SNUM   SERIAL NUMBER 
*             62-63   DF.RPAS   READ PASSWORD 
*             64-65   DF.WPAS   WRITE PASSWORD
*             66      DF.CSUM   INTERPRETER CHECKSUM
*             67-125  (UNUSED)
*             126-127 DF.DCHK   CHECK CHANGED DISK
* 
* 
*       DISKETTE DIRECTORY
*       BYTES 00-09   DD.LABL   *DIRECTORY* 
*             10-19   DD.NAM    DISKETTE NAME 
*             20-31   UNUSED
*             32      DD.NFNS   NUM FILE NAME TABLE SECTORS 
*             33      DD.HFNS   HIGHEST FILE NAME SECT USED 
*             34-47   UNUSED
*             48-127  DD.SRT    SPACE RESERVATION TABLE 
* 
* 
*       FILE NAME TABLE ENTRY 
*       BYTES 00-19   FN.NAM    FILE NAME 
*             20      FN.TYPE   FILE TYPE 
*             21-22   FN.SPAC   STARTING SPACE NUMBER 
*             23      FN.NSPC   NUMBER SPACES 
*             24-31   FN.INF    UNIQUE BY FILE TYPE 
*            (32)     FN.LTH    LENGTH OF NAME TABLE ENTRY
* 
* /---   BLOCK      DISK       00 000   81/04/22  15.52 
* 
*       SYSTEM FILE (SYSTEMB) 
*       SECTOR 00     SF.SCOS   SCORE/COMPLETION INFO SECTOR
*       BYTES 00-01   SF.SCOR   CURRENT SCORE 
*             02-03   SF.LDON   LESSON COMPLETION INFO
*             04-127            UNUSED
* 
*       SECTOR 01     SF.ERPS   ERROR LOG POINTER SECTOR
*       BYTES 00      SF.ERRP   CURRENT ERROR LOG POINTER 
* 
*       SECTOR 02-09  SF.ERRS   EXECUTION ERROR LOG 
* 
* 
*       FILE INFORMATION PACKAGE
*       BYTES 00-01   FI.SECT   LOGICAL SECTOR
*             02      FI.NSEC   NUMBER SECTORS
*             03-04   FI.ADDR   BUFFER ADDRESS
*             05      FI.UNIT   UNIT NUMBER 
*             06-25   FI.NAM    FILE NAME 
*             26      FI.TYPE   FILE TYPE 
*             27-28   FI.SPAC   STARTING SPACE NUMBER 
*             29      FI.NSPC   NUMBER SPACES 
*             30-36   FI.INF    UNIQUE BY FILE TYPE 
*             37      FI.PUB    PUBLISHED FILE FLAG(S)
*            (38)     FI.LTH    LENGTH OF FILE INFO PACKAGE 
* 
*       *FI.INF* FOR LESSON BINARY
*       BYTES 00      LI.DSEC   NUMBER DIRECTORY SECTORS
*             01      LI.CSEC   MAXIMUM CHARSET SECTORS 
*             02-03   LI.VARS   NUMBER USER VARIABLE BYTES
* 
* 
*       LESSON BINARY DIRECTORY 
*       BYTES 00      LD.NUN    NUMBER UNITS
*             01      LD.ISTU   NUMBER OF UNIT TO JUMPOUT TO
*             02      LD.NNAS   NUM UNIT NAME TABLE SECTORS 
*             03      LD.YEAR   LESSON LAST-COPY YEAR 
*             04      LD.MON    LESSON LAST-COPY MONTH
*             05      LD.DAY    LESSON LAST-COPY DAY
*             06-07   LD.OBTS   OBTAIN TABLE FIRST SECTOR 
*             08      LD.OBTL   OBTAIN TABLE SECTOR COUNT 
*             09-10   LD.OFRS   OFFER TABLE FIRST SECTOR
*             11      LD.OFRL   OFFER TABLE SECTOR COUNT
*             12      LD.INTU   FIRST NON-OBTAINED UNIT 
*             13-15   UNUSED
*             16-XX   LD.UTAB   UNIT LOCATION/LENGTH TABLE
* 
* 
* /---   BLOCK      DISK       00 000   80/09/14  19.47 
* 
* 
*       F.OPEN          H,L = ADDRESS OF FIP
*       F.CLOSE         H,L = ADDRESS OF FIP
*       F.READ          H,L = ADDRESS OF FIP
*       F.WRITE         H,L = ADDRESS OF FIP
* 
*       ERROR RETURN CODES
* 
*         DP.ERR =  1 = READ ERROR
*                   2 = WRITE ERROR 
*                   3 = MASTER-CLEAR ERROR
*                   4 = TIME-OUT
*                   5 = FILE NOT FOUND
*                   6 = DUPLICATE FILE NAME 
*                   7 = ILLEGAL PARAMETER 
*                   8 = INSUFFICIENT DISK SPACE 
*                   9 = DISKETTE FORMAT BAD 
*                  10 = DATA SUM-CHECK ERROR
*                  11 = SEEK ERROR
* 
* 
*       ****************************************************
* /---   BLOCK      DEFINITION 00 000   81/09/02  09.07 
          TITLE  DEFINITIONS
* 
 
          CODE   D           SET ASSEMBLER TO DISPLAY CODE
 
* 
          EXT    COMPHL,MOVEB,ZEROB,DIVBCDE,MULDEHL 
          EXT    PPTTUT,PURGALL,LESERR,DSKERR,TVARS,UBUFFA
          EXT    ISTRAM,LIBLOAD,V 
          EXT    ZEROB,ALLOC
* 
          ENTRY  IINTERP,D.VDEF,D.RDEF,D.CLEAR,D.READ 
          ENTRY D.WRITE,F.JUMPO,D.RCID,D.CLOCK
          ENTRY F.LESSN,F.OPEN,F.READ,F.WRITE 
          ENTRY F.FNTS,Y.INIX1,F.FILEL,SETRAM 
* 
* 
          CST 
* 
*CALL DXTEXT
* 
* 
* /---   BLOCK      D.ENTRIES  00 000   81/07/06  19.52 
          TITLE  DEFINE DISK ROUTINES 
          LIST   G
* 
* 
* 
* * *     D.CLEAR            MASTER-CLEAR DISK
*         ON ENTRY - DP.UNIT = DISK UNIT NUMBER 
* 
 D.CLEAR  D.CLEAR            DEFINE D.CLEAR ROUTINE 
* 
* 
* 
* * *     D.RCID             READ CONTROLLER ID 
*         ON EXIT - A = DP.CID = CONTROLLER ID BYTE 
*                     = 0      = NO RESPONSE FROM CONTROLLER
* 
 D.RCID   D.RCID             DEFINE D.RCID ROUTINE
 
*         D.CLOCK            READ THE CLOCK VALUE 
*         EXIT   HL = CURRENT CLOCK VALUE.
*                  = 0 IF AN ERROR OCCURRED.
 
 D.CLOCK  D.CLOCK 
 
* 
* 
* 
* * *     D.READ             READ DISK
*         ON ENTRY - DP.UNIT = DISK UNIT NUMBER 
*                    DP.TRAK = TRACK
*                    DP.SECT = LOGICAL SECTOR 
*                    DP.NUM  = NUMBER SECTORS TO READ 
*                    DP.ADDR = BUFFER ADDRESS 
* 
 D.READ   D.READ             DEFINE D.READ ROUTINE
* 
* 
* 
* * *     D.WRITE            WRITE DISK 
*         ON ENTRY - DP.UNIT = DISK UNIT NUMBER 
*                    DP.TRAK = TRACK
*                    DP.SECT = LOGICAL SECTOR 
*                    DP.NUM  = NUMBER SECTORS TO WRITE
*                    DP.ADDR = BUFFER ADDRESS 
* 
 D.WRITE  D.WRITE            DEFINE D.WRITE ROUTINE 
* 
* /---   BLOCK      DS.SUBR    00 000   81/01/22  18.47 
          TITLE  DEFINE SUBROUTINES FOR DISK ROUTINES 
* 
* 
* 
* + +     SINC               INCREMENT TRACK+SECTOR ADDRESS 
*         ON ENTRY - DP.TRAK = TRACK
*                    DP.SECT = SECTOR 
* 
* + +     RLIGHT             BLINK RED ERROR INDICATOR
* 
          DS.SUBR            DEFINE DISK SUBROUTINES
* 
* 
* 
* + +     SETTS              SET TRACK/SECTOR 
*         ON ENTRY - D.TRACK = TRACK
*                    D.SECT  = SECTOR 
* 
          DS.SUBS            DEFINE DISK SUBROUTINES
* 
* 
* 
* + +     WAITI              WAIT OPERATION INITIATED 
* 
* + +     WAITC              WAIT OPERATION COMPLETE
* 
          DS.WAIT            DEFINE WAIT SUBROUTINES
* 
          LIST   *
* 
* /---   BLOCK      D.RDEF     00 000   81/07/06  19.51 
          TITLE  D.RDEF      READ DISKETTE DEFINITION SECTOR
* 
* 
* 
*         D.RDEF             READ DISKETTE DEFINITION SECTOR
*         ON EXIT - A = NON-ZERO IF ERROR OCCURRED
*                   DF.BUFF = DEFINITION PARAMETERS 
*                   F.BUFF  = DEFINITION SECTOR 
* 
 D.RDEF   XOR    A           A = 0
          LD     (DF.BUFF+DF.LABL),A     PRE-CLEAR LABEL
          LD     (DP.UNIT),A SET UNIT  NUMBER 
          LD     (DP.TRAK),A SET TRACK NUMBER 
          LD     A,1
          LD     (DP.SECT),A SET SECTOR NUMBER
          LD     (DP.NUM),A  SET NUMBER SECTORS 
* 
*         INITIALIZE DISK CONTROLLER
* 
          CALL   D.RCID      READ CONTROLLER ID 
          JR     Z,XRD190    JUMP IF NO CONTROLLER REPLY
* 
* /---   BLOCK      D.RDEF     00 000   81/07/06  20.18 
* 
*         READ AND VERIFY DEFINITION SECTOR 
* 
          LD     HL,F.BUFF
          LD     (DP.ADDR),HL SET BUFFER ADDRESS
          LD     A,26        PRE-SET SECTORS/TRACK = 26 
          LD     (DF.BUFF+DF.ST),A
          CALL   D.READ      READ DEFINITION SECTOR 
          JR     NZ,XRD190
          LD     DE,F.BUFF   D,E = *FROM* ADDRESS FOR MOVE
          LD     HL,DF.BUFF  H,L = *TO*   ADDRESS FOR MOVE
          LD     BC,DF.LTH   B,C = LENGTH 
          CALL   MOVEB       MOVE DISKETTE DEFINITION 
          CALL   D.VDEF      VERIFY DEFINITION
          RET    Z
* 
 XRD190   LD     A,26        RE-SET SECTORS/TRACK = 26
          LD     (DF.BUFF+DF.ST),A
          JR     ERR9 
* 
* 
* 
*         D.VDEF             VERIFY DEFINITION SECTOR 
*         CHECKS DEFINITION SECTOR LABEL CORRECT
*         ON EXIT - A = NON-ZERO IF ERROR OCCURRED
* 
 D.VDEF   LD     HL,DF.BUFF+DF.LABL       H,L = ADDR OF LABEL 
          LD     BC,XVLABL   D,E = ADDR OF CORRECT LABEL
* 
 XVD120   LD     A,(BC)      LOAD NEXT BYTE OF LABEL
          AND    A
          RET    Z           EXIT IF END OF LABEL (A=0) 
          LD     D,(HL)      LOAD NEXT BYTE OF LABEL
          SUB    D
          JR     NZ,ERR9     JUMP IF DID NOT VERIFY 
          INC    HL 
          INC    BC          ADVANCE INDEXES
          JR     XVD120 
* 
* 
 XVLABL   DEFB   '7D'7,'7E'7,'7F'7
          VFD    8/0
* 
* 
* /---   BLOCK      EXITS      00 000   80/03/24  17.56 
          TITLE  EXIT ROUTINES
* 
* 
* 
 ERR1     LD     A,1         1  = READ ERROR
          JR     ERRSET 
* 
 ERR2     LD     A,2         2  = WRITE ERROR 
          JR     ERRSET 
* 
 ERR3     LD     A,3         3  = MASTER-CLEAR ERROR
          JR     ERRSET 
* 
 ERR4     LD     A,4         4  = TIME-OUT
          JR     ERRSET 
* 
 ERR5     LD     A,5         5  = FILE NOT FOUND
          JR     ERRSET 
* 
*                            6 = DUPLICATE FILE NAME
* 
 ERR7     LD     A,7         7  = ILLEGAL PARAMETER 
          JR     ERRSET 
* 
*                            8 = INSUFFICIENT DISK SPACE
* 
 ERR9     LD     A,9         9  = DISKETTE FORMAT BAD 
          JR     ERRSET 
* 
 ERR10    LD     A,10        10 = DATA SUM-CHECK ERROR
          JR     ERRSET 
* 
*                            11 = SEEK ERROR
* 
* 
 ERRSET   LD     (DP.ERR),A  SET ERROR CODE 
* 
 DISKRET  LD     A,(DP.ERR)  GET DISK ERROR FLAG
          AND    A
          RET                EXIT 
* 
* 
* /---   BLOCK      F.INIX     00 000   81/07/07  17.37 
          TITLE  F.INIX      BEGIN EXECUTION
* 
* 
* 
*         F.INIX
*         INITIALIZES INTERPRETER AND INITIATES EXECUTION OF
*         BOOTSTRAP (ROUTER) LESSON IN OFF-LINE MODE
* 
 IINTERP  DEFS   0
* 
*         PRE-ZERO /PPTCOM/ 
* 
          LD     HL,PPTCOM   H,L = ADDRESS OF /PPTCOM/
          LD     DE,PPTCOML  D,E = LENGTH  OF /PPTCOM/
          LD     B,0         B   = 0
* 
 IX220    LD     (HL),B      ZERO NEXT BYTE OF COMMON 
          INC    HL          ADVANCE MEMORY ADDRESS 
          DEC    DE          DECREMENT BYTE COUNT 
          LD     A,D
          OR     E           END TEST 
          JR     NZ,IX220 
* 
*         INITIALIZE INTERPRETER VARIABLES
* 
          LD     A,77O
          LD     (UNCCHR),A  PLANT UNCOVER CODES FOR FORMAT 
          LD     (LSTCHAR+1),A
          LD     HL,-1
          LD     (ZSCORE),HL INITIALIZE *ZSCORE* = -1 
          LD     HL,0 
          LD     (TVARS),HL  FLAG VARIABLE ADDR NOT SET 
          LD     (M.HALT),HL CLEAR HALT REQUEST FLAG
          ADD    HL,SP       SAVE ENTRY VALUE OF STACK PTR
          LD     (XSP),HL 
* 
*         READ DISKETTE DEFINITION SECTOR 
* 
          CALL   D.RDEF      INITIALIZE DEFINITION SECTOR 
          JP     NZ,LESERR   CHECK IF ERROR OCCURRED
*         CHECK MICRO-PLATO RELEASE LEVEL CORRECT 
* 
          LD     A,(V+2)     LOAD INTERPRETER RELEASE LEVEL 
          LD     B,A
          LD     A,(F.BUFF+DF.REL)     DISKETTE    RELEASE LEVEL
          SUB    B
          JP     NZ,DSKERR   CHECK IF INCORRECT LEVEL 
* 
 Y.INIX1  LD     A,1         MARK IN OFF-LINE STATE 
          LD     (RMODE),A
          LD     HL,DF.BUFF+DF.BLSN    H,L = ADDR LESSON NAME 
* 
* 
* /---   BLOCK      F.JUMPO    00 000   81/07/06  19.52 
          TITLE  F.JUMPO     JUMP-OUT TO SPECIFIED LESSON 
* 
* 
* 
*         F.JUMPO            JUMP-OUT TO SPECIFIED LESSON 
*         ON ENTRY - H,L = ADDRESS OF LESSON NAME 
* 
 F.JUMPO  PUSH   HL          PUSH ADDRESS OF LESSON NAME
          CALL   PURGALL     DELETE ALL UNITS 
 
*         SET *TVARS* TO 0 SO *LIBLOAD* WILL DO INITIALIZATIONS.
 
          LD     HL,0 
          LD     (TVARS),HL 
* 
*         INITIALIZE CHARSET POINTERS 
* 
          LD     HL,M2ADD    SET ADDRESS OF M2 CHARACTERS 
          LD     (TMCHR2),HL
          LD     HL,M3ADD    SET ADDRESS OF M3 CHARACTERS 
          LD     (TMCHR3),HL
 
*         INITIALIZE THE STACK AND UNIT BUFFER POINTERS SO
*         SPACE CAN BE ALLOCATED FOR LIBRARY BUFFERS. 
 
          LD     HL,M2ADD 
          LD     (TOS),HL 
          CALL   SETRAM      RETURN WITH HL = 5300
          LD     (BUFBEG),HL
 
*         ALLOCATE SPACE FOR LIBRARY RESOLUTION BUFFERS.
*         THIS IS DONE SO THE *XLESS* OVERLAY IS LOADED 
*         LOWER IN MEMORY THAN THE BUFFERS AND DOESNT HAVE
*         TO MOVE WHEN IT ALLOCATES THE BUFFERS.
*         THE NUMBER OF SECTORS *B.SECTS* COMES FROM THE
*         EQUATE OF THE SAME NAME IN THE *XLESSN* OVERLAY.
 
 B.SECTS  EQU    64 
 
          LD     A,B.SECTS   NUM. SECTORS USED BY XLESSN
          CALL   ALLOC
          LD     (BUFBEG),HL
* 
*         WE ZERO THE MEMORY LOCATION POINTED TO BY *BUFBEG*
*         SO THAT WHEN *LIBLOAD* CALLS *FINDU*, IT WILL NOT 
*         FIND ANY UNITS IN MEMORY. 
 
          XOR    A
          LD     (HL),A 
 
          LD     A,SYSLN              SYSTEM LESSON NUMBER
          LD     (L.NUM),A
          LD     A,ZXLESSN            OVERLAY NUMBER
          LD     (UNUM),A 
          LD     (OVRLAYU),A
          LD     HL,0 
          CALL   LIBLOAD     LOAD    LIBRARY OVERLAY
          JP     NZ,DSKERR
          JP     (HL)        EXECUTE LIBRARY OVERLAY
* 
* 
* /---   BLOCK      F.OPEN     00 000   81/07/06  19.52 
          TITLE  F.OPEN      OPEN DISK FILE 
* 
* 
* 
*         F.OPEN             OPEN SPECIFIED FILE
*         ON ENTRY - H,L   = ADDR OF FIP
*         ON EXIT  - FIP   = FILE INFORMATION 
* 
 F.OPEN   LD     DE,FI.NAM   GET BIAS TO FILE NAME
          ADD    HL,DE       ADD TO FIP ADDRESS 
          LD     (FIPADR),HL
          CALL   IDEF        INSURE DEFINITION SECTOR VALID 
          RET    NZ 
* 
*         DETERMINE DISK UNIT NUMBER
* 
          LD     HL,(FIPADR) LOAD ADDRESS OF FILE NAME
          DEC    HL          BACK UP TO DISK UNIT NUMBER
          LD     A,(HL) 
          AND    A
          JP     M,FOP110    IF NEGATIVE DISK UNIT NUMBER 
          LD     (DP.UNIT),A SET DISK UNIT NUMBER 
          AND    376O 
          JP     NZ,ERR7     CHECK IF LEGAL DISK UNIT NUMBER
          JR     FOP200 
* 
 FOP110   CP     -2 
          JR     NZ,FOP120   IF DISK UNIT .NE. -2 
* 
*         SEARCH DEFAULT DRIVE (NUMBER 0) ONLY. 
* 
          XOR    A
          LD     (DP.UNIT),A
          CALL   FOP200 
          RET    NZ          EXIT IF ERROR OCCURRED 
          JR     FOP130 
* 
*         SEARCH FOR FILE ON BOTH DISK UNITS (UNIT 0 FIRST) 
* 
 FOP120   XOR    A           SEARCH DISK UNIT 0 
          LD     (DP.UNIT),A
          CALL   FOP200      ATTEMPT TO OPEN FILE ON UNIT 0 
          JR     Z,FOP130 
          LD     A,1         SEARCH DISK UNIT 1 
          LD     (DP.UNIT),A
          CALL   FOP200      ATTEMPT TO OPEN FILE ON UNIT 1 
          RET    NZ          EXIT IF ERROR OCCURRED 
* 
 FOP130   LD     HL,(FIPADR) GET ADDRESS OF FILE NAME IN FIP
          DEC    HL          BACK-UP TO DISK UNIT NUMBER
          LD     A,(DP.UNIT)
          LD     (HL),A      SET DISK UNIT NUMBER IN FIP
          XOR    A           A = 0
          RET 
* 
* /---   BLOCK      F.OPEN     00 000   81/07/06  19.52 
* 
*         READ 1ST SECTOR OF DISKETTE DIRECTORY 
* 
 FOP200   CALL   READDIR     READ 1ST SECTOR OF DIRECTORY 
          RET    NZ 
* 
* 
* 
*         F.FNTS             SEARCH FILE NAME TABLE 
*         ON ENTRY - F.BUFF  = 1ST SECTOR OF DIRECTORY
*                    DP.UNIT = UNIT NUMBER
*                    DP.TRAK = DIRECTORY TRACK NUMBER 
*                    FIPADR  = ADDRESS OF FIP 
*         ON EXIT  - FIP     = FILE INFORMATION 
*                    FADDR   = ADDR OF FILE NAME TABLE ENTRY
*                    FSECT   = NAME TABLE SECTOR NUMBER 
* 
 F.FNTS   DEFS   0
* 
*         SEARCH FILE NAME SECTORS FOR SPECIFIED FILE 
* 
          LD     A,(F.BUFF+DD.HFNS) 
          LD     (FNSECT),A  SET NUM FILE NAME SECTORS+1
          LD     A,(F.BUFF+DD.NFNS) 
          LD     (FMSECT),A  SET MAXIMUM SECTOR NUMBER
          LD     A,(DF.BUFF+DF.DSEC)
          INC    A           SET STARTING SECTOR NUMBER 
          LD     (FSECT),A
* 
*         READ NEXT SECTOR
* 
 FOP220   LD     A,(FSECT)   SET SECTOR NUMBER
          LD     (DP.SECT),A
          LD     A,1         SET NUMBER SECTORS TO READ 
          LD     (DP.NUM),A 
          LD     HL,F.BUFF   SET BUFFER ADDRESS 
          LD     (DP.ADDR),HL 
          CALL   D.READ      READ NEXT SECTOR 
          RET    NZ          EXIT IF ERROR OCCURRED 
* 
* /---   BLOCK      F.OPEN     00 000   78/07/09  16.35 
* 
*         SEARCH CURRENT SECTOR 
* 
          LD     HL,F.BUFF   INITIALIZE ADDRESS 
          LD     (FADDR),HL 
          EX     DE,HL       D,E = ADDRESS IN SECTOR BUFFER 
          LD     B,FN.FNS    B   = NUMBER NAMES/SECTOR
* 
 FOP240   LD     HL,(FIPADR) GET ADDRESS OF FILE INFO 
          LD     C,21        C   = NUM CHARS TO COMPARE 
* 
 FOP242   LD     A,(DE)      COMPARE NEXT CHARACTER 
          SUB    (HL) 
          JR     NZ,FOP244
          INC    HL          ADVANCE CHARACTER POINTERS 
          INC    DE 
          DEC    C           NAME END TEST
          JR     NZ,FOP242
          LD     HL,(FADDR)  GET ADDRESS OF FILE NAME/INFO
          EX     DE,HL       D,E = *FROM* ADDRESS FOR MOVE
          LD     HL,(FIPADR) H,L = *TO*   ADDRESS FOR MOVE
          LD     BC,FN.LTH   B,C = LENGTH TO MOVE 
          CALL   MOVEB       EXTRACT FILE INFORMATION 
          JP     DISKRET
* 
 FOP244   LD     HL,(FADDR)  INCREMENT ADDRESS
          LD     DE,FN.LTH
          ADD    HL,DE       ADVANCE TO NEXT FILE NAME
          LD     (FADDR),HL 
          EX     DE,HL       D,E = ADDRESS IN SECTOR BUFFER 
          DEC    B           SECTOR END TEST
          JR     NZ,FOP240
          LD     A,(FNSECT) 
          DEC    A           CHECK IF LAST SECTOR 
          JP     Z,ERR5      EXIT IF FILE NOT FOUND 
          JP     M,ERR5 
          LD     (FNSECT),A  DECREMENT SECTOR COUNT 
          LD     A,(FSECT)   LOAD CURRENT SECTOR ADDRESS
          INC    A           ADVANCE SECTOR ADDRESS 
          LD     (FSECT),A
          LD     B,A
          LD     A,(FMSECT)  LOAD MAXIMUM SECTOR NUMBER 
          CP     B
          JP     M,ERR5      EXIT IF FILE NOT FOUND 
          JP     FOP220      READ NEXT SECTOR 
* 
* /---   BLOCK      F.READ     00 000   81/07/06  19.53 
          TITLE  F.READ / F.WRITE 
* 
* 
* 
*         F.READ             READ  SPECIFIED FILE 
*         F.WRITE            WRITE SPECIFIED FILE 
*         ON ENTRY - H,L = ADDRESS OF FIP 
*         ON EXIT  - A = NON-ZERO IF ERROR OCCURRED 
* 
 F.READ   CALL   RWSET       INITIALIZE FOR READ
          RET    NZ 
          CALL   D.READ      READ DISK
          RET 
* 
 F.WRITE  CALL   RWSET       INITIALIZE FOR WRITE 
          RET    NZ 
          CALL   D.WRITE     WRITE DISK 
          RET 
* 
* 
* 
*         RWSET              INITIALIZE FOR FILE READ/WRITE 
*         ON ENTRY - H,L = ADDRESS OF FIP 
*         ON EXIT  - A   = NON-ZERO IF BOUNDS ERROR 
*                    DP.UNIT = DISK UNIT NUMBER 
*                    DP.TRAK = ABSOLUTE TRACK NUMBER
*                    DP.SECT = ABSOLUTE SECTOR NUMBER 
*                    DP.NUM  = NUMBER SECTORS TO READ/WRITE 
*                    DP.ADDR = BUFFER ADDRESS 
* 
 RWSET    LD     (FIPADR),HL SET ADDRESS OF FIP 
          XOR    A           A = 0
          LD     (DP.ERR),A  CLEAR DISK ERROR CODE
          LD     DE,FI.ADDR 
          ADD    HL,DE       H,L = ADDRESS OF BUFFER ADDRESS
          LD     E,(HL) 
          INC    HL 
          LD     D,(HL)      D,E = BUFFER ADDRESS 
          EX     DE,HL
          LD     (DP.ADDR),HL SET BUFFER ADDRESS
          LD     HL,(FIPADR) H,L = ADDRESS OF FIP 
          CALL   F.FILEL     COMPUTE FILE LENGTH IN SECTORS 
          CALL   COMPHL      H,L = -FILE LENGTH 
          LD     (FNSECT),HL SAVE COMP OF LENGTH
* 
* /---   BLOCK      F.READ     00 000   80/03/15  19.33 
* 
          LD     HL,(FIPADR)
          LD     D,H         D,E = ADDRESS OF FIP 
          LD     E,L
          LD     BC,FI.UNIT  BIAS TO DISK UNIT NUMBER 
          ADD    HL,BC       H,L = ADDRESS OF DISK UNIT NUM 
          LD     A,(HL) 
          LD     (DP.UNIT),A SET DISK UNIT NUMBER 
          LD     HL,FI.SECT  BIAS TO LOGICAL SECTOR 
          ADD    HL,DE       H,L = ADDR OF LOGICAL SECTOR 
          LD     C,(HL) 
          INC    HL 
          LD     B,(HL)      B,C = LOGICAL SECTOR 
          LD     A,370O 
          AND    B           CHECK SECTOR NUMBER REASONABLE 
          JP     NZ,ERR7
          LD     HL,FI.NSEC  BIAS TO NUMBER SECTORS 
          ADD    HL,DE
          LD     D,0
          LD     E,(HL)      D,E = NUMBER SECTORS 
          LD     A,E
          AND    A           CHECK SECTOR COUNT PRESENT 
          JP     Z,ERR7 
          LD     (DP.NUM),A  SET NUMBER SECTORS 
          EX     DE,HL
          ADD    HL,BC       COMPUTE ENDING SECTOR NUMBER 
          DEC    HL 
          EX     DE,HL
          LD     HL,(FNSECT) RETRIEVE COMPLEMENT OF LENGTH
          ADD    HL,DE
          LD     A,H         CHECK TRANSFER LEGAL 
          AND    A
          JP     P,ERR7      ERROR EXIT IF ILLEGAL TRANSFER 
          CALL   Y.DSKAD     COMPUTE DISK ADDRESS 
          XOR    A           A = 0
          RET 
* 
* 
* /---   BLOCK      Y.DSKAD    00 000   81/07/06  20.20 
          TITLE  Y.DSKAD     COMPUTE ABSOLUTE DISK ADDRESS
* 
* 
* 
*         Y.DSKAD 
*         COMPUTE ABSOLUTE TRACK+SECTOR FROM SPACE NUMBER 
*         AND LOGICAL SECTOR
* 
*         PERFORMS THE FOLLOWING CALCULATION -
*         TEMP=SPACE*(SECTORS/SPACE)
*         TEMP=TEMP+LOGICAL SECTOR
*         DP.TRAK=INT(TEMP/(SECTORS/TRACK)) 
*         DP.SECT=TEMP-TEMP*(SECTORS/TRACK) 
* 
*         ON ENTRY - FIPADR  = ADDRESS OF FIP 
*         ON EXIT  - DP.TRAK = ABSOLUTE TRACK  NUMBER 
*                    DP.SECT = ABSOLUTE SECTOR NUMBER 
* 
 Y.DSKAD  LD     HL,(FIPADR) GET ADDRESS OF FIP 
          LD     DE,FI.SPAC 
          ADD    HL,DE       H,L = ADDRESS OF SPACE NUMBER
          LD     D,(HL) 
          INC    HL 
          LD     E,(HL)      D,E = SPACE NUMBER 
          CALL   MSPSSP      COMPUTE SECTORS*SECTORS/SPACE
          EX     DE,HL       D,E = SECTOR NUMBER
          LD     HL,(FIPADR) LOAD ADDRESS OF FIP
          LD     BC,FI.SECT 
          ADD    HL,BC       H,L = ADDRESS OF SECTOR NUMBER 
          LD     C,(HL) 
          INC    HL 
          LD     B,(HL)      B,C = LOGICAL SECTOR 
          EX     DE,HL
          ADD    HL,BC       H,L = SECTOR REL TO DISKETTE 
          PUSH   HL          SAVE RELATIVE SECTOR IN STACK
          LD     B,H
          LD     C,L         B,C = RELATIVE SECTOR
          LD     A,(DF.BUFF+DF.ST)
          LD     D,0
          LD     E,A         D,E = PHYSICAL SECTORS/TRACK 
          CALL   DIVBCDE     COMPUTE TRACK NUMBER 
          LD     A,C
          LD     (DP.TRAK),A SET TRACK NUMBER 
          LD     D,B
          LD     E,C         D,E = TRACK NUMBER 
* 
* /---   BLOCK      Y.DSKAD    00 000   80/10/01  18.27 
* 
          LD     HL,(DF.BUFF+DF.ST) 
          LD     H,0         H,L = SECTORS/TRACK
          CALL   MULDEHL     COMPUTE TRACK*SECTORS/TRACK
          EX     DE,HL
          CALL   COMPHL      COMPLEMENT BASE SECTOR NUMBER
          EX     DE,HL       D,E = -BASE SECTOR 
          POP    HL          RETRIEVE REL SECTOR FROM STACK 
          ADD    HL,DE       COMPUTE SECTOR WITHIN TRACK
          LD     A,L
          INC    A           ADJUST TO START AT SECTOR 1
          LD     (DP.SECT),A SET SECTOR NUMBER
          RET 
* 
* 
* 
*         F.FILEL            RETURN FILE LENGTH IN SECTORS
*         ON ENTRY - H,L = ADDRESS OF FIP 
*         ON EXIT  - H,L = FILE LENGTH IN SECTORS 
* 
 F.FILEL  LD     DE,FI.NSPC  BIAS TO NUMBER FILE SPACES 
          ADD    HL,DE       H,L = ADDRESS OF NUMBER SPACES 
          LD     D,0
          LD     E,(HL)      D,E = NUMBER OF SPACES 
* 
 MSPIF    IFEQ   DC.SS,13 
 MSPSSP   LD     H,D         COPY SPACE NUMBER TO H,L 
          LD     L,E
          ADD    HL,DE       H,L = 2*SPACE
          ADD    HL,HL       H,L = 4*SPACE
          LD     B,H
          LD     C,L         B,C = 4*SPACE
          ADD    HL,HL       H,L = 8*SPACE
          ADD    HL,BC       H,L = 12*SPACE 
          ADD    HL,DE       H,L = 13*SPACE = SECTOR
          RET 
 MSPIF    ENDIF 
* 
 MSPIF    IFEQ   DC.SS,16 
 MSPSSP   LD     H,D         COPY SPACE NUMBER TO H,L 
          LD     L,E
          ADD    HL,DE       H,L = 2*SPACE
          ADD    HL,HL       H,L = 4*SPACE
          ADD    HL,HL       H,L = 8*SPACE
          ADD    HL,HL       H,L = 16*SPACE = SECTOR
          RET 
 MSPIF    ENDIF 
* 
* 
* /---   BLOCK      ROUTINES   00 000   80/08/24  15.41 
          TITLE  ROUTINES 
* 
* 
* 
*         READDIR            READ 1ST SECTOR OF DIRECTORY 
*         ON ENTRY - DP.UNIT = UNIT NUMBER
*         ON EXIT  - A = NON-ZERO IF ERROR OCCURRED 
*                    F.BUFF = 1ST SECTOR
* 
 READDIR  CALL   SETDIR      SET TO READ DIRECTORY
          CALL   D.READ      READ 1ST SECTOR
          RET 
* 
* 
* 
*         SETDIR             SET TO READ/WRITE DIRECTORY
*         ON EXIT  - DP.TRAK = DIRECTORY 1ST TRACK  NUMBER
*                    DP.SECT = DIRECTORY 1ST SECTOR NUMBER
*                    DP.ADDR = ADDRESS OF F.BUFF
*                    DP.NUM  = 1
* 
 SETDIR   LD     A,(DF.BUFF+DF.DTRK)
          LD     (DP.TRAK),A SET DIRECTORY TRACK
          LD     A,(DF.BUFF+DF.DSEC)
          LD     (DP.SECT),A SET DIRECTORY SECTOR 
          LD     A,1
          LD     (DP.NUM),A  SET NUMBER SECTORS TO READ 
          LD     HL,F.BUFF
          LD     (DP.ADDR),HL SET BUFFER ADDRESS
          RET 
* 
* 
* 
*         IDEF               INITIALIZE DEFINITION SECTOR 
*         ON EXIT - A = NON-ZERO IF ERROR OCCURRED
* 
 IDEF     CALL   D.VDEF      VERIFY DEFINITION SECTOR 
          RET    Z           EXIT IF INTACT 
          CALL   D.RDEF      READ DEFINITION SECTOR 
          RET 
* 
* /---   BLOCK      ROUTINES   00 000   80/09/23  17.55 
* 
* 
* 
*         SETRAM             SET LWA OF USEABLE RAM 
*         ON EXIT - H,L = LWA OF USEABLE RAM
*         USES    - A,H,L 
* 
 SETRAM   LD     HL,ISTRAM   GET FWA OF INTERPRETER RAM 
          RET 
* 
* /---   BLOCK      END        00 000   81/07/06  19.54 
* 
* 
 F.LESSN  JP     LESERR 
* 
* 
          END