      HED S6 - SECTION 6 (OPDSN)
* 
*     OPDSN 
*      OPERATOR DESIGN SECTION
*      THIS SECTION ALLOWS THE OPERATOR TO DESIGN 
*      HIS OWN TEST AND THEN EXECUTE IT.
* 
OPDSN EQU * 
      LDA BPTO      START OF WORK AREA
      STA BILD      STORAGE POINTER 
      STA OPSRT 
      LDA D57       STEP NUMBER 
      JSB COPR
      LDB LWAM      LIMIT 
      LDA MSIZE      OPDSN
      AND MEM         TO
      CPA BIT12        8K 
      RSS 
      LDB B7777 
      ADB MM1 
      STB LBLP1 
      LDA BPTR      SET 
      STA BUFAD      UP 
      LDA BPTS        POINTERS
      STA BUFAE 
      CLA 
      STA LABLC 
      STA SHTAS     ZERO EXPECTED STATUS
      STA STRF
      STA DMRF
      STA HDON
      STA HFLAG 
H55   LDA B55       ENTER INSTRUCTIONS
      JSB PRINT 
OPD1  EQU * 
      JSB HIN       INPUT LINE
      CLA 
      STA PFLAG 
      LDA D128      COMMONLY USED FOR 
      STA WD2        DEFAULT CASE 
      JSB PACK2     GET OP CODE 
      JMP H20       ERROR IN INPUT
      LDB CODEE 
OPD2  EQU *         SEARCH FOR
      CPA B,I        CODE MATCH 
      JMP OPD3      FOUND IT
      INB 
      CPB CODEF 
      RSS           ERROR - BAD OP CODE 
      JMP OPD2
H20   LDA B20       UNDEFINED INSTRUCTION 
      JSB PRINT 
      JMP OPD1
OPD3  EQU * 
      ADB CODEC 
      STB OPCNT     OP CODE 
      ADB OUTC
      JSB OPEND     CHECK FOR ABORT 
      LDA B,I       PROCESS INSTRUCTION 
      JMP A,I 
* 
* 
*     POUT1    AR,DS,IS,SR
* 
POUT1 LDA PPT1
      STA WD1       STORE TRANSFER VECTOR 
      CLA 
      STA WD2       DEFAULT CASE
      JSB PUT1H     LOOK FOR COMMA
      JSB PUT1D     PROCESS FIRST FIELD,CYLINDER
      ALF,ALF 
      STA WD2 
      JSB PUT1D     PROCESS SECOND FIELD,HEAD 
      ALF,RAL 
      IOR WD2 
      STA WD2 
      JSB PUT1D     PROCESS THIRD FIELD,SECTOR
      IOR WD2 
      STA WD2 
      LDA PFLAG     DONE? 
      SZA,RSS       SKIP IF YES 
      JMP PUT1A     ERROR 
PUT1B LDA D3
PUT1F JSB BUILD 
      JMP OPD1      EXIT
PUT1A JSB H31       BAD INPUT 
      JMP OPD1
PUT1D NOP 
      LDA PFLAG     DONE? 
      SZA 
      JMP PUT1B     YES 
      JSB DCHAR     NO,GET NEXT FIELD 
      RSS 
      JMP PUT1D,I 
      JSB PUT1E     DONE OR ERROR?
      ISZ PFLAG     DONE
      JMP PUT1D,I   CONTINUE
PUT1E NOP           DONE OR ERROR?
      LDB CCNT      COLUMNS REMAINING 
      SZB 
      JMP OPD1      ERROR (ALREADY REPORTED)
      JMP PUT1E,I 
PUT1G NOP           CHECK COMMA 
      XOR B54 
      SZA,RSS 
      JMP PUT1G,I   OK
      JMP PUT1A 
PUT1H NOP 
      JSB CHAR      GET NEXT CHARACTER
      JMP PUT1B     DONE
      JSB PUT1G     CHECK FOR COMMA 
      JMP PUT1H,I   RETURN
* 
* 
*     POUT2    CE,RL,RR,RS,ST,FL,FU,VL,VU 
* 
POUT2 EQU * 
      LDA PPT2
      STA WD1       STORE TRANSFER VECTOR 
      JSB CHAR
      RSS           SKIP IF DONE
      JMP PUT1A     ERROR 
      JMP PUT3J     EXIT
* 
* 
*     POUT3    GO,LB
* 
POUT3 LDA PPT3      AN RSS
      STA WD1       STORE TRANSFER VECTOR 
      JSB CHAR
      JMP PUT1A     ERROR 
      JSB PUT3K     GET LABEL 
      JSB CHAR      CHECK NEXT CHARACTER
      RSS           OK-SKIP 
      JMP PUT1A     ERROR-TOO MANY CHARACTERS 
      LDA OPCNT     OP CODE 
      CMA,INA 
      ADA B15       IS IT LB? 
      SZA           SKIP IF YES 
      JMP PUT3A     MUST BE GO
      JSB PUT3D     SEARCH FOR LABEL
      JMP PUT3B     NOT THERE 
      ISZ LBLP2     FOUND IT
      LDA LBLP2,I   ADDRESS WORD
      SZA,RSS       SKIP IF PREVIOUSLY DEFINED
      JMP PUT3E 
H17   LDA B17       DUPLICATE LABEL 
      JSB PRINT 
      JMP OPD1
PUT3B JSB PUT3L     CHECK FOR OVERFLOW
PUT3E LDA BILD      NEXT AVAILABLE LOCATION 
      STA LBLP2,I   STORE ADDRESS 
PUT3J LDA D2
      JMP PUT1F     EXIT
PUT3A JSB PUT3D     GO,SEARCH TABLE 
      JMP PUT3F     DID NOT FIND IT 
      ISZ LBLP2     FOUND IT
PUT3G LDA LBLP2 
      AND B3777 
      IOR JMPI      =126000B
      STA WD1 
      JMP PUT3J 
PUT3F JSB PUT3L     CHECK FOR OVERFLOW
      CLA 
      STA LBLP2,I   ZERO ADDRESS WORD 
      JMP PUT3G 
PUT3D NOP           SEARCH TABLE
      LDB LABLC     NUMBER OF LABELS
PUT3I SZB,RSS 
      JMP PUT3D,I   ZERO LABELS 
      LDA LBLP2,I 
      CPA LABEL 
      JMP PUT3H     FOUND IT
      LDA LBLP2     STEP
      ADA MM2        BACK 
      STA LBLP2       THROUGH CORE
      ADB MM1       DECREMENT LABEL COUNT 
      JMP PUT3I 
PUT3H ISZ PUT3D     NORMAL
      JMP PUT3D,I    EXIT 
PUT3K NOP           GET LABEL 
      JSB PUT1G     CHECK COMMA 
      JSB PACK2 
      JMP PUT1A     ERROR 
      STA LABEL     SAVE LABEL
      LDA LBLP1 
      STA LBLP2 
      JMP PUT3K,I 
PUT3L NOP           CHECK FOR WORK SPACE OVERFLOW 
      JSB PUT3N 
      ISZ LABLC 
      LDA LABEL 
      STA LBLP2,I 
      ISZ LBLP2 
      JMP PUT3L,I   NORMAL EXIT 
PUT3N NOP 
      LDA LABLC 
      ALS           TWO LOCATIONS PER LABEL 
      ADA BILD
      ADA D4
      LDB LBLP1 
      CMB,INB 
      ADB A 
      SSB,RSS 
      JMP PUT3M     OVERFLOW
      JMP PUT3N,I 
PUT3M LDA B16       OVERFLOW
      JSB PRINT 
      JMP OPD1
* 
* 
*     POUT4    CD,RD,WD 
* 
POUT4 LDA PPT4
      STA WD1       STORE TRANSFER VECTOR 
      JSB PUT1H     LOOK FOR COMMA
      JSB PUT1D     PROCESS FIELD,WORD COUNT
      STA WD2 
      LDA OPCNT     IS
      XOR B16        IT 
      SZA,RSS         READ? 
      JSB PUT6D     YES,LIMIT WORD COUNT
      LDA PFLAG     DONE? 
      SZA,RSS       SKIP IF YES 
      JMP PUT1A     ERROR 
      JMP PUT1B     EXIT
* 
* 
*     POUT5    CB 
* 
POUT5 LDA PPT5
      STA WD1       TRANSFER VECTOR 
      CLA,INA 
      STA WD3       DEFAULT NUMBER OF ERROR PRINTS
      JSB CHAR
      JMP PUT5B     DONE
      JSB PUT1G     CHECK COMMA 
      JSB DCHAR 
      JMP PUT5A     DONE OR ERROR?
      ISZ DFLT      SKIP ON DEFAULT 
      STA WD2 
      JSB DCHAR 
      RSS 
      JMP PUT1A     ERROR 
      JSB PUT1E     DONE OR ERROR?
      ISZ DFLT      SKIP ON DEFAULT 
      STA WD3 
      JMP PUT5B 
PUT5A JSB PUT1E 
      ISZ DFLT      SKIP ON DEFAULT 
      STA WD2 
PUT5B LDA D4
      JMP PUT1F     EXIT
* 
*     POUT6    DB 
* 
POUT6 LDA PPT6
      STA WD1       STORE TRANSFER VECTOR 
      JSB PUT1H     LOOK FOR COMMA
      JSB DCHAR 
      JMP PUT6C     DONE OR ERROR?
      ISZ DFLT      SKIP ON DEFAULT 
      STA WD2 
      JSB PUT6D 
      JSB OCHAR 
      JMP PUT6A     DONE OR ERROR?
      JSB PUT6B 
      JSB CHAR
      JMP PUT1A     ERROR 
      XOR B103      C 
      SZA 
      JMP PUT1A     ERROR 
      LDA WD2 
      IOR BIT14 
      STA WD2 
      JSB CHAR
      JMP PUT5B     SHOULD BE DONE
      JMP PUT1A     ERROR 
PUT6A JSB PUT1E     DONE OR ERROR?
      JSB PUT6B 
      JMP PUT5B 
PUT6B NOP 
      ISZ DFLT      SKIP IF DEFAULT 
      RSS           OK
      JMP PUT1A     ERROR 
      STA WD3 
      LDA BIT15 
      IOR WD2 
      STA WD2 
      JMP PUT6B,I 
PUT6C JSB PUT1E     DONE OR ERROR?
      ISZ DFLT      SKIP IF DEFAULT 
      STA WD2 
      JSB PUT6D 
      JMP PUT1B     EXIT
PUT6D NOP           CHECK WD2 - MUST NOT BE GREATER 
      LDA WD2       THAN 1536 
      SSA           MUST BE 
      JMP PUT1A      POSITIVE 
      CMA,INA 
      ADA D1024 
      SSA 
      JMP PUT1A     ERROR 
      JMP PUT6D,I 
* 
*     POUT7    EN 
* 
POUT7 LDA PPT7
PUT7G STA WD1       STORE TRANSFER VECTOR 
      LDB LABLC     NUMBER OF LABELS
      LDA LBLP1 
      INA 
      STA LBLP2 
PUT7D SZB,RSS       SEARCH FOR
      JMP PUT7B      UNDEFINED LABELS 
      LDA LBLP2,I 
      SZA,RSS 
      JMP PUT7C 
      LDA LBLP2 
      ADA MM2 
      STA LBLP2 
      ADB MM1 
      JMP PUT7D 
PUT7B JSB CHAR
      JMP PUT7F     NORMAL START
      JSB PUT3K 
      JSB CHAR      CHECK NEXT CHARACTER
      RSS           OK-SKIP 
      JMP PUT1A     ERROR-TOO MANY CHARACTERS 
      JSB PUT3D     SEARCH TABLE
      JMP PUT7A     DID NOT FIND IT 
      ISZ LBLP2     FOUND IT
      LDA LBLP2,I 
      STA OPSRT 
PUT7F LDA D2
      JSB BUILD 
      JMP OPSRT,I   START EXECUTION 
PUT7C LDB LBLP2 
      ADB MM1 
      LDA B,I 
PUT7E STA P056A,I 
H56   LDA B56       UNDEFINED LABEL,XX
      JSB PRINT 
      JMP OPD1
PUT7A LDA LABEL 
      JMP PUT7E 
* 
* 
*     POUT8    SD 
* 
POUT8 LDA PPT8
      STA WD1       SET UP TRANSFER VECTOR
      JSB CHAR
      JMP PUT1A     ERROR 
      JSB PUT1G     CHECK COMMA 
      JSB DCHAR 
      RSS           SHOULD BE DONE
      JMP PUT1A     ERROR 
      JSB PUT1E     ERROR OR DONE?
      ISZ DFLT      DEFAULT?
      RSS           NO
      JMP PUT1A     YES 
      STA WD2 
      JMP PUT1B     EXIT
* 
* 
*     POUT9    ID 
* 
POUT9 LDA PPT9
      STA WD1       SET UP TRANSFER VECTOR
      LDA WPCYL 
      STA WD2       DEFAULT CASE
      JSB PUT1H     LOOK FOR COMMA
      JSB DCHAR 
      JMP PUT6C     DONE OR ERROR?
      ISZ DFLT      SKIP ON DFLT
      STA WD2 
      JSB CHAR
      NOP 
      XOR B104      IS IT A D?
      SZA           SKIP IF YES 
      JMP PUT9A     NO
      LDA BIT14     DEFECTIVE INDICATOR 
PUT9B IOR WD2 
      STA WD2 
      JSB CHAR
      RSS 
      JMP PUT1A 
      JMP PUT1B 
PUT9A XOR B24       IS IT A P?
      SZA           SKIP IF YES 
      JMP PUT1A     NO,ERROR
      LDA BIT15     PROTECTIVE INDICATOR
      JMP PUT9B 
* 
* 
*     POT10    SC,HT
* 
POT10 LDA PPT10     SC
      LDB OPCNT 
      ADB MM10      -10 
      SZB,RSS       SKIP IF SC
      LDA PPT13     HT
      STA WD1       STORE TRANSFER VECTOR 
      CLA 
      STA WD2       DEFAULT VALUE 
      JSB PUT1H     LOOK FOR COMMA
      JSB OCHAR 
      RSS           OK
      JMP PUT1A     ERROR 
      JSB PUT1E     DONE OR ERROR?
      ISZ DFLT      SKIP ON DEFAULT 
      STA WD2       STORE VALUE 
      JMP PUT1B     EXIT
* 
* 
*     POT11    EE 
* 
POT11 LDA BILD
      CPA BPTO
      JMP OPD1      NOTHING TO ERASE
      ADA MM1 
      LDA A,I 
      STA LOCAL     PREVIOUS TRANSFER VECTOR
      ALF,ALF 
      AND B377      WORD COUNT
      CMA,INA 
      ADA BILD
      STA BILD      BILD = BILD - WORD COUNT
      LDA LOCAL 
      AND B377
      XOR B15       IS IT LB
      SZA,RSS 
      JMP PT11A     YES,LB
      XOR B4
      SZA           SKIP IF GO
      JMP OPD1      EXIT
      LDA BILD,I
      AND B1777     GET ADDRESS 
      ADA PAGE8     =16000B 
      STA LOCAL      OF REFERENCED LABEL
      LDA LOCAL,I   IS THIS LABEL 
      SZA           DEFINED?
      JMP OPD1      YES,EXIT
      LDA BILD,I    SEARCH FOR OTHER REFERENCES 
      STA TEMP1     MASK USED TO SEARCH FOR OTHER 
      LDA BILD      REFERENCES
      STA TEMP2     POINTER 
PT11C CPA BPTO
      JMP PT11B     NOT FOUND 
      LDA TEMP2 
      ADA MM1       GET TRANSFER VECTOR 
      LDA A,I 
      ALF,ALF 
      AND B377      GET WORD COUNT
      CMA,INA 
      ADA TEMP2     ADDRESS = ADDRESS - WORD COUNT
      STA TEMP2 
      LDB TEMP2,I 
      CPB TEMP1 
      JMP OPD1      ANOTHER REFERENCE WAS FOUND 
      JMP PT11C 
PT11A LDA LBLP1     SEARCH TABLE FOR LOCATION OF
      INA           THIS LABEL
PT11E STA LBLP2 
      LDA LBLP2,I 
      CPA BILD
      JMP PT11D     FOUND IT
      LDA LBLP2 
      ADA MM2 
      JMP PT11E 
PT11D STA TEMP2     WORK AREA POINTER 
      LDA LBLP2 
      STA LOCAL     ADDRESS OF LABEL
      AND B3777 
      IOR JMPI      =126000B
      STA TEMP1     MASK USED TO SEARCH FOR OTHER 
      CLA           REFERENCES
      STA LOCAL,I   ZERO OUT LABEL
      LDA TEMP2 
      JMP PT11C 
PT11B CLA           NO REFERENCE FOUND
      LDB LOCAL 
      ADB MM1 
      STA B,I       LABEL = 0 
      INA 
      STA LOCAL,I   ADDRESS # 0 ,SO IT WILL BE
      JMP OPD1       DEFINED
* 
* 
*     POT12    EP 
* 
POT12 EQU OPDSN 
* 
* 
*     POT14    LP 
* 
POT14 LDA PPT14     TRANSFER VECTOR 
      JMP PUT7G 
* 
*     POT15    RT 
* 
POT15 LDA PPT15 
      STA WD1       STORE TRANSFER VECTOR 
      JSB CHAR
      JMP PUT1A     ERROR 
      JSB PUT3K     GET LABEL 
      JSB PUT3D     SEARCH TABLE
      JMP PUT7A     DID NOT FIND IT-ERROR 
      ISZ LBLP2     FOUND IT
      LDA LBLP2 
      AND B3777 
      IOR JMPI      =126000B
      STA WD4 
      JSB CHAR
      JMP PUT1A     ERROR 
      JSB PUT1G 
      JSB DCHAR     GET NUMBER OF TIMES TO REPEAT 
      RSS           OK-SKIP 
      JMP PUT1A     ERROR 
      JSB PUT1E     DONE OR ERROR?
      STA WD2 
      CLA 
      STA WD3 
      LDA D5
      JSB BUILD 
      JMP OPD1
      SKP 
* 
*     TVP1     AR,DS,IS,SR
* 
TVP1  NOP 
      JSB OPEND     CHECK FOR ABORT 
      LDB TVP1,I    WD2 
      LDA TVP1
      STA LOCAL 
      LDA B 
      ALF,ALF 
      AND B377
      STA CYL       CYLINDER
      LDA B 
      AND B37 
      STA SECTR     SECTOR
      LDA B 
      ALF,ALF 
      ALF,RAR 
      AND B7
      STA HEAD      HEAD
      ISZ TVP1
      LDA TVP1,I    WD3 
      ISZ TVP1
      AND B37       OP CODE 
      SZA 
      JMP TVP1A 
TVP1H EQU * 
      JSB SEEH      LOAD RAR
      JSB WAIH      WAIT FOR HEADS TO SWITCH
TVP1F LDA TVP1,I    NEXT TRANSFER VECTOR
      JSB TVP1G     CHECK STATUS
      JMP TVP1,I    EXIT
TVP1A XOR B23 
      SZA 
      JMP TVP1B 
TVP1D EQU * 
      JSB SEEK      SEEK
      JSB WAITS     WAIT FOR SEEK 
      JMP TVP1F 
TVP1B XOR B26 
      SZA 
      JMP TVP1C 
      LDA B         DS
      AND B377      SAVE HEAD-SECTOR
      LDB CYL 
      SZB,RSS 
      LDB D203
      ADB MM1       DECREMENT CYL 
TVP1E BLF,BLF 
      IOR B 
      STA LOCAL,I   CHANGE WD2
      JMP TVP1D 
TVP1C LDA B         IS
      AND B377      SAVE HEAD-SECTOR
      LDB CYL 
      INB           INCREMENT CYLINDER
      CPB D203
      CLB 
      JMP TVP1E 
TVP1G NOP 
      CPA PPT10     IS NEXT TRANSFER VECTOR SC
      JMP TVP1G,I   YES 
      JSB WCHK      NO
      JMP TVP1G,I 
* 
* 
*     TVP2     CE,RL,RR,RS,ST,FL,FU,VL,VU 
* 
TVP2  NOP 
      JSB OPEND     CHECK FOR ABORT 
      LDA TVP2,I    WD2 
      ISZ TVP2
      AND B37       OP CODE 
      XOR B17 
      SZA 
      JMP TVP2A 
      JSB RFNE      ISSUE REFINE COMMAND
TVP2G LDA TVP2,I
      JSB TVP1G     CHECK STATUS
      JMP TVP2,I
TVP2A XOR B37 
      SZA 
      JMP TVP2E 
      JSB RNCHI,I   RS, RANDOM CYLINDER AND HEAD
      JSB RNSCI,I   RANDOM SECTOR 
      LDA TVP2
      STA TVP1
      JMP TVP1D 
TVP2E XOR D6
      SZA 
      JMP TVP2B 
      LDA TVP2      RL
      STA TVP1
      JMP TVP1H 
TVP2B XOR B25 
      SZA 
      JMP TVP2F 
      STA SECTR     CE
TVP2C JSB SWR 
      ARS,ARS 
      ARS,ARS 
      AND B3
      STA HEAD      HEAD = BIT 5 * 2 + BIT 4
      JSB SWR 
      LDB D95 
      AND B3
      SZA,RSS 
      JMP TVP2D     SWR = 0   CYL = 95
      ADB D5        B = 100 
      ADA MM1 
      SZA,RSS 
      JMP TVP2D     SWR = 1   CYL = 100 
      ADB D5        B = 105 
      ADA MM1 
      SZA           SWR = 2   CYL = 105 
      JMP TVP2,I    SWR = 3   DONE
TVP2D STB CYL 
      JSB FSEEK     SEEK IN S7
      JMP TVP2C     CYCLE 
TVP2F EQU * 
      XOR B24 
      SZA 
      JMP TVP2H 
      JSB STAT      ST
      JMP TVP2G 
TVP2H EQU * 
      XOR B15 
      SZA 
      JMP TVP2J 
TVP2K STA HEAD      FU
      CLA 
      STA SECTR 
      STA WRSP
TVP2I EQU * 
      STA CYL 
      JSB FSEEK     SEEK TO EACH CYLINDER 
      JSB WADI,I    FORMAT CYLINDER 
      LDA D48 
      JSB FCYKI,I   VERIFY WITH CYCLIC CHECK
      CLA,INA 
      ADA CYL 
      CPA CYPP      DONE? 
      JMP TVP2,I    YES 
      JMP TVP2I     NO - CONTINUE 
TVP2J XOR B3
      SZA 
      JMP TVP2L 
      LDA D2        FL
      JMP TVP2K 
TVP2L XOR D5
      SZA 
      LDA D2        VL
      STA HEAD      VU
      LDA P5767     IGNORE FLAGGED CYLINDERS AND
      STA NFFB       WRITE PROTECT
      CLA 
      STA SECTR 
TVP2M EQU * 
      STA CYL 
      LDA D48 
      JSB FCYKI,I   SEEK-THEN CYCLIC CHECK CYLINDER 
      CLA,INA 
      ADA CYL 
      CPA CYPP      DONE? 
      RSS           YES 
      JMP TVP2M     NO - CONTINUE 
      LDA MM1       RESET STATUS
      STA NFFB       MASK 
      JMP TVP2,I
P5767 OCT 175767
* 
* 
*     TVP4     CD,RD,WD 
* 
TVP4  NOP 
      JSB OPEND     CHECK FOR ABORT 
      LDA TVP4,I    WD2 
      STA WCNT
      ISZ TVP4
      LDA TVP4,I    WD3 
      ISZ TVP4
      AND B377      OP CODE 
      XOR B16 
      SZA 
      JMP TVP4A 
      JSB READ
TVP4C LDA TVP4,I
      JSB TVP1G     CHECK STATUS
      JMP TVP4,I    EXIT
TVP4A XOR B32 
      SZA 
      JMP TVP4B 
      JSB WRITE 
      JMP TVP4C 
TVP4B EQU * 
      LDA WCNT
      ALF,ALF 
      RAL 
      AND B377      SECTOR COUNT
      STA WCNT
      JSB CYCK      ISSUE CYCLIC CHECK COMMAND
      JMP TVP4C 
* 
* 
*     TVP5     CB 
* 
TVP5  NOP 
      JSB OPEND     CHECK FOR ABORT 
      LDA TVP5,I    WD2 
      STA WCNT
      ISZ TVP5
      LDA TVP5,I    WD3 
      STA NUMP
      ISZ TVP5
      JSB DCHK      COMPARE BUFFERS 
      ISZ TVP5
      LDA D1
      STA NUMP
      JMP TVP5,I
* 
* 
*     TVP6     DB 
* 
TVP6  NOP 
      JSB OPEND     CHECK FOR ABORT 
      LDA TVP6,I    WD2 
      LDB A 
      AND D7777     =37777
      STA WCNT
      SZA,RSS 
      JMP TVP6F     WORD COUNT = 0
      LDA WCNT
      CMA,INA 
      STA WCNT      WCNT = -WCNT
      LDA BPTR
      STA LOCAL 
      SSB 
      JMP TVP6A     F=1 
TVP6B JSB RAND      F=0 
      JSB TVP6E     STORE IN BUFFER,CHECK FOR END 
      JMP TVP6B 
TVP6A RBL 
      SSB 
      CLB           C=0,F=1 
      ISZ TVP6      C=1,F=1 
      LDA TVP6,I
TVP6C JSB TVP6E     STORE IN BUFFER,CHECK FOR END 
      SZB,RSS 
      CMA 
      JMP TVP6C 
TVP6E NOP 
      STA LOCAL,I   STORE A IN BUFFER 
      ISZ LOCAL 
      ISZ WCNT      DONE? 
      JMP TVP6E,I   NO
TVP6G ISZ TVP6      YES 
      ISZ TVP6
      JMP TVP6,I    EXIT
TVP6F SSB 
      ISZ TVP6
      JMP TVP6G 
* 
* 
*     TVP8     SD 
* 
TVP8  NOP 
      JSB OPEND     CHECK FOR ABORT 
      LDA TVP8,I    WD2 
      ISZ TVP8
      STA UNIT      STORE UNIT NUMBER 
      ISZ TVP8
      JMP TVP8,I    EXIT
* 
* 
*     TVP9     ID 
* 
TVP9  NOP 
      JSB OPEND     CHECK FOR ABORT 
      LDA TVP9,I    WD2 
      LDB A 
      AND D7777     =37777B 
      STA WCNT
      CLA 
      SSB 
      LDA WRILB     PROTECTIVE TRACK INDICATOR
      RBL 
      SSB 
      LDA DFTB      DEFECTIVE TRACK INDICATOR 
      STA WRSP
      JSB WADRI,I   WRITE ADDRESS 
      ISZ TVP9
      ISZ TVP9
      LDA TVP9,I
      JSB TVP1G     CHECK STATUS
      JMP TVP9,I    EXIT
                                                                                                                                                                                    