ASMB,Q,R,C
      HED SWTCH - TRANSFERS FILE CONTAINING RTE-IV SYSTEM GENERATED ONLINE
      NAM SWTCH,3,10 92067-16513 REV.2001 791022
      SPC 1 
******************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS     *
*  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
*  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
******************************************************************
      SPC 2 
****************************************
* 
*     NAME:           SWTCH 
*     SOURCE:         92067-18513 
*     BINARY:         92067-16513 
*     WRITTEN BY:     KFH,JJC 
* 
****************************************
      SPC 2 
* 
* TURN - ON SEQUENCE: 
* 
*  RU,SWTCH,FNAME:SC:CR,CHAN/DISC LU,SUBCH/UNIT/ADDR,AUTO,FILES,TYPE6,INIT
* 
*  WHERE: 
* 
*  FLNAME:SC:CR  IS THE ABSOLUTE OUTPUT FILE NAME OF THE NEW SYSTEM 
*  CHAN          7900 DISC ONLY: <OCTAL TARGET SELECT CODE>"B"
*                OR 
*  DISC LU       7905/05/20/25(H) DISCS: DUMMY LU THAT POINTS AT DRIVER 
*  SUBCH         IS THE TARGET 7900 SUBCHANNEL
*                OR 
*  UNIT          IS THE TARGET 7905/06/20/25 UNIT 
*                OR 
*  ADDR          IS THE HPIB SELECT ADDRESS 
*  AUTO          IS Y/N, FOR AUTO BOOT-UP 
*  FILES         IS Y/N, FOR SAVING THE TARGET FILE SYSTEM
*  TYPE6         IS Y/N, FOR PURGING THE TYPE 6 FILES AT THE TARGET 
*  INIT          IS Y/N, FOR INITIALIZING ANY ADDITIONAL SUBCHANNELS
     SPC 2
* 
* 
* THE ON-LINE RTE GENERATOR PRODUCES AN FMP FILE CALLED THE 
* ABSOLUTE OUTPUT FILE WHICH CONTAINS A COMPLETE RTE-IV+
* SYSTEM FOR THE SPECIFIC DISC CONFIGURATION AS SPECIFIED AT
* GENERATION TIME.  SWTCH COPIES THE FILE ONTO THE SPECIFIED
* DISC SELECT CODE AND SUBCHANNEL FOR 7900 TYPE DISCS. SWTCH
* CONFIGURES ITS OWN DRIVER TO THIS SELECT CODE.  IN THE CASE OF
* ALL TYPE 32 DISCS (IE. 7905/05/20/25 (H)) SWTCH REQUIRES A
* DUMMY DISC LU WHICH POINTS AT THE CORRECT DRIVER IN THE HOST
* SYSTEM. SWTCH THEN CALLS THE ON-LINE DRIVER VIA THE DRIVER
* LIBRARY SUBROUTINES TO DO THE NECESSARY I/O TO THE TARGET DISC. 
* 
* BEFORE THE TRANSFER BEGINS, THE FILE IS CHECKED FOR VALIDITY, 
* THE OPERATOR IS NOTIFIED OF THE DESTINATION CONFIGURATION,
* INCLUDING THE SYSTEM SUBCHANNEL DEFINITION. 
* 
* IF THE NEW RTE SYSTEM OVERLAYS THE CURRENT SYSTEM, A NEW
* FMP SETUP (INITIALIZED) CODE WORD IS COMPUTED AND WRITTEN 
* INTO THE FMP CARTRIDGE DIRECTORY SO THAT ON BOOTUP, FMP 
* WILL REMAIN INTACT (INITIALIZED). 
      SKP 
*  ENTRY POINTS 
* 
      ENT SWTCH 
* 
      ENT \SWTM 
      ENT \DFTR,\DSHD,\DNSU,\DNSP,\DNTR,\DSUB 
      ENT \TUNT,\TDLU,\TSUB,\DUNT,\D#ST,\D#WT 
      ENT \INIT,\LNTH 
      ENT \BUFI,\BUFA,\XOUT,\SAVE 
      ENT \TRAK,\SECT 
      ENT \CVAS,\CLEN,\DSPL,\BLIN,\RDIN,\DFLT 
      ENT \FFMP,\STRK 
      ENT \BOOT,\TMT,\LU2,\MODE 
* 
*  EXTERNAL ENTRY POINTS
* 
      EXT RMPAR,EXEC,$LIBR,SEGLD
      EXT OPEN,READF,LOCF,CLOSE 
      EXT $LIBR,$LIBX 
* 
      EXT \DSK0,\DSK5 
      EXT \INP0,\INT0 
      EXT \STD0 
      EXT CNUMD,GETST 
      EXT \RET
      EXT \FLGT,\SETD,\BADH 
      EXT EQTRQ,\GDMA,\RDMA,$DATC 
* 
      SPC 2 
A     EQU 0 
B     EQU 1 
      SUP 
      SKP 
*                HEADER RECORD #1 FORMAT
* 
* FOR A 7905/6/20/25(H) SYSTEM: 
* 
*        ------------------------------------ 
*        !     # 64-WORD SECTORS/TRACK      ! 
*        ------------------------------------ 
*        !       FIRST CYLINDER #           !        ONE 5-WORD 
*        ------------------------------------ 
*        ! # SUFACES ! STARTING HEAD!UNIT/AD!        ENTRY FOR
*        ------------------------------------ 
*        !       NUMBER OF TRACKS           !        SUBCHANNELS
*        ------------------------------------ 
*        !100!UNIT(3)!00 !    #SPARES(8)    !        0 THRU 31
*        ------------------------------------ 
*        <- HPIB DISCS -> 
*               ONLY
* 
* FOR A 7900 SYSTEM:
* 
*        ------------------------------------ 
*        !       FIRST TRACK #              !        SUBCHANNEL 0 
*        ------------------------------------ 
*                        .                           SUBCHANNELS 1
*                        .
*                        .                           THRU 7 
*        ------------------------------------ 
*        !       NUMBER OF TRACKS           !        SUBCHANNEL 0 
*        ------------------------------------ 
*                        .                           SUBCHANNELS 1
*                        .
*                        .                           THRU 7 
      SKP 
*                HEADER RECORD #2 FORMAT
* 
*                         . 
*                         . 
*                         . 
* 
*        ------------------------------------ 
*        ! 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1  !        INDICATES AN RTE-IV+ 
*        ------------------------------------ 
*    59  !1! SYSTEM SUBCHANNEL# BIT 15=HPIB ! 
*        ------------------------------------ 
*    60  !       SYSTEM EQT #               ! 
*        ------------------------------------ 
*    61  !       NUMBER OF EQT'S            ! 
*        ------------------------------------ 
*    62  !       PRIV. INT. CHANNEL         ! 
*        ------------------------------------ 
*    63  !       TBG CHANNEL                ! 
*        ------------------------------------ 
*    64  ! # SUBCHANNELS  !   TTY CHANNEL   ! 
*        ------------------------------------ 
*    65  !   CHANNEL #    !   EQT TYPE      !        FOR EQT #1 
*        ------------------------------------ 
*                         .                               . 
*                         .                               . 
*                         .                               . 
*        ------------------------------------ 
*   127  !    CHANNEL #   !   EQT TYPE      !        FOR EQT #63
*        ------------------------------------ 
      SKP 
      SPC 4 
*------------------------------------------------------------------------ 
* 
*              THE FOLLOWING 8192 WORDS WILL BE OVERLAID
*              ONCE THE TRANSFER PROCESS BEGINS. BUFR 
*              WILL CONTAIN ONE TRACK'S WORTH OF INFO.
* 
*------------------------------------------------------------------------ 
      SPC 4 
IBBUF BSS 16        COMMAND BUFFER FOR DRIVER LIBRARY 
BUFR  BSS 128       BUFFER FOR MAXIMUM SIZE TRACK (8192 WORDS)
* 
* 
MES1  DEF *+1 
      ASC 22,              ******  W A R N I N G  ******
MES2  DEF *+1 
      ASC 23,ALL ACTIVITY MUST BE TERMINATED BEFORE SYSTEM
      ASC 9,TRANSFER PROCESS. 
      SPC 2 
      BSS 512+BUFR-*   NEED TO READ IN 4 RECORDS AT VERF1 
      SPC 2 
MES3  DEF *+1 
      ASC 14,FILE NAME OF NEW RTE SYSTEM? 
MES4  DEF *+1 
      ASC 16,ILLEGAL FILE NAME - FMP ERR XXXX 
MES4A DEF MES4+15 
MES5  DEF *+1 
      ASC 15,NEW SYSTEM I/O CONFIGURATION:
MES6  DEF *+1 
      ASC 18,SELECT CODE XX PRIVILEGED INTERRUPT
MES6A DEF MES6+7
MES7  DEF *+1 
      ASC 9,SELECT CODE XX TBG
MES7A DEF MES7+7
MES8  DEF *+1 
      ASC 11,SELECT CODE XX TYPE=XX 
MES8A DEF MES8+7
MES8B DEF MES8+11 
MES9  DEF *+1 
      ASC 24,NEW SYSTEM (LU2) SELECT CODE= XX  SUBCHANNEL= XX 
MES9A DEF MES9+16 
MES9B DEF MES9+24 
MES10 DEF *+1 
      ASC 12,PLATTER XX FIRST TRACK#
MS10A ASC 9,XXXX  #TRACKS XXXX
MS10C DEF MS10A 
MS10D DEF MS10A+7 
MES11 DEF *+1 
      ASC 4,ILLEGAL 
MS12  ASC 25,TARGET SELECT CODE FOR NEW SYSTEM?  (XX OR " "CR)
MES12 DEF MS12
MSS12 DEF *+1 
      ASC 25,TARGET DISC LU FOR NEW SYSTEM?  (XX) 
MES13 DEF *+1 
      ASC 18,TARGET ADDRESS/UNIT/PLATTER FOR NEW
      ASC 10,SYSTEM? (X OR " "CR) 
MES16 DEF *+1 
      ASC 23,NOW IS THE TIME TO INSERT CORRECT CARTRIDGE IN 
MES17 DEF *+1 
      ASC 25,TARGET ADDRESS/UNIT/PLATTER.   (" "CR TO CONTINUE) 
MES18 DEF *+1 
      ASC 16,SAVE FILES AT TARGET?   (Y OR N) 
MES19 DEF *+1 
      ASC 19,NEW SYSTEM WILL DESTROY SOME FMP FILES 
MES20 DEF *+1 
      ASC 12,OK TO PROCEED? (Y OR N)
MES22 DEF *+1 
      ASC 15,PURGE TYPE 6 FILES?   (Y OR N) 
MES23 DEF *+1 
      ASC 23, INFORMATION STORED ON ADDRESS/UNIT/PLATTER XX 
      ASC 13, OF TARGET SELECT CODE  XX 
MS23A DEF MES23+23
MS23B DEF MES23+36
MS23C DEF *+1 
      ASC 9, WILL BE DESTROYED
MES24 DEF *+1 
      ASC 12,AUTO BOOT-UP?   (Y OR N) 
MES25 DEF *+1 
      ASC 25,PRESENT CONFIGURATION DOESN'T PERMIT AUTO BOOT-UP. 
MES26 DEF *+1 
      ASC 22,DISC IN HOST SYSTEM DRIVE WILL BE OVERLAID.
MES32 DEF *+1 
      ASC 17,READY TO TRANSFER. OK TO PROCEED?
MES34 DEF *+1 
      ASC 18,INITIALIZE SUBCHANNELS  ?  (Y OR N)
MS34A DEF MES34+12
"L"   ASC 1,L 
MES35 DEF *+1 
      ASC 15,TARGET PLATTER?  (XX OR " "CR) 
MES36 DEF *+1 
      ASC 20,TARGET ADDRESS/UNIT XX FOR SUBCHANNELS 
MS36A ASC 24, 
      ASC 20, 
      ASC 24, 
COMBL ASC 1,, 
MS36B DEF MS36A 
MES37 DEF *+1 
      ASC 20,DESTN. ADDRESS/UNIT XX FOR SUBCHANNELS 
MS37A ASC 24, 
      ASC 20, 
      ASC 24, 
MS37B DEF MS37A 
MES38 DEF *+1 
      ASC 18,TARGET ADDRESS/UNIT?  (XX OR " "CR)
MES40 DEF *+1 
      ASC 17,#TRACKS           FIRST CYL
MS40A DEF MES40+6 
MS40B DEF MES40+16
MES41 DEF *+1 
      ASC 17,HEAD #            #SURFACES
MS41A DEF MES41+6 
MS41B DEF MES41+16
MES42 DEF *+1 
      ASC 17,ADDR/UNIT         #SPARES
MS42A DEF MES42+6 
MS42B DEF MES42+16
MES43 DEF *+1 
      ASC 17,#SECTORS/TRACK 
MS43B DEF MES43+16
MES46 DEF *+1 
      ASC 12,OUTDATED SYSTEM SOFTWARE 
* 
SWAP0 DEF *+1 
      ASC 3,SWSG1   7900 DISK DRIVER SEGMENT
SWAP5 DEF *+1 
      ASC 3,SWSG2   TYPE 32(13037 CTRLR) & HPIB DRIVER SEGMENT
      SKP 
*  CONSTANTS
* 
B177  OCT 177 
B777  OCT 777 
B2060 OCT 20060 
* 
N6    DEC -6
N7    DEC -7
N8    DEC -8
N31   DEC -31 
N64   DEC -64 
N89   DEC -89 
N128  DEC -128
* 
P7    DEC 7 
P12   DEC 12
P13NA OCT 100015    DECIMAL 13 +100000B (NO ABORT BIT)
P14   DEC 14
P31   DEC 31
P98   DEC 98
P161  DEC 161 
P512  DEC 512 
* 
* 
#LEP  EQU 1762B     # OF LIBRARY ENTRY POINTS IN LIST 
ALEP  EQU 1761B     ADDR    "      "     "    LIST
LEPL  NOP           LENGTH  "      "     "     "
LCNT  NOP           COUNTER 
$T    ASC 1,$T
B3    ASC 1,B3
.2    ASC 1,2 
TMTSF OCT 2202
      SKP 
* 
*  GTLEN  COMPUTES LLEN FOR READING THE 
*         LIBRARY ENTRY POINTS LIST INTO
*         BUFR
* 
*  CALLING SEQUENCE: (A)=REMAINING SIZE OF L.E.P. 
*                    JSB GTLEN
* 
GTLEN NOP 
      LDB P512      THE NORMAL BUFFER SIZE
      CMA,INA       IF MORE THAN THE REMAINING
      ADA P512       LEP SIZE, THEN USE THE SIZE
      SSA,RSS       IN (A)
      LDB LEPL
      STB LLEN
      JMP GTLEN,I 
      SPC 5 
* 
*  READD  READS LLEN WORDS AT TRACK LTRK, AND 
*         SECTOR LSEC 
* 
READD NOP 
     JSB EXEC 
     DEF *+7
     DEF D1 
     DEF P2 
     DEF BUFR 
     DEF LLEN 
     DEF LTRK 
     DEF LSEC 
* 
     JMP READD,I
* 
* 
LTRK  NOP 
LSEC  NOP 
      SKP 
* 
*   VERIFIES THE EXISTENCE OF A SYSTEM SUBCHANNEL MATCH 
*   AT THE TARGET CHANNEL AND SUBCHANNEL. THE FOLLOWING 
*   CHECKS ARE MADE:
* 
*      VERIFY THAT A CARTRIDGE DIRECTORY EXISTS ON THE
*             LAST SYSTEM TRACK (AS DEFINED BY THE NEW
*             SYSTEM) 
*  OR  VERIFY THAT A FILE DIRECTORY SPECIFICATION ENTRY 
*             EXISTS ON THIS TRACK
* 
* 
*      RETURN: (P+1) CAN'T SAVE THE FILE STRUCTURE
*              (P+2) CAN SAVE IT
* 
VFYSY NOP 
      CLA 
      STA \INIT     CLEAR INIT WORD FOR DISKD 
* 
      LDA N128
      STA \LNTH     READ 128 WORDS
      CCE           HOPEFULLY THEY WILL CONTAIN 
      LDB \BUFA     THE DIRECTORY AT
      STB BPTR      TARGET SUBCHANNEL 
      CCA 
      ADA \DNTR      DESTINATION SYSTEM LAST(LOGICAL) 
      STA \TRAK      TRACK, LESS 1
      CLA 
      STA \SECT 
      INA 
      STA \MODE   SET TYPE 32 DRIVER MODE TO REG R/W
      JSB DISKD 
* 
* 
* VERIFY THE EXISTENCE OF A CARTRIDGE DIRECTORY 
* 
      LDA N31       MAX # CARTRIDGE ENTRIES 
      STA TEMP1 
CHCD0 LDA BPTR,I    GET WORD 0 OF ENTRY 
      SSA 
      JMP NEWFD     LU WORD < 0 
      LDB N64 
      ADB A 
      SSB,RSS 
      JMP NEWFD     LU > 77(8)
* 
      CPA D0        END OF LU'S ? 
      JMP CHCD3     YES 
      CPA P2        LU 2 (SYSTEM) ? 
      RSS           YES 
      JMP CHCD1     CHECK WORDS 1-3 IN ENTRY
* 
      LDB BPTR      GET WORD #1 OF THE (POSSIBLY) 
      INB           SYSTEM LU 2 ENTRY 
      LDA B,I 
      SSA 
      JMP NEWFD     LAST FMP TRACK WORD < 0 
      STA D.LT      SAVE FOR LATER CHECKS 
* 
CHCD1 LDA N3
      STA TEMP2 
* 
CHCD2 ISZ BPTR      CHECK WORDS 1,2,&3
      LDA BPTR,I    OF ENTRY FOR VALUES 
      SSA           >= 0
      JMP NEWFD     INVALID 
      ISZ TEMP2 
      JMP CHCD2     CHECK NEXT WORD 
      ISZ BPTR      NEXT ENTRY WORD 0 
      ISZ TEMP1     LAST ENTRY (31)?
      JMP CHCD0     NO,CONTINUE 
* 
*     POSSIBLY A NEW FILE DIRECTORY FORMAT: CARTRIDGE DIRECTORY 
*     IS AT END OF OP SYSTEM
* 
NEWFD LDB \BUFA     RESET BUFFER POINTER
      STB BPTR      TO CHECK FOR FD AT
      ISZ D.LT      BEGINNING OF DIRECTORY TRACK
      NOP           SET D.LT TO 0 TO INDICATE 
      ISZ OLDNU     A POTENTIAL NEW FORMAT
      JMP CHFD0     CHECK FOR FD
* 
CHCD3 LDA D.LT      (WAS INITIALLY -1)
      SSA 
      JMP NEWFD     NEVER SET BY A LU 2 
      LDA BF124 
      SZA 
      JMP NEWFD     WORD 124 OF CD MUST = 0 
* 
* 
*  LOOKED LIKE A CARTRIDGE DIRECTORY.  NOW TRY FOR A
*  FILE DIRECTORY IN THE NEXT BLOCK.
* 
      CCA 
      ADA \DNTR      DETERMINE DISK ADDRESS OF NEXT 
      STA \TRAK      BLOCK CONTAINING THE 
      LDA P14        FILE SPEC ENTRY
      STA \SECT     READ 128 WORDS, HOPEFULLY THE 
      LDB \BUFA      SPEC ENTRY 
      STB BPTR
      CCE 
      JSB DISKD 
* 
CHFD0 LDA BPTR,I    TESTS FOR A VALID FILE DIRECTORY ENTRY: 
      SSA,RSS 
      JMP NOTFS     WORD 0 MUST BE < 0
* 
      LDA N7        WORDS 1-7,9-15 IN SPEC MUST BE >= 0 
      STA TEMP2 
CHFD1 ISZ BPTR
      LDA BPTR,I
      SSA 
      JMP NOTFS     < 0, THEREFORE INVALID
      ISZ TEMP2 
      JMP CHFD1 
* 
      ISZ BPTR      WORD 8 MUST BE < 0
      LDA BPTR,I
      SSA,RSS 
      JMP NOTFS 
      LDA N6        NOW CHECK WORDS 9-15
      STA TEMP2 
CHFD2 ISZ BPTR
      LDA BPTR,I
      SSA 
      JMP NOTFS 
      ISZ TEMP2 
      JMP CHFD2 
* 
      LDA BF6       WORD 6 (#SECTORS/TRACK) MUST BE 
      CPA \D#ST      SAME AS DESTINATION SYSTEM 
      RSS 
      JMP NOTFS      AND
      LDB BF5         >= WORD 5 (NEXT AVAILABLE SECTOR) 
      CMB,INB 
      ADA B 
      SSA 
      JMP NOTFS     INVALID 
* 
      LDA BF7        LOWEST DIRECTORY TRACK(LOGICAL)
      LDB BF8         MINUS THE NEGATIVE # DIRECTORY
      STB D.#         TRACKS, 
      CMB             MINUS 1 
      ADA B         GIVES LAST FMP TRACK
      CPA D.LT      MUST = LAST FMP TRACK INDICATED 
      JMP CHFD3      IN CD FOR LU 2 
      LDB D.LT      ELSE NONE FOUND AT ALL
      SZB 
      JMP NOTFS     NEITHER 
      STA D.LT      OTHERWISE UPDATE LAST FMP TRACK 
* 
CHFD3 LDB \DNTR      DOES  THE LOGICAL DIRECTORY TRACK #
      ADB N1         AT TARGET = LOGICAL DIRECTORY TRACK #
      CPA B          FOR DESTINATION (THE LAST LOGICAL TRACK FOR
      RSS            SYSTEM LU) ? 
      JMP NOTFS     NO
      LDA BF4       SAVE THE FIRST FMP TRACK FOR
      STA \FFMP       FUTURE CHECKS 
* 
*     SET UP SOME VALUES FOR SCANNING THE DIRECTORY 
*     ENTRIES LATER - ESPECIALLY WHEN PURGING OVERLAID FILES
*     OR TYPE 6 FILES 
* 
      LDA OLDNU     GET THE FLAG TO INDICATE THE DIFFERENCES
      LDB \D#ST     DETERMINE # OF 16-WORD
      RBL,RBL        ENTRIES PER TRACK
      SZA,RSS       OLD VERSION 
      ADB N8         HAS 8 LESS CUZ OF CD 
      CMB,INB       COMPLEMENT
      STB FDT#E     NUMBER TO SCAN ON FIRST TRACK 
      LDB P4        NOW DETERMINE THE WORD 4 OFFSET 
      SZA,RSS       IN THE FILE SPEC'N ENTRY
      ADB P896      BEGINNING OF SECOND BLOCK FOR OLD 
      ADB \BUFA     ADD BUFFER ADDRESS
      STB FDOFF     AND SAVE
      LDB \BUFA     NOW THE OFFSET FOR THE FIRST
      SZA,RSS       DIRECTORY ENTRY (OK TO
      ADB P128       SCAN THE SPEC'N ENTRY) 
      STB FIRDE 
      LDA \D#WT     NOW SET A POINTER TO THE
      ADA \BUFA     LAST WORD+1 IN THE DIRECTORY
      STA DTEND     TRACK BUFFER
* 
      ISZ VFYSY     LOOKS VALID 
      JMP VFYSY,I 
* 
P896  DEC 896 
      SPC 2 
* 
*  ONE OF THE ABOVE TESTS FAILED, THEREFORE NOT ALLOWING THE
*  TARGET FILE STRUCTURE TO BE SAVED
* 
NOTFS CLA,INA 
      STA \CLEN 
* 
      LDA \TSUB 
      LDB DEQT
      SLB,RSS 
      LDA \TUNT 
      LDB MS23A 
      JSB \CVAS 
* 
      LDB DEQT
      LDA \T32C     SELECT CODE IF TYPE 32 DISC 
      SLB 
      LDA \TDLU     SELECT CODE IF TYPE 31 DISC 
      LDB MS23B 
      JSB \CVAS 
      LDA P36 
      LDB MES23     "INFORMATION STORED ON ADDRESS/UNIT/... 
      JSB \DSPL     OF TARGET SELECT CODE YY WILL BE DESTROYED" 
      LDA P9
      LDB MS23C 
      JSB \DSPL 
* 
      JSB OK?       CHECK ANSWER
* 
      CLA 
      STA \SAVE     DON'T \SAVEFILES
      STA TYP6      "     "   PURGE TYPE 6'S
      JMP VFYSY,I 
* 
P36   DEC 36
* 
BF4   EQU BUFR+4
BF5   EQU BUFR+5
BF6   EQU BUFR+6
BF7   EQU BUFR+7
BF8   EQU BUFR+8
BF124 EQU BUFR+124
      SKP 
*  VERIFIES THE EXISTENCE OF A TRACK 0, SECTOR 0 BOOTSTRAP
*  IN HEADER RECORD #3
* 
* 
*  RETURN: (P+1)  NOT A BOOTSTRAP 
*          (P+2)  YES, ONE EXISTS 
* 
VT0S0 NOP 
* 
      LDA DSIB?     IS THIS AN HPIB SYSTEM??
      SLA           DSIB?=1/0=HPIB/NOT HPIB 
      JMP IBISY     YES-IBI SYSTEM
* 
      LDB BPTR
      ADB B155
      LDA P5        # WORDS FOR CHECKSUM
      JSB CHKSM 
      CPA MAGIC     DOES IT MATCH THE BOOT'S CHECKSUM 
      ISZ VT0S0     YES - INCR RETURN ADDR. 
      JMP VT0S0,I   RETURN
* 
*     CHECK OUT THE ICD BOOT EXTENSION IN THE FILE
* 
IBISY LDB BPTR
      ADB B277      OFFSET INTO THE BOOT TO 'BENTR' 
      LDA P5        # WDS FOR CHECKSUM
      JSB CHKSM     COMPUTE 5 WD CHECKSUM 
      CPA MAGIC     DOES IT MATCH MAGIC WORD??
      ISZ VT0S0       YES- INCR RETURN
      JMP VT0S0,I   RETURN
* 
* 
* 
B155  OCT 155 
B277  OCT 277 
* 
MAGIC OCT 101707    THE CHECKSUM OF 5 INSTRUCTIONS IN 
*                   THE BOOT EXTENSION
      SKP 
*     OK? QUERIES THE USER WITH:
*         "OK TO PROCEED? (Y OR N)" 
*     AND TRANSFERS TO \XOUT ON A "N" RESPONSE, 
*     DOING A SIMPLE RETURN ON A "Y" RESPONSE.
* 
OK?   NOP 
      LDA P12 
      LDB MES20 
      JSB \DSPL 
      JSB YE?NO     DECIPHER ANSWER 
      JMP OK?+1     INVALID REPLY 
      JMP OK?+1     INVALID REPLY 
      JMP \XOUT      NO,TERMINATE SWTCH 
      JMP OK?,I 
      SPC 4 
*    YE?NO READS THE OPERATOR ANSWER ( Y OR N ) 
*    RETURNS TO (P+1) IF INVALID ANSWER 
*               (P+2) IF /E 
*               (P+3) IF NO 
*               (P+4) IF YES
* 
YE?NO NOP 
      LDA N2
      LDB \BUFI 
      JSB \RDIN     RETRIEVE ANSWER IN IBBUF
* 
      CLE           CHECK HIGH HALF FIRST 
      LDA IBBUF 
      CPA "/E"
      JMP EOUT
YENO  ALF,ALF 
      AND B377
      CPA "N" 
      JMP NOUT
      CPA "Y" 
      JMP YOUT
* 
      SEZ           CHECK THE LOW HALF? 
      JMP YE?NO,I   ALREADY DID - NEITHER MATCHES 
      LDA IBBUF      SWITCH EM
      ALF,ALF 
      CCE 
      JMP YENO      CHECK THE LOW HALF
* 
YOUT  ISZ YE?NO 
NOUT  ISZ YE?NO 
EOUT  ISZ YE?NO 
      JMP YE?NO,I 
* 
"N"   OCT 116 
"Y"   OCT 131 
"/E"  ASC 1,/E
      SPC 4 
* 
*     READS TARGET RESPONSES, INCLUDING RE-ISSUING EXEC CALL
*     IN CASE OF TIME-OUTS. 
* 
TARGT NOP 
      LDA N8        MAX INPUT LENGTH
      LDB \BUFI 
      JSB \RDIN     GET RESPONSE
      JMP TARGT,I   YES, RETURN 
      SKP 
* 
*  PARMP, PARAMETER PARSING ROUTINE (CONVERTED FROM NAMR,DLB) 
*         PRODUCES A PARAMETER BUFFER 12 WORDS LONG 
* 
*  THE TWELVE WORDS ARE DESCRIBED AS FOLLOWS: 
      SPC 1 
*  WORD 1 = 0 IF TYPE = 0 (SEE BELOW) 
*         = 16 BIT TWO'S COMPLEMENT NUMBER IF TYPE = 1
*         = CHARS 1 & 2 IF TYPE = 3 
*  WORD 2 = 0 IF TYPE = 0 OR 1, CHARS 2 & 3 OR TRAILING SPACE(S) IF 3.
*  WORD 3 = SAME AS WORD 2. (TYPE 3 PARAM. IS LEFT JUSTIFIED) 
*  WORD 4 = PARAMETER TYPE OF ALL 8 PARAMETERS IN 2 BIT PAIRS.
*           0 = NULL PARAMETER
*           1 = INTEGER NUMERIC PARAMETER 
*           2 = NOT IMPLEMENTED YET 
*           3 = LEFT JUSTIFIED 6 ASCII CHARACTER PARAMETER. 
*         BITS FOR : P1   : P2  , P3  , P4  , P5  , P6   , P7    , P8 
*                    0,1   2,3   4,5   6,7   8,9  10,11  12,13   14,15
*  WORD 5 = 1ST SUB-PARAMETER AND HAS CHARACTERISTICS OF WORD 1.
*  WORD 6 = 2ND SUB-PARAMETER DELIMETED BY COLONS AS IN WORD 5. 
*  WORD 7 = 3RD SUB-PARAM. AS 5 & 6. (MAY BE 0, NUMBER OR 2 CHARS)
*  WORD 8 = 4TH    "
*  WORD 9 = 5TH    "
*  WORD 10 = 6TH   "
*  WORD 11 = 7TH   "
*  WORD 12 = 8TH   "
      SPC 2 
* 
*      WHERE: 
*        DNAME = TWELVE WORD DESTINATION PARAMETER BUFFER ADDRESS 
*        INBUF = STARTING ADDRESS OF INPUT BUFFER CONTAINNING "NAMR". 
*        PARML = CHARACTER LENGTH OF "INBUF". (MUST BE POSITIVE)
*        ISTRC = THE STARTING CHARACTER NUMBER IN "INBUF".  THIS
*                PARAMETER WILL BE UPDATED FOR POSSIBLE NEXT CALL 
*                TO "PARMP" AS THE START CHARACTER IN "INBUF".
*        CAUTION!!!!
*        ISTRC IS MODIFIED BY THIS ROUTINE, THEREFORE IT MUST 
*        BE PASSED AS A VARIABLE (NOT A CONSTANT) FROM CALLER.
* 
      SKP 
*  CHECK CALLERS PARAMETERS FOR CORRECTNESS 
      SPC 1 
INBUF NOP           INPUT BUFFER ADDRESS
PARML NOP           TRANSMISSION LOG IN CHARACTERS
ISTRC NOP           CURRENT STARTING CHARACTER IN INBUF 
* 
PARMP NOP 
      CCA           SET TO NO COMMAS
      STA FRSTC 
      CLA,INA 
      STA ISTRC     SET FIRST CHAR
      LDB \BUFI 
      STB INBUF     INPUT BUFFER ADDRESS
      LDB DNAME 
      STB BPTR      NOW CLEAR OUT DEST BUFFER 
      LDA N12       GET DEST BUFFER LENGTH
      STA SUBCT     SAVE IN TEMP
      CLA           ZERO BUFFER 
      STA B,I 
      INB 
      ISZ SUBCT 
      JMP *-3 
      STA WORD4,I   INITIALIZE THE TYPE WORD
      STA FILEW     AND THE FILE FLAG 
      LDA INBUF     FORM STARTING CHARACTER 
      CLE,ELA       ADDRESS OF INPUT
      STA INBUF     SAVE AS CHARACTER ADDRESS.
      LDB PARML     GET CHARACTER LENGTH
      ADA B         GET ADDRESS OF LAST+1 CHARACTER 
      STA EOFBF     AND SAVE FOR LATER USE
      LDA ISTRC     GET START CHAR IN "INBUF" 
      CMB,SSB,INB,SZB CHECK FOR 0 & NEG.
      CMA,INA,RSS   >0, MAKE ISTRC NEG. + TEST FOR 0
      CCE           DI\DN'T PASS, SET FLAG
      CMA           SUBTRACT 1 FROM ISTRC 
      ADB A          A-REG = ISTRC - PARML -1 
      CCA,SEZ       TEST E FOR ERROR
      JMP PARMP,I    RETURN A= -1 FOR ERROR 
      LDA BPTR      GET DESTINATION BUFFER
      LDB A 
      ADB P3        SET ADDRESS OF TYPE WORD
      STB BPTR      AND BUFFER POINTER
      LDB P3        GET LENGTH OF BUFFER (WORDS)
      JSB SCAN      GET 1ST PARAMETER 
      STA FILEW     AND SAVE FILE TYPE(IF ANY)
      LDB FRSTC     WAS A COMMA ENCOUNTERED 
      SZB 
      JMP MORE0     NO
      RAR,RAR       YES, SKIP APPROPRIATE 
      RAR,RAR       POSITIONS IN WORD4,I
      STA WORD4,I   FOR P1 AND P2 
      ISZ BPTR      AND UPDATE DESTINATION
      ISZ BPTR      POINTER 
      JMP MORE1 
MORE0 LDB N2        SET TO GET THE NEXT 2 PARAMETERS AFTER: 
      STB SUBCT 
      ISZ BPTR
      LDA BPTR
      CLB,INB 
      JSB SCAN
      IOR WORD4,I   SET BITS FOR SECURITY CODE (FIRST TIME THRU), 
      RAR,RAR       OR LABEL PARAMETER(SECOND TIME THRU)
      STA WORD4,I 
      ISZ SUBCT 
      RSS 
      JMP MORE1 
      LDB FRSTC     GOT A COMMA AFTER ONLY ONE COLON? 
      SZB 
      JMP MORE0+2   NO, A SECOND COLON
      ISZ BPTR      UPDATE DESTINATION POINTER
      RAR,RAR       AND TYPE BITS FOR NULL PARAMETER P2 
      STA WORD4,I 
MORE1 LDB N6       NOW SCAN FOR NEXT 6 SUB-PARAMS 
      STB SUBCT 
MORE2 ISZ BPTR
      LDA BPTR      GET DESTINATION BUFFER ADDRESS
      CLB,INB       AND THE LENGTH
      JSB SCAN      GET NEXT SUB PARAM
      IOR WORD4,I   MERGE IN WITH PREV. 
      RAR,RAR       POSITION "PARAM TYPE BITS"
      STA WORD4,I   AND PUT BACK
      ISZ SUBCT     DONE WITH ALL EIGHT?
      JMP MORE2     NO, CONTINUE
      JMP PARMP,I