ASMB,R,L,C
      HED RTE WCS UTILITY -- WLOAD
      NAM WLOAD,7 13197-16003 REV.1813 771228   
      ENT WLOAD 
      EXT .ENTR,EXEC,OPEN,READF,CLOSE 
      SUP 
* 
*   ********************************************************* 
*   * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975.           * 
*   *                                                       * 
*   * 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.                              * 
*   ********************************************************* 
* 
*    SOURCE: 13197-18006
* 
* 
*************************** 
*                         * 
*  E N T R Y   P O I N T  * 
*                         * 
*************************** 
* 
* ENTRY:
*         JSB WLOAD       -OR-           JSB WLOAD
*         DEF *+5                        DEF *+5 (OR 6 OR 7)
*         DEF LUARR                      DEF LUARR
*         DEF NOLU                       DEF NOLU 
*         DEF BUF                        DEF BUF
*         DEF INLU                       DEF FNAME
*                                        DEF SECUR  (OPTIONAL)
*                                        DEF CRLBL  (OPTIONAL)
*   LUARR OCT LU1,LU2,...,LU(N) 
*   NOLU  DEC N 
*   BUF   BSS 60                   BUF   BSS 204
*   INLU  OCT LU                   FNAME ASC 3,XXXXXXX
*                                  SECUR OCT N
*                                  CRLBL OCT N
* 
* EXIT: 
*   A=ERROR STATUS
*   B=AUGMENTS A-REGISTER 
* 
*   A-REGISTER               B-REGISTER 
*   -----------------     ------------------------------------------- 
*   0 = NO ERROR          CONTAINS INDEX OF LAST LUARR ENTRY
*                         (1-ORIGINED)
* 
*   1 = INPUT ERROR       FMGR ERROR CODE OR DEVICE STATUS
*                         (EQT5)
* 
*   2 = WCS I/O ERROR     LUARR INDEX IN HIGH BYTE (1-ORIGINED),
*                         WCS STATUS IN LOW BYTE
* 
*   3 = WLOAD ERROR       1 = INVALID OR INSUFFICIENT PARAMETERS
*                         2 = NOLU <= 0 (OR INVALID ADDRESS)
*                         3 = INVALID LUARR ENTRY (NOT DVR36) 
*                         4 = INVALID RECORD FORMAT OR CHECKSUM ERROR 
* 
* NOTE: ALTHOUGH WLOAD IS ENTRY POINT, ALL EXITS BUT BE THROUGH THE 
* LABEL START.  THIS IS A PSEUDO-ENTRY POINT SET-UP FOR .ENTR.
* 
* IF INLU=0, WE EXIT IMMEDIATELY WITH A=0 AND B=1.  IF ANY LUARR ENTRY
* IS ZERO, WE SKIP THAT ENTRY AND GET THE NEXT ONE. 
* 
      DEC 77       VERSION NUMBER: YEAR     
      OCT 1434     BITS 9-6=MONTH...BITS 5-0=DAY  
WLOAD NOP 
      LDA WLOAD    GET PTR TO PARAM LIST
      STA START    PUT INTO "ENTRY POINT" 
      LDA =D-6     ZERO PARAMETER BUFFER
      STA CNT 
      LDB @PARM 
      CLA 
LP.1  EQU * 
      STA B,I 
      INB 
      ISZ CNT 
      JMP LP.1
      LDA .1        SET THE FILE FLAG TO
      STA FILE?      OTHER SO NO CLOSE OR EOT HAPPENS 
      JMP START+1  GO TO PSEUDO ENTRY POINT 
* 
* 
*************** 
*             * 
*  E X I T S  * 
*             * 
*************** 
* 
* 
* EXIT THROUGH "START" ENTRY POINT. 
* 
IOERR EQU *        DEVICE I/O ERROR. A=ERROR CODE 
      LDB ERR 
      CLA,INA      SET I/O ERROR FLAG 
      JMP TIO 
* 
OVFLO EQU *        FAKE DATA OVERRUN ERROR
      LDA =D5      SET "OVERRUN" FLAGS
      LDB @NOLU,I  INDEX OF LAST LUARR ENTRY
      JMP WCS.1 
* 
WCSER EQU *        WCS I/O ERROR. A=ERROR CODE
      AND =B377    ISOLATE STATUS FIELD 
      JSB INDEX    B=LUARR INDEX
WCS.1 EQU * 
      BLF,BLF 
      ADB A        ADD ERROR CODE 
      LDA =D2      SET WCS ERROR FLAG 
      JMP TIO 
* 
BADPM EQU *        MISSING PARAMETER
      LDB =D1 
      JMP WERR
* 
BAD#  EQU *        NOLU<=0
      LDB =D2 
      JMP WERR
* 
BADLU EQU *        LUARR LU IS NOT DVR36
      LDB =D3 
      JMP WERR
* 
BADRC EQU *        INVALID RECORD OR CHECKSUM ERROR 
      LDB =D4 
WERR  EQU *        WLOAD ERROR EXIT 
      LDA =D3 
      JMP TIO 
* 
DONE  EQU *        SUCCESSFUL COMPLETION
      JSB INDEX    B=LUARR INDEX (1-ORIGINED) 
      CLA 
* 
TIO   EQU * 
      STA AREG     SAVE REGISTERS 
      STB BREG
      LDA FILE?    I/O FROM FILE? 
      SSA,RSS 
      JMP TIO.1 
      JSB CLOSE    YES: CLOSE FILE
      DEF *+2 
      DEF @DCB,I
      JMP TIO.2 
TIO.1 EQU * 
      SZA,RSS      PAPER TAPE DEVICE? 
      JSB EOT      YES: RESET END OF TAPE STATE 
TIO.2 EQU * 
      LDA AREG     RESTORE REGISTERS & EXIT 
      LDB BREG
      JMP START,I 
* 
* 
***************************************** 
*                                       * 
*  P S E D U O - E N T R Y   P O I N T  * 
*                                       * 
***************************************** 
* 
* 
* ALL EXITS MUST GO THROUGH "START" 
* 
@PARM DEF *+1      PTR TO PARAM BUFFER
@LUAR DEF 0        PTR TO ARRAY OF WCS LU'S 
@NOLU DEF 0        PTR TO ORIGINAL SIZE OF LUARR
@BUF  DEF 0        PTR TO WORKSPACE 
@FNAM DEF 0        FILE NAME
@INLU EQU @FNAM    PTR TO INPUT DEVICE LU 
SECUR DEC 0        FILE SECURITY (OPTIONAL) 
CRLBL DEC 0        DISC CARTRIDGE LABEL (OPTIONAL)
* 
START NOP          "ENTRY POINT"
      JSB .ENTR    PULL UP PARAMETERS 
      DEF @LUAR 
      LDA @LUAR    VERIFY REQUIRED PARAMS WERE PASSED 
      LDB @NOLU 
      CLE,ERA      AND NOT A OR B REGISTERS 
      CLE,ERB 
      SZA 
      SZB,RSS 
      JMP BADPM    ERROR: INVALID PARAM 
      LDA @BUF
      LDB @INLU 
      CLE,ERA 
      CLE,ERB 
      SZA 
      SZB,RSS 
      JMP BADPM    ERROR: INVALID PARAM 
      LDA @BUF     SET UP DCB PTR FOR FILE I/O
      ADA =D60
      STA @DCB
      LDA @NOLU,I  SET UP LU COUNT
      SZA 
      CMA,SSA,RSS  -(NOLU+1)
      JMP BAD#     ERROR: NOLU<=0 
      STA REMLU 
* DISTINGUISH FILE I/O AND DEVICE I/O.  IF DEVICE I/O, UPPER BYTE 
* MUST BE ZERO.  OTHERWISE, WE ASSUME FILE I/O. 
      LDA @FNAM,I  ZERO LU? 
      SZA,RSS 
      JMP DONE     YES: WE'RE DONE
      IOR =B300    SET BINARY-VARIABLE FLAGS FOR DEVICE I/O 
      STA IOCTL 
      AND =B177400 UPPER BYTE=0?
      SZA,RSS 
      JMP W.0      YES: DEVICE I/O
      CLA          SET-UP SECUR & CRLBL IN CASE USER
      CLB          PASSED ZERO (OR ONE) INSTEAD OF PTR
      LDA SECUR,I 
      STA SECUR 
      CLA 
      LDA CRLBL,I 
      STA CRLBL 
      JSB OPEN     OPEN FILE
      DEF *+7 
      DEF @DCB,I
      DEF ERR 
      DEF @FNAM,I 
      DEF .310B    SET BINARY-VARIABLE FLAGS FOR TYPE-0 FILE
      DEF SECUR 
      DEF CRLBL 
      SSA 
      JMP IOERR    FILE ERROR 
      CCA          SET FILE FLAG
      STA FILE? 
      JMP W.1 
* CHECK FOR PAPER TAPE DEVICES (DVR 0-7).  IF SO, WE MUST SET END OF
* TAPE STATE SO WE CAN SKIP LEADER. 
W.0   EQU * 
      LDA IOCTL    DEVICE LU
      JSB DVR#     A = DVR# < 8?
      CLB,INB      SET NON-PTAPE DEV FLAG 
      ADA =B-10 
      SSA           DVR #<8?
      JSB EOT       YES.ALSO SETS B=0 FOR PTAPE DEV 
      STB FILE?     NO
* 
W.1   EQU *        INITIATE XFER
      JSB READ
      CLA 
      STA TLOG
* 
* GET NEXT WCS SUBCHANNEL.  IF NONE LEFT, TERMINATE WITH DATA 
* OVERRUN.  IF LU IS NOT DVR36, TERMINATE WITH ERROR
* 
LP.2  EQU * 
      ISZ REMLU    DECREMENT LU COUNTER 
      JMP *+2 
      JMP OVFLO    ERROR: NO MORE LU'S
      LDA @LUAR,I  GET NEXT WCS LU
      ISZ @LUAR 
      AND =B77     ISOLATE LU 
      SZA,RSS 
      JMP LP.2     IGNORE ZERO LU 
      STA WCSLU 
      IOR =B100    PREPARE EXEC CONTROL WORDS...
      STA WCTL     ...FOR WRITE-VERIFY RQ 
      STA ACTL     ...FOR ASSIGN RQ 
      STA SCTL     ...FOR READ-STATE RQ 
      JSB DVR#     A=DVR NUMBER 
      XOR =B36     WCS DVR? 
      SZA 
      JMP BADLU    NO: BAD WCS LU 
* ADJUST CONTROL PARAMETERS BY ADVANCING ORIGIN AND CODE POINTERS BY
* LAST TRANSMISSION LOG AND SUBTRACTING LOG FROM TRANSFER COUNT.
* CHECK SUBCHANNEL FOR 13197A (1K) BOARD:  DYNAMICALLY ASSIGN BASE
* ADDRESS.  ALSO SET FIRST-WRITE FLAG FOR 12978A (1/4K) BOARD...USED
* TO DISTINGUISH BAD ADDRESS FROM DATA OVERRUN. 
      STA FLAG     "SET" (=0) FIRST-WRITE FLAG
      LDA TLOG     ADJUST WCS ORIGIN
      ARS          CONVERT TLOG TO WCS COUNT
      ADA ORG 
      STA ORG 
      LDA @CODE    ADJUST BUFFER POINTER
      ADA TLOG
      STA @CODE 
      LDA TLOG     ADJUST XFER COUNT
      CMA,INA 
      ADA XFER     XFER=XFER-TLOG 
      STA XFER
      JSB EXEC     GET SCHNL TYPE 
      DEF *+5 
      DEF .1       READ-STATE RQ
      DEF SCTL
      DEF STATE 
      DEF .2       ON RETN, A=EQT5
      LDA STATE 
      AND =B37     ISOLATE SCHNL #
      JSB GOTO     CASE ON SCHNL
      DEF ASSGN 
      DEF ASSGN 
      DEF LP.3
ASSGN EQU *        ASSIGN BASE ADDR (ORG) 
      JSB EXEC
      DEF *+4 
      DEF .3       ASSIGN RQ
      DEF ACTL
      DEF ORG 
      SLA          ADDR CONFLICT? 
      JMP WCSER    YES
* 
* COPY FILE TO SUBCHANNEL.  WE CONTINUE WRITING UNTIL WE GET AN ERROR 
* (OR "READ" DETECTS END-RECORD).  IF ERROR IS BAD ADDRESS OR OVERRUN,
* WE LOOP UP TO GET NEXT SUBCHANNEL.  OTHERWISE, WE TERMINATE ON ERROR. 
* 
* BAD ADDRESS CAN ARISE FOR TWO REASONS.  ON THE FIRST WRITE TO 12978A
* (1/4K) BOARD, THIS ERROR INDICATES THAT BOARD IS NOT PROPERLY 
* CONFIGURED.  (FLAG=0 INDICATES FIRST WRITE.)  SINCE BOARD CANNOT
* BE RECONFIGURED DYNAMICALLY, THIS ERROR IS TERMINAL.  NOTE
* THAT A BAD ADDRESS ON FIRST WRITE CAN HAPPEN ONLY ON NON-CONFIGURABLE 
* BOARDS (VIZ., 12978A AND NOT 13197A).  WHEN ERROR OCCURS ON NON-FIRST 
* WRITE TO EITHER 12978A (1/4K) OR 13197A(1K) BOARDS (FLAG>0), ADDRESS
* IS NOT INCLUDED IN REMAINING ADDRESS SPACE OF BOARD.  THUS, TREAT 
* AS A DATA OVERRUN ERROR AND GET NEXT SUBCHANNEL.
* 
* NOTE THAT WE ASSUME THAT WE DO FEWER THAN 64K WRITES TO WCS (IE., 
* WE CAN ISZ FLAG).  THIS CERTAINLY IS A REASONABLE ASSUMPTION AT THE 
* CURRENT TIME.   WE ALSO RELY ON FACT THAT RECORD ALWAYS CONTAINS
* COMPLETE MICROWORDS (IE., PAIRS OF 16-BIT WORDS). 
* 
LP.3  EQU * 
      JSB EXEC     WRITE TO WCS 
      DEF *+6 
      DEF .2       WRITE RQ...
      DEF WCTL     ...WITH VERIFY OPTION
@CODE DEF 0        PTR TO CODE BUFFER 
      DEF XFER     XFER LENGTH
      DEF ORG      ORIGIN ADDR
      SLA          ANY ERROR? 
      JMP W.3      YES: CHECK FOR BAD ADDR OR OVERRUN 
      ISZ FLAG     "RESET" (<>0) FIRST-WRITE FLAG 
      JSB READ     GET NEXT RECORD... 
      JMP LP.3     ...AND CARRY ON
W.3   EQU *        CHECK ERROR CLASS
      STA ERR      SAVE ERROR CODE... 
      STB TLOG     ...AND TRANSMISSION LOG
      AND =B377    ISOLATE ERROR CODE (INCL VERIFY FLAG)
      LDB FLAG
      CPA =B3      BAD ADDR?
      SZB,RSS      YES: SKIP IF NOT FIRST WRITE 
      CPA =B5      OVERRUN? 
      JMP LP.2     YES OR NON-FIRST-WRITE BAD ADDR
      LDA ERR 
      JMP WCSER 
* 
* 
*************************** 
*                         * 
*  S U B R O U T I N E S  * 
*                         * 
*************************** 
* 
* 
********************
* 
* D V R # 
* 
* ENTRY:
*   LDA <LU>
*   JSB DVR#
* EXIT: 
*   A= DRIVER NUMBER
* 
* WE EXTRACT LOW SIX BITS FROM <LU>.
* 
DVR#  NOP 
      AND =B77
      STA CONWD 
      JSB EXEC
      DEF *+4 
      DEF .13      STATUS RQ
      DEF CONWD 
      DEF STATE    RETNS EQT5 HERE
      LDA STATE    ISOLATE DVR# (BITS 13-8) 
      AND =B37400 
      ALF,ALF 
      JMP DVR#,I
* 
* 
********************
* 
* E O T 
* 
* EXIT: 
*  B= ZERO
* 
* ROUTINE REQUIRES THAT 'IOCTL' CONTAIN DEVICE LU.
* 
EOT   NOP 
      LDA IOCTL    SET UP EOT CONTROL RQ
      AND =B77     EXTRACT LU 
      ADA =B700    EOT SUBFUNC
      STA CONWD 
      JSB EXEC
      DEF *+3 
      DEF .3       CONTROL RQ 
      DEF CONWD 
      CLB          EOT-SET FLAG 
      JMP EOT,I 
* 
* 
********************
* 
* G O T O 
* 
* ENTRY:
*   LDA <INDEX> 
*   JSB GOTO
*   DEF <LABEL1>
*   DEF <LABEL2>
*      :
* 
* <INDEX> IS ZERO-ORIGINED.  THIS ROUTINE PRESERVES THE B-REG.
* 
* 
GOTO  NOP 
      ADA GOTO     INDEXED PTR INTO LABEL TABLE 
      IOR =B100000 SET INDIRECT BIT 
      JMP A,I      BRANCH TO LABEL-I
* 
* 
********************
* 
* I N D E X 
* 
* EXIT: 
*   B= ONE-ORIGINED INDEX INTO LUARR CURRENTLY POINTED TO.
*      (IF BEFORE FIRST ACCESS, ZERO IS CHANGED TO ONE).
* 
* THIS ROUTINE PRESERVES THE A-REGISTER.
* 
* 
INDEX NOP 
      LDB @NOLU,I 
      ADB REMLU 
      SSB,INB      INDEX=0? 
      INB          YES: INCREMENT TO 1
      JMP INDEX,I 
* 
* 
********************
* 
* R E A D 
* 
* 
READ  NOP 
      LDA FILE?    READ FROM FILE?
      SSA 
      JMP FREAD    YES
* 
* READ FROM I/O DEVICE.  TERMINATE ON ANY ERROR 
* 
      JSB EXEC
      DEF *+5 
      DEF .1       READ RQ
      DEF IOCTL    BINARY OPTION
      DEF @BUF,I
      DEF .59 
      STA ERR      SAVE ERROR CODE
      AND =B377    ISOLATE STATUS FIELD 
      SZA,RSS      ERROR? 
      JMP R.2 
      JMP IOERR    YES. 
* 
* READ FROM FILE.  TERMINATE ON ANY ERROR.
* 
FREAD EQU * 
      JSB READF 
      DEF *+5 
@DCB  DEF 0 
      DEF ERR 
      DEF @BUF,I
      DEF .59 
      SSA          ANY ERROR? 
      JMP IOERR    FILE ERROR 
* 
* I/O COMPLETE.  VALIDATE RECORD BY CHECKING RECORD TYPE (DBL OR END) 
* AND CHECKSUM.  TERMINATE ON ERROR IF NOT DBL OR END RECORD.  SET UP 
* SET UP ORG AND XFER FROM RECORD.  SET UP @CODE TO POINT TO FIRST
* MICROWORD IN BUFFER.
* 
R.2   EQU * 
      LDA @BUF     SET UP MOVING POINTER
      STA @CODE 
      LDA A,I      GET RECORD LENGTH (HIGH BYTE)
      ALF,ALF 
      ADA =D-5     COMPUTE XFER LENGTH... 
      STA XFER     ...SANS HEADER 
      CMA,INA 
      STA CNT      CHECKSUM COUNT 
      ISZ @CODE 
      LDB @CODE,I  GET RECORD TYPE
* PRESERVE B-REG: INITIAL CHECKSUM TOTAL
      ISZ @CODE 
      LDA @CODE,I  GET CHECKSUM 
      STA CHK 
      ISZ @CODE 
      CPB =B120000 END RECORD?
      JMP END?     YES: CHECK CHECKSUM
      CPB =B60100  DBL RECORD?
      JMP *+2 
      JMP BADRC    IMPROPER RECORD
      LDA @CODE,I  GET ORIGIN VALUE 
      STA ORG 
      ADA B        INCLUDE IN CHECKSUM
      ISZ @CODE 
      ADA @CODE,I  ADD MICRO/MDE FLAG 
      ISZ @CODE    PTR TO 1ST MICROWORD (FOR WRITE TO WCS)
      LDB @CODE 
* PERFORM CHECKSUM.  A=CHECKSUM, B=POINTER INTO RECORD.  WE ASSUME
* RECORD LENGTH >= 7.  THAT IS, MICRO NEVER EMITS NULL RECORD 
* (CONTRARY TO MANUAL!).
R.3   EQU * 
      ADA B,I 
      INB 
      ISZ CNT 
      JMP R.3 
      CPA CHK      CHECKSUM OKAY? 
      JMP READ,I
      JMP BADRC    NO: CHECKSUM ERROR 
* 
END?  CPA CHK      CHECKSUM OKAY
      JMP DONE     YES: WE'RE DONE
      JMP BADRC    CHECKSUM ERROR 
* 
* 
* 
********************
* 
* L O C A L S 
* 
* 
A     EQU 0 
B     EQU 1 
ACTL  BSS 1        ASSIGN RQ CONTROL WORD 
AREG  BSS 1        SAFE FOR A-REGISTER (TEMP) 
BREG  BSS 1        SAFE FOR B-REGISTER (TEMP) 
CHK   BSS 1        CHECKSUM 
CNT   BSS 1        TEMPORARY COUNTER
CONWD BSS 1        TEMPORARY EXEC CONTROL WORD
ERR   BSS 1        I/O ERROR CODE 
FILE? BSS 1        I/O FLAG: -1=FILE, 0=PTAPE DEV, 1=OTHER
FLAG  BSS 1        FIRST-WRITE FLAG (0 ==> FIRST WRITE) 
IOCTL BSS 1        CONTROL WORD FOR DEVICE I/O
ORG   BSS 1        WCS ORIGIN 
REMLU BSS 1        NUMBER OF REMAINING LU'S IN LUARR
SCTL  BSS 1        WCS READ-STATE CONTROL WORD
STATE BSS 2        WCS STATE BUFFER 
TLOG  BSS 1        TRANSMISSION LOG 
WCSLU BSS 1        WCS LOGICAL UNIT 
WCTL  BSS 1        WCS WRITE CONTROL WORD 
XFER  BSS 1        TRANSFER LENGTH
.1    DEC 1 
.2    DEC 2 
.3    DEC 3 
.13   DEC 13
.59   DEC 59
.310B OCT 310 
      UNS 
      END 
                                                                                                                            