ASMB,Q,C,N
      HED <RMOTE> OPERATOR ACCESS TO 3000 * (C) HEWLETT-PACKARD CO. 
     IFN           *****
      NAM RMOTE,19,80 91750-16167 REV.2013 800324 MEF 
     XIF           *****
     IFZ           *****
      NAM RMOTE,19,80 91750-16168 REV.2013 800324 MEF 
     XIF           *****
      SPC 1 
******************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS      *
*  * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,       *
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
*  * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY.   *
******************************************************************
      SPC 2 
      UNL           NEXT 5 LINES ARE FOR PRODUCTION ENGINEERING 
*  NAME:
*SOURCE: 91750-18167
* RELOC: 91750-16167 (N OPTION)   91750-16168 (Z OPTION)
*  PGMR: DMT
      LST 
**************************   RMOTE   *************************
*                                                            *
* SOURCE: 91750-18167                                        *
*                                                            *
* BINARY: 91750-16167     N OPTION                           *
*         91750-16168     Z OPTION (INCLUDES FILE MOVE)      *
*                                                            *
* PROGRAMMER: JIM HARTSELL                                   *
*                                                            *
* DATE: OCTOBER 21, 1975                                     *
*                                                            *
*                                                            *
****       MODIFIED BY DMT BEGINNING AUGUST 1, 1978       ****
*              FOR DS/1000 ENHANCEMENTS PROJECT              *
*                                                            *
**************************************************************
      SPC 1 
* 
* DS/1000 PROGRAM TO PROVIDE OPERATOR ACCESS
* TO A REMOTE HP3000 COMPUTER.
* 
      EXT NAMR,IFTTY,IFBRK,.ENTR,.MVW 
      EXT EXEC,KCVT,MESSS,REIO,LURQ 
      EXT OPEN,READF,POSNT,CLOSE
      EXT #PKUP,#LU3K,HELLO,BYE 
      EXT D3KMS,D$RQB,D$3BF,D$ERR,D$INP,D$LOG,D$SMP 
     IFZ           *****
      EXT POPEN,PCONT,PREAD,PWRIT,PCLOS 
      EXT WRITF,LOCF,CREAT
      EXT COR.A,SPOPN,LUTRU,CNUMD,$SPCR 
      EXT D$BRK,D$CTY 
XEQT  EQU 1717B     ID SEGMENT ADDRESS
BGLWA EQU 1777B     LAST WORD IN PARTITION
     XIF           *****
* 
A     EQU 0         A-REGISTER
B     EQU 1         B-REGISTER
      SUP 
      SKP 
* 
RMOTE JSB #PKUP     PICK UP PARAMETERS. 
      DEF *+4 
      DEF PMASK 
      DEF NAME
      DEF DEFLU 
* 
      CLA 
      STA D$SMP     FOR RTE-M, CLEAR SMP NUMBER.
     IFZ           *****
      STA SLFLG     SLAVE-OPEN FLAG := 0. 
      STA SPFLG     SPOOL FLAG := 0.
* 
*  SET UP P-TO-P BUFFER.
      LDA XEQT      FIND FIRST WORD 
      JSB COR.A      OF AVAILABLE MEM.
      STA BUFER     BUFFER STARTS THERE.
      CMA,INA 
      LDB BGLWA     FIND LAST WORD. 
      ADA B         CALCULATE LENGTH. 
      AND ML256     MAKE IT MULTIPLE OF 256.
      STA MAXBF 
      LDB D4096     INSURE MAX
      CMA,INA        BUFFER IS
      ADA D4096       <= 4096.
      SSA 
      STB MAXBF 
* 
      LDA #LU3K     SET NODE NUMBER 
      CMA,INA        TO NEGATIVE
      STA NOD3K       HP 3000 LU. 
     XIF           *****
* 
      LDA LPRMP     INITIALIZE FOR
      STA PROMP      LOCAL PROMPT CHAR. 
* 
      LDA MD6       SET ZERO-LENGTH RECORD
      STA ZLCNT      COUNTER TO -6. 
      SPC 1 
* 
*  PROCESS FIRST PARAMETER--INPUT LU OR NAMR
* 
      LDA NAME      CHECK IF P1=ASCII PARAM 
      AND HB377      (A=0 IF NUMERIC).
      SZA 
      JMP STYPE 
* 
      LDA NAME      IF FIRST PARAMETER
      AND B77        (MINUS CONTROL BITS) 
      SZA,RSS         IS ZERO,
      LDA DEFLU         USE DEFAULT LU
      STA NAME
      JSB EQTYP     CHECK TYPE OF INPUT LU. 
* 
STYPE STA LUTYP     SAVE EQUIPMENT TYPE.
      SPC 1 
* 
*  PROCESS SECOND PARAMETER--LOG DEVICE 
* 
      LDB P1        ASSUME PARAMETER WAS SUPPLIED.
      LDA P1        IF IT IS
      AND HB377      ALPHABETIC 
      SZA,RSS 
      SZB,RSS         OR ZERO,
      LDB DEFLU         USE DEFAULT LU. 
      LDA B         CLEAR CONTROL 
      AND B77        BITS FOR D$LOG.
      STA D$LOG     ADD "PRINT
      IOR B600       COLUMN-1" BIT
      STA LULOG       FOR LULOG.
      JSB LOKLU     LOCK LIST LU. 
      SPC 1 
* 
*  PROCESS THIRD PARAMETER--SEVERITY CODE 
*       
      LDA SEVER     MAKE SURE 
      CPA D2         SEVERITY 
      JMP DOELU       IS 2, 
      CPA D1           1, OR
      JMP DOELU         ZERO. 
      CLA 
      STA SEVER 
      SPC 1 
* 
*  FIGURE OUT ERROR LU. 
* 
DOELU LDA NAME       IF INPUT 
      LDB LUTYP       IS
      SZB,RSS         INTERACTIVE,
      JMP IOR           USE IT. 
      LDA LULOG     IF LOG
      JSB EQTYP      LU IS
      SZA             INTERACTIVE,
      JMP LDDEF 
      LDA LULOG         USE IT. 
      JMP IOR 
LDDEF LDA DEFLU     OTHERWISE USE DEFAULT.
IOR   IOR B600      SET "ECHO INPUT" BIT. 
      STA ERRLU     SAVE ERROR LU.
      SPC 1 
      LDA STKHD     INITIALIZE TRANSFER STACK TO
      JMP M1221      CONTAIN INPUT LU/NAMR. 
      SPC 1 
B77   OCT 77
B600  OCT 600 
PMASK BYT 3,3       #PKUP HAS 3 PARAMS, FIRST 2 NAMR. 
     IFZ           *****
ML256 OCT 177600
D4096 DEC 4096
     XIF           *****
      SKP 
* 
* DISPLAY PROMPT CHARACTER (IF INTERACTIVE DEVICE). 
* CONTROL RETURNS HERE WHEN REQUEST PROCESSING COMPLETES. 
* 
QUERY LDA P.STK,I   READ FROM 
      JSB READ       CURRENT INPUT. 
      DEF POPTS     (ERROR RETURN)
      DEF TRANS     (EOF RETURN)
* 
      LDA P.STK 
      ADA D3
      ISZ A,I       BUMP RECORD COUNT.
* 
* ECHO THE REQUEST IF NOT INPUT FROM INTERACTIVE DEVICE.
* 
ECHO  LDA LUTYP 
      SZA,RSS 
      JMP CKCNT     IT IS AN INTERACTIVE DEVICE.
* 
      CLA           IF SEVERITY = 0,
      JSB ECHPR      ECHO.
* 
      JSB IFBRK     IF BREAK
      DEF *+1        FLAG IS
      SZA             SET,
      JMP POPTS          POP TO TOP OF STACK. 
* 
      LDA INBUF     FIRST CHARACTER MUST
      XOR PROMP      BE CURRENT 
      AND HB377       PROMPT CHARACTER. 
      SZA 
      JMP INVAL 
* 
      LDA INBUF     BLANK 
      AND B377       OUT THE
      IOR BLANK       PROMPT
      STA INBUF        CHARACTER. 
* 
CKCNT LDB IOLEN     NULL INPUT? 
      SZB 
      JMP PRSCM       NO--GO PARSE COMMAND. 
      ISZ ZLCNT     BUMP ZERO-LENGTH INPUT COUNTER. 
      JMP QUERY     IGNORE UNTIL 6TH... 
      JMP M0501       THEN TERMINATE. 
* 
ZLCNT NOP           ZERO-LENTGH INPUT COUNTER 
* 
* PARSE THE OPERATOR REQUEST. 
* 
PRSCM LDA MD6       SET ZERO-LENGTH 
      STA ZLCNT      COUNTER TO -6. 
      CLA,INA       SET CHARACTER 
      STA PNTR       POINTER TO 1.
      JSB PNAMR     PARSE COMMAND 
      DEF P1         TO P1 ARRAY. 
* 
      JMP M0000     TRY FOR <RMOTE> COMMAND FIRST.
      SPC 2 
TRANS DLD A.TR      AT EOF, GENERATE
      DST INBUF      TRANSFER.
      LDB D4
      STB IOLEN 
      LDB LUTYP     IF NON-INTERACTIVE, 
      SZB 
      JMP ECHO        GO ECHO.
* 
      AND B377      CHANGE FIRST
      IOR BLANK      CHARACTER TO BLANK.
      STA INBUF 
      JMP PRSCM     PARSE COMMAND.
      SKP 
* LOCAL RTE OR REMOTE HP3000 COMMAND. 
* 
OTHER LDA PROMP     IF SWITCHED LOCAL, SEND 
      CPA LPRMP      COMMAND TO RTE.
      JMP LCRTE 
* 
* SEND REMOTE HP3000 COMMANDS.
      LDA D$SMP     HAS "HELLO" BEEN ENTERED? 
      SZA,RSS 
      JMP NHLLO     NO. REPORT ERROR. 
     IFZ           *****
      JSB CLSLV     MAKE SURE SLAVE IS CLOSED.
     XIF           *****
      JSB BLKIL     KILL LEADING BLANKS IN COMMAND. 
      JSB CMNDS     SEND COMMAND TO HP3000. 
      DEF *+3 
DINBF DEF INBUF 
      DEF IOLEN 
* 
      JMP QUERY 
* 
*  PASS COMMAND TO LOCAL RTE. 
LCRTE JSB MESSS     PROCESS COMMAND.
      DEF *+4        (RU & ON COME THRU HERE IF 
      DEF INBUF       "NOW" WAS SPECIFIED IN COMMAND.)
      DEF IOLEN 
      DEF D$LOG     PASS LOG LU.
* 
      SZA,RSS       IF REPLY CHAR COUNT NON-ZERO: 
      JMP QUERY 
* 
      STA TEMP      NEGATE CHARACTER COUNT. 
* 
      LDA D$LOG     SET "ECHO INPUT" &
      IOR B600       "PRINT COL 1" BITS.
      STA CNWRD 
      JSB REIO      DISPLAY REPLY MESSAGE.
      DEF *+5 
      DEF SD2 
      DEF CNWRD 
      DEF INBUF 
      DEF TEMP
OTERR JSB EROUT     ERROR RETURN. 
      JMP QUERY 
      SKP 
* CHECK THE OPERATOR REQUEST CODE AGAINST THE LEGAL 
* REQUEST CODES AND JUMP TO THE PROPER PROCESSOR. 
* 
*    TO ADD NEW REQUEST ONE MERELY: 
*      A. ADDS ASCII OPERATION CODE TO TABLE "LDOPC". 
*      B. ADDS PROCESSOR START ADDRESS TO TABLE "LDJMP".
*      C. ADDS PROCESSOR CODING TO PROCESS THE REQUEST. 
* 
M0000 LDA P1        FETCH OPERATION CODE. 
      XOR STAR      IF "*" IN 
      AND HB377      COLUMN 1,
      SZA,RSS         JUST A
      JMP QUERY        COMMENT. 
      LDA P1        FETCH OPERATION CODE. 
      AND UMASK     UPSHIFT.
      STA OPP       SET STOP FLAG.
      LDB LDOPC     SET OPERATION TABLE POINTER.
      STB TEMP1 
      LDB LDJMP     SET PROCESSOR JUMP ADDRESS. 
      STB TEMP2 
* 
M0030 CPA TEMP1,I   COMPARE WITH TABLE VALUE. 
      JMP TEMP2,I   COMPARES. GO DO IT. 
* 
      ISZ TEMP1     KEEP LOOKING. 
      ISZ TEMP2 
      JMP M0030 
* 
LDOPC DEF *+1       OPERATION CODE TABLE ADDRESS. 
      ASC 10,SWHEBYTREXRUONRWLLSV 
     IFZ           *****
      ASC  1,MO 
     XIF           *****
OPP   NOP                OP CODE FOR CURRENT REQ. 
"RW"  EQU LDOPC+8 
"LL"  EQU LDOPC+9 
* 
LDJMP DEF *+1,I     JMP ADDRESS FOR EACH OP CODE. 
      DEF M0100     SWITCH. 
      DEF M0200     HELLO.
      DEF M0300     BYE.
      DEF M0400     TRANSFER. 
      DEF M0500     EXIT. 
      DEF M0600     "RU" COMMAND TRAP.
      DEF M0600     "ON" COMMAND TRAP.
      DEF M0600     RW COMMAND
      DEF M0700     LL COMMAND. 
      DEF M0800     SEVERITY CODE.
     IFZ           *****
      DEF M0900     MOVE FILE.
     XIF           *****
      DEF OTHER     ASSUME RTE OR HP3000 COMMAND. 
* 
NHLLO JSB ECHP2     ECHO IF SEVERITY=2. 
      JSB PRINT     DISPLAY "NEED HELLO"
      DEF NHMSG 
D6    DEC 6 
      JMP POPTS 
* 
NHMSG ASC 6,NEED "HELLO"
* 
UMASK OCT 157737    UPSHIFT MASK. 
STAR  BYT 52,0
CNWRD NOP 
BLNKS ASC 1,
      SPC 3 
*  SUBROUTINE TO CHECK FOR POSSIBLE NON-RMOTE COMMAND (EG: UDC FILE)
*   CALLING SEQUENCE: JSB CKUDC 
*     RETURNS TO P+1 IF RMOTE COMMAND 
*     GOES TO <OTHER> IF NOT
* 
CKUDC NOP           ENTRY.
      LDA P1+1      GET CHARS 3 & 4.
      CPA BLNKS     IF BLANKS,
      JMP CKUDC,I    IT'S AN RMOTE COMMAND. 
      JMP OTHER     OTHERWISE PASS TO OP SYSTEM.
      SKP 
* 
* SW[,N]
* 
* CHANGE OR TOGGLE DESTINATION OF OPERATOR COMMANDS.
* 
M0100 JSB CKUDC     CHECK FOR NON-RMOTE COMMAND.
      JSB PNAMR     PARSE NODE NUMBER 
      DEF P1         INTO P1 ARRAY. 
      LDA STAT1     CHECK IF FIRST PARAM SPECIFIED. 
      AND D3
      SZA 
      JMP M0105     PARAM SPECIFIED.
* 
      LDB PROMP     NO PARAM. TREAT AS A TOGGLE.
      CPB RPRMP     IS CURRENT PROMPT = REMOTE PROMPT?
      JMP M0110     YES. SWITCH TO LOCAL PROMPT.
      LDA #LU3K     NO. GET LU OF 3000. 
      SZA 
      JMP M0110     GO CHANGE CURRENT PROMPT. 
      JMP NLSTN     TELL USER HE NEEDS TO RUN "DINIT".
* 
M0105 LDA P1        PARAM GIVEN.
      AND UMASK     UPSHIFT.
      CPA "LO"      "LO" MEANS LOCAL. 
      JMP M0109 
      LDA P1
      SZA,RSS       0=LOCAL RTE, N=HP3000 LU. 
      JMP M0110 
      LDB #LU3K     IF NON-ZERO, MUST BE IN #LU3K.
      SZB,RSS 
      JMP NLSTN     TELL USER HE NEEDS TO RUN "DINIT".
      CPB A         CHECK FOR VALID REMOTE LU.
      JMP M0110     VALID.
      JSB ECHP2     ECHO IF SEVERITY=2. 
      JSB PRINT     DISPLAY "INVALID REMOTE LU".
      DEF ILLU
      DEC 9 
      JMP POPTS 
* 
M0109 CLA 
M0110 LDB LPRMP      CHANGE THE PROMPT CHARACTER: 
      SZA            LOCAL IF NEW LU = 0, 
      LDB RPRMP      REMOTE IF NEW LU NON-ZERO. 
      STB PROMP 
* 
      LDA A.TR      CHANGE CANNED 
      XOR PROMP      TR COMMAND 
      AND B377        PROMPT. 
      XOR PROMP 
      STA A.TR
      JMP QUERY 
* 
NLSTN JSB ECHP2     ECHO IF SEVERITY=2. 
      JSB PRINT     DISPLAY "NEED TO RUN DINIT".
      DEF NLSN
      DEC 10
      JMP POPTS 
NLSN  ASC 10,NEED TO RUN "DINIT"
ILLU  ASC 9,INVALID REMOTE LU 
"LO"  ASC 1,LO
      SKP 
* 
* PROCESSOR FOR "HELLO" COMMAND.
* 
M0200 LDA P1+1      MAKE SURE 
      AND UMASK      SECOND TWO 
      CPA "LL"        CHARACTERS
      RSS              ARE "LL".
      JMP OTHER     NO--MUST BE ANOTHER COMMAND.
      LDA PROMP     IF LOCAL PROMPT,
      CPA LPRMP 
      JMP NDREM      COMMAND IS AN ERROR. 
      JSB BLKIL     KILL LEADING BLANKS.
     IFZ           *****
      JSB CLSLV     MAKE SURE SLAVE IS CLOSED.
     XIF           *****
* 
      LDA P.STK,I   IF CURRENT INPUT IS A LOGICAL UNIT, 
      STA B         USE IT. IF NOT, USE DEFAULT LU. 
      AND HB377 
      SZA 
      LDB DEFLU 
      LDA B         REMOVE ANY
      AND B77        CONTROL BITS.
      STA D$INP 
* 
      JSB HELLO     SEND "HELLO" TO HP3000. 
      DEF *+7 
      DEF ERROR 
      DEF #LU3K     LU OF HP3000. 
      DEF D$LOG     LU OF LOG DEVICE. 
      DEF SMPNM     RETURNED PROCESS NUMBER.
@INBF DEF INBUF     ADDR OF HELLO MESSAGE.
@REC  DEF IOLEN     POS. # BYTES. 
* 
      LDA ERROR     CHECK FOR ERRORS. 
      SZA,RSS 
      JMP QUERY     OK. 
      CPA D1        ERROR CODE = 1? 
      RSS 
      JMP RFAIL     NO. 
* 
      JSB ECHP2     ECHO IF SEVERITY=2. 
      JSB PRINT     DISPLAY MESSAGE.
      DEF HFAIL 
D13   DEC 13
* 
      JMP POPTS 
* 
HFAIL ASC 13,HELLO FAILED OR LINE DOWN
      SKP 
* 
* PROCESSOR FOR "BYE" COMMAND.
* 
M0300 LDA P1+1      IF CHARACTERS 
      AND UMSK2      3 AND 4 AREN'T 
      CPA "E"         "E ", IT'S
      RSS              NOT A BYE COMMAND. 
      JMP OTHER 
      LDA PROMP     IF LOCAL PROMPT,
      CPA LPRMP 
      JMP NDREM      COMMAND IS AN ERROR. 
      LDA D$SMP      IF NO HELLO ISSUED,
      SZA,RSS 
      JMP NHLLO       COMMAND IS AN ERROR.
* 
      JSB LOGOF     SEND "BYE" TO HP3000. 
      SZA 
      JMP RFAIL     FAILED. 
* 
      JMP QUERY 
* 
"E"   ASC 1,E 
UMSK2 OCT 157777
      SPC 3 
*  SUBROUTINE TO LOG OFF FROM 3000. USED FOR "BYE" AND "EXIT" 
*     CALLING SEQUENCE: JSB LOGOF 
*                       <RETURNS WITH ERROR IN A-REG> 
* 
LOGOF NOP           ENTRY.
     IFZ           *****
      JSB CLSLV     CLOSE SLAVE (IF OPEN).
     XIF           *****
* 
      JSB BYE       SEND "BYE"
      DEF *+5 
      DEF ERROR 
      DEF #LU3K 
      DEF D$LOG 
      DEF SMPNM 
* 
      LDA ERROR     LOAD ERROR CODE.
      JMP LOGOF,I   RETURN. 
      SKP 
RFAIL CPA D5
      JMP TMOUT 
      CPA "IO"
      JMP OTERR 
      CPB "05"
      JMP TMOUT 
      CPA D1
      JMP DSCNT 
      CPB "01"
      JMP DSCNT 
* 
      JSB PRINT     DISPLAY "REQUEST FAILED". 
      DEF RQFL
      DEC 7 
* 
      JMP POPTS 
* 
      JSB ECHP2     ECHO IF SEVERITY=2. 
DSCNT JSB PRINT     DISPLAY "LINK IS DISCONNECTED". 
      DEF DISCN 
      DEC 10
      JMP POPTS 
* 
RQFL  ASC 7,REQUEST FAILED
* 
TMOUT JSB ECHP2     ECHO IF SEVERITY=2. 
      JSB PRINT     "TIMEOUT" 
      DEF TOMSG 
      DEC 15
* 
      JMP POPTS 
* 
TOMSG ASC 15,TIMEOUT: NO REPLY FROM REMOTE
* 
NDREM JSB ECHP2     ECHO IF SEVERITY=2. 
      JSB PRINT     NOT LOCAL COMMAND.
      DEF NTLOC 
      DEC 9 
* 
      JMP POPTS 
* 
NTLOC ASC 9,NOT LOCAL COMMAND 
DISCN ASC 10,LINK IS DISCONNECTED 
"IO"  ASC 1,IO
"01"  ASC 1,01
"05"  ASC 5,05
      SKP 
*  TR PROCESSOR.
* 
*  TRANSFER CONTROL TO LU OR DISK FILE. 
* 
M0400 JSB CKUDC     CHECK FOR NON-RMOTE COMMAND.
      JSB CLSFL     CLOSE DISC FILE, IF OPEN. 
* 
      JSB PNAMR     PARSE NAMR. 
      DEF NAME
      LDA STATS     ISOLATE STATUS
      AND D3         BITS.
      SZA,RSS       IF NOT SPECIFIED, 
      CCA,RSS       SIMULATE "TR,-1". 
      LDA NAME
      SZA,RSS       IS PARAMETER ZERO?
      JMP INVAL       YES...INVALID!
      SSA,RSS       NEGATIVE INTEGER? 
      JMP M1220     NO. 
* 
* BACK UP THROUGH TRANSFER STACK. 
* 
      LDB P.STK     TOP OF STACK? 
BKUP  CPB STKHD 
      JMP M0501     YES. SIMULATE "EX" REQUEST. 
      ADB MD6       NO. BACK UP 1 ENTRY.
      INA,SZA 
      JMP BKUP      LOOP TILL DONE. 
      STB P.STK     SET NEW STACK ADDRESS.
      JMP M1250     GO CHECK FOR FILE.
* 
* ADD NEW CONTROL TO THE TRANSFER STACK.
* 
M1220 LDA P.STK     BUMP TO NEXT ENTRY. 
      ADA D6
M1221 STA P.STK     CHECK FOR 
      CPA STKEN      END OF STACK.
      RSS 
      JMP M1230 
      JSB ECHP2     ECHO IF SEVERITY=2. 
      JSB PRINT     STACK OVERFLOW. 
      DEF STKOV 
      DEC 9 
* 
      JMP POPTS     POP TO TOP OF STACK.
* 
M1230 LDB NAME      STORE LU OR FILE NAME.
      STB A,I 
      INA 
      LDB NAME+1
      STB A,I 
      INA 
      LDB NAME+2
      STB A,I 
      INA 
      CLB,INB       SET RECORD NUMBER TO 1. 
      STB A,I 
      INA 
      LDB SECU      STORE SECURITY. 
      STB A,I 
      INA 
      LDB CRN       STORE CART NO.
      STB A,I 
* 
* IF DISK FILE, OPEN AND OPTIONALLY POSITION. 
* 
M1250 LDA P.STK,I 
      AND HB377 
      SZA,RSS 
      JMP QUERY     LU. GO GET NEXT REQUEST.
* 
      STA LUTYP     SET INPUT TYPE NON-INTERACTIVE. 
      LDA P.STK     PICK UP 
      ADA D4         SECURITY 
      LDB A,I         AND 
      STB SECU         CARTRIDGE
      INA               NUMBER. 
      LDB A,I 
      STB CRN 
* 
      JSB OPEN      OPEN THE FILE.
      DEF *+7 
      DEF DCB 
      DEF ERROR 
      DEF P.STK,I 
      DEF D0
      DEF SECU
      DEF CRN 
* 
      JSB CKRTE     CHECK FILE ERROR. 
      JMP POPTS      (ERROR RETURN) 
* 
      LDA P.STK     POSITIONING REQUIRED? 
      ADA D3
      LDB A,I 
      CPB D1        (REC. CNT MORE THAN 1?) 
      JMP QUERY     NO. 
      STB TEMP      YES.
* 
      JSB POSNT     POSITION TO NEXT RECORD.
      DEF *+5 
      DEF DCB 
      DEF ERROR 
      DEF TEMP      NUR GREATER THAN ZERO.
      DEF TEMP      ABSOLUTE RECORD NUMBER. 
* 
      JSB CKRTE      CHECK FOR ERRORS.
      JMP POPTS       (ERROR FOUND) 
      JMP QUERY 
* 
      SPC 5 
* 
* TRANSFER STACK: 
*   FOR EACH ENTRY, WORD 1 = INTEGER LU OR
*                            FIRST 2 FNAME CHAR.
*                   WORD 2,3 = REST OF FNAME. 
*                   WORD 4 = NEXT RECORD NUMBER.
*                   WORD 5 = SECURITY CODE
*                   WORD 6 = CARTRIDGE NUMBER 
* 
P.STK NOP           STACK POINTER.
STKHD DEF *+1 
* 
      BSS 48        8 ENTRIES.
* 
STKEN DEF *         STACK LWA+1.
* 
STKOV ASC 9,TR STACK OVERFLOW 
      SKP 
* 
*  EX PROCESSOR 
* 
*  TERMINATE THE OPERATOR INTERFACE PROGRAM.
* 
M0500 JSB CKUDC     CHECK FOR NON-RMOTE COMMAND.
M0501 LDA D$SMP     CHECK IF A "HELLO" IS OUTSTANDING.
      SZA,RSS 
      JMP M0510       NO. 
* 
      JSB LOGOF     YES. ISSUE AN AUTO BYE. 
      SZA,RSS       CHECK FOR ERRORS. 
      JMP M0510     NONE. 
      JSB PRINT     ERROR FROM "BYE". 
      DEF BYMSG 
D9    DEC 9 
* 
M0510 JSB PRINT     DISPLAY TERMINATION MESSAGE 
      DEF TRMSG     ON LOG DEVICE.
      DEC 5 
* 
      JSB CLSFL     CLOSE OPEN FILES. 
* 
      JSB EXEC      EXIT. 
      DEF *+2 
      DEF D6
* 
BYMSG ASC 9, AUTO "BYE" FAILED
TRMSG ASC 5,END RMOTE 
      SKP 
* 
* PROCESSOR FOR "RU" COMMAND TRAP.  IF ENTERED UNDER THE LOCAL
* PROMPT, AND 5TH PARAM IS NOT SPECIFIED, PASS SESSION NUMBER 
* AS 5TH SCHEDULE PARAMETER.
* 
M0600 LDA RPRMP     IF REMOTE PROMPT, 
      CPA PROMP 
      JMP OTHER      LET IT GO BY.
      JSB PNAMR     PARSE PROGRAM 
      DEF NAME       NAME.
      JSB PNM1      PARSE FIRST PARAMETER.
      LDA OPP       IF "RW" COMMAND,
      CPA "RW"        SKIP THE
      JMP CKST         "NOW" CHECK. 
      CPB "NO"      IF "NOW", 
      JMP OTHER      LET IT GO. 
CKST  LDA STAT1     IF NOT PROVIDED,
      AND D3
      SZA,RSS 
      LDB DEFLU        USE DEFAULT LU.
      STB TEMP1 
      JSB PNM1      PARSE SECOND PARAMETER. 
      STB TEMP2 
      JSB PNM1      PARSE THIRD PARAMETER.
      STB TEMP3 
      JSB PNM1      PARSE FOURTH PARAMETER. 
      STB TEMP4 
      JSB PNAMR     PARSE FIFTH PARAMETER.
      DEF P1
      LDB D$SMP 
      CMB,INB 
      LDA STAT1     IF NOT PROVIDED,
      AND D3
      SZA,RSS 
      STB P1          USE NEGATIVE SMP NUMBER.
* 
      LDA IOLEN     MAKE # OF 
      CMA,INA        BYTES
      STA IOLEN       NEGATIVE. 
* 
      LDA SD9       CHECK WHETHER 
      LDB OPP        ICODE SHOULD BE
      CPB "RW"        QUEUE WITH WAIT 
      LDA SD23         ("RW" COMMAND) OR
      STA TEMP          SCHEDULE WITH WAIT. 
* 
      JSB EXEC      SCHEDULE THE PROGRAM WITH WAIT. 
      DEF *+10
      DEF TEMP      ICODE: 9 (SCHEDULE) OR 23 (QUEUE) 
      DEF NAME      PROGRAM NAME. 
      DEF TEMP1     SCHEDULE PARAMETERS.
      DEF TEMP2 
      DEF TEMP3 
      DEF TEMP4 
      DEF P1
      DEF INBUF 
      DEF IOLEN 
      JMP SCERR     ERROR RETURN. 
* 
      SZA,RSS       NORMAL RETURN.
      JMP QUERY 
      LDA PGBZY     PROGRAM WAS BUSY. 
      JMP SCMSG 
* 
SCERR CPA "SC"
      RSS 
      JMP SCM1      NOT A SCHEDULING ERROR. 
      LDA DSC03 
      CPB "03"
      JMP SCMSG     "ILLEGAL STATUS"
      LDA DSC05 
      CPB "05"
      JMP SCMSG     "NO SUCH PROG"
      LDA DSC10 
      CPB "10"
      JMP SCMSG     "NOT ENOUGH SAM"
SCM1  LDA @RQFL     "REQUEST FAILED"
SCMSG STA SCM2
      JSB ECHP2     ECHO IF SEVERITY=2. 
      JSB PRINT 
SCM2  NOP 
      DEC 7 
      JMP POPTS 
* 
DSC03 DEF *+1 
      ASC 7,ILLEGAL STATUS
* 
DSC05 DEF *+1 
      ASC 7,NO SUCH PROGRM
* 
PGBZY DEF *+1 
      ASC 7,PROGRAM BUSY
* 
DSC10 DEF *+1 
      ASC 7,NOT ENOUGH SAM
* 
@RQFL DEF RQFL
SD9   DEF 9,I 
SD23  DEF 23,I
"SC"  ASC 1,SC
"03"  ASC 1,03
"10"  ASC 1,10
"NO"  ASC 1,NO
      SKP 
* 
*  PROCESSOR FOR LL COMMAND.  CHANGE $STDLIST DESTINATION (D$LOG).
* 
M0700 JSB CHKP1     MAKE SURE P1 IS NUMERIC.
      LDA P1        LOAD LU.
      AND B77       REMOVE CONTROL BITS.
      STA D$LOG     CHANGE $STDLIST DESTINATION.
      JSB LOKLU     LOCK $STDLIST LU. 
      LDA D$LOG     ADD "PRINT  
      IOR B600       COLUMN 1" BIT
      STA LULOG       AND STORE LULOG.
      JMP QUERY 
      SPC 3 
* 
*  PROCESSOR TO CHANGE SEVERITY CODE. 
* 
M0800 JSB CHKP1     MAKE SURE P1 IS NUMERIC.
      LDA P1        MAKE SURE 
      ADA MD3        IT'S BETWEEN 
      SSA,RSS         0 AND 2.
      JMP INVAL 
      LDA P1        SET SEVERITY
      STA SEVER      CODE.
      JMP QUERY 
      SPC 3 
* 
*  COMMON CODE FOR LL AND SV PROCESSORS. CHECKS P1. 
* 
CHKP1 NOP           ENTRY 
      JSB CKUDC     CHECK FOR NON-RMOTE COMMAND.
      JSB PNAMR     PARSE PARAMETER.
      DEF P1
      LDA P1        NEGATIVE? 
      SSA 
      JMP INVAL       INVALID!
      LDA STAT1     WAS 
      AND D3         IT 
      CPA D1          NUMERIC?
      JMP CHKP1,I       YES--RETURN.
* 
INVAL JSB ECHP2     ECHO IF SEVERITY=2.                                         
      JSB PRINT     DISPLAY "INVALID INPUT".
      DEF INVLM 
      DEC 7 
      JMP POPTS     POP THE TRANSFER STACK. 
* 
INVLM ASC 7, INVALID INPUT
      SKP 
* 
*  STORAGE AND CONSTANTS
* 
      SPC 1 
************************************* WARNING: DO NOT CHANGE ORDER OF 
*                                   *          "NAME" THROUGH "SEVER".
*  RTE FILE NAMR PARAMETERS         * 
NAME  BSS 3         * 
STATS BSS 1         * 
SECU  BSS 1         * 
CRN   BSS 1         * 
TYPE  BSS 1         * 
SIZE  BSS 1         * 
RLENG BSS 2         * 
*                                   * 
*  ALTERNATE PARSE BUFFER           * 
P1    BSS 3         * 
STAT1 BSS 1         * 
P2    BSS 6         * 
*                                   * 
* SEVERITY CODE                     * 
SEVER NOP           * 
************************************* END OF #PKUP PARAMETER BLOCK
      SPC 1 
B20   OCT 20
B377  OCT 377 
HB377 BYT 377,0 
MD2   DEC -2
MD3   DEC -3
MD6   DEC -6
D1    DEC 1 
D2    DEC 2 
D3    DEC 3 
D4    DEC 4 
D8    DEC 8 
SD1   DEF 1,I 
SD2   DEF 2,I 
"00"  ASC 1,00
SMPNM NOP 
ERROR NOP 
TEMP  NOP 
TEMP1 NOP 
TEMP2 NOP 
TEMP3 NOP 
IOLU  NOP 
LUTYP NOP           EQ. TYPE OF INPUT DEVICE. 
LULOG NOP           LU OF LOG DEVICE. 
A.TR  ASC 2,$TR     TR COMMAND WITH CURRENT PROMPT CHAR.
LPRMP ASC 1,$_      "$" PROMPT FOR LOCAL RTE. 
RPRMP ASC 1,#_      "#" PROMPT FOR REMOTE 3000. 
PROMP ASC 1,        CURRENT OPERATOR PROMPT.
BLANK BYT 40,0
DEFLU BSS 1         DEFAULT LU. 
ERRLU BSS 1         ERROR LU. 
      SKP 
*** SUBROUTINES *** 
      SPC 2 
* SUBROUTINE TO CHECK FOR RTE FILE ERROR
*   CALLING SEQUENCE: JSB CKRTE 
*                     <ERROR RETURN>
*                     <NORMAL RETURN> 
* 
CKRTE NOP           ENTRY POINT.
      ISZ CKRTE     SET NORMAL RETURN.
      LDA ERROR     IF ERROR
      SSA,RSS        >= 0,
      JMP CKRTE,I     RETURN. 
      CMA,INA       USE ABSOLUTE
      STA ERROR      VALUE OF ERROR.
      JSB ECHP2     ECHO IF SEVERITY=2. 
* 
      JSB KCVT      CONVERT TO ASCII. 
      DEF *+2 
      DEF ERROR 
      IOR "00"
      STA RTERR 
      JSB PRINT     PRINT 
      DEF RERMS      ERROR
      DEC 9           MESSAGE.
      CCA           TAKE
      ADA CKRTE      ERROR
      JMP A,I         RETURN. 
* 
RERMS ASC 8,RTE FILE ERROR -
RTERR BSS 1 
      SPC 3 
* SUBROUTINE TO ECHO LAST INPUT IF SEVERITY IS 2
*  CALLING SEQUENCE: JSB ECHP2
* 
ECHP2 NOP           ENTRY.
      LDA D2
      JSB ECHPR 
      JMP ECHP2,I   RETURN. 
      SKP 
* 
* SUBROUTINE TO READ A RECORD.
*  CALLING SEQUENCE: <SET UP DCB AND PROMPT>
*                    LDA <INPUT LU OR FILE NAME>
*                    JSB READ 
*                    DEF <ERROR RETURN> 
*                    DEF <EOF RETURN> 
* 
ERRTN NOP 
EFRTN NOP 
READ  NOP           ENTRY.
      STA IOLU      SAVE INPUT INDICATOR. 
      LDB READ,I    PICK UP 
      STB ERRTN      RETURN 
      ISZ READ        ADDRESSES.
      LDB READ,I
      STB EFRTN 
      ISZ READ
      AND HB377     NON ZERO IF FILE NAME, ELSE LU. 
      SZA 
      JMP FLRD      DISK FILE.
* 
      LDA IOLU
      JSB EQTYP     CHECK TYPE. 
      STA LUTYP 
      LDB MD768     ASSUME 768 MAX CHAR READ. 
      SZA 
      JMP LURD      LU NOT INTERACTIVE. 
* 
      JSB REIO      DISPLAY PROMPT ON INTERACTIVE DEVICE. 
      DEF *+5 
      DEF D2
      DEF IOLU
      DEF PROMP 
      DEF D1
* 
      LDA IOLU   SET ECHO BIT.
      IOR B600
      STA IOLU
      LDB MD80      USE 80 CHARACTER READ.
* 
* READ OPERATOR REQUEST FROM CURRENT DEVICE OR FILE.
* 
LURD  STB RDLEN     STORE NUMBER OF CHARACTERS. 
      JSB REIO      LU READ.
      DEF *+5 
      DEF SD1 
      DEF IOLU
      DEF INBUF 
      DEF RDLEN 
      RSS 
      JMP RDOK      IF ERROR ON INPUT LU, 
      JSB EROUT       PRINT MESSAGE.
      JMP ERRTN,I   TAKE ERROR RETURN.
* 
RDOK  STA TEMP      SAVE STATUS WORD. 
      STB IOLEN     SAVE BYTE COUNT.
      JSB EOFCK     CHECK FOR END OF FILE.
      JMP EFRTN,I   GOT IT. 
      JMP READ,I    NORMAL RETURN.
* 
FLRD  JSB READF     DISK FILE.
      DEF *+6       (OPENED WHEN FIRST TRANSFER 
      DEF DCB       WAS PERFORMED)
      DEF ERROR 
      DEF INBUF 
      DEF D384
      DEF IOLEN     ACTUAL WORD COUNT.
* 
      JSB CKRTE     CHECK FOR ERRORS. 
      JMP ERRTN,I   ERROR RETURN. 
* 
      LDA IOLEN     IF EOF, 
      INA,SZA,RSS 
      JMP EFRTN,I      TAKE EOF RETURN. 
      LDA IOLEN     SET IOLEN TO
      CLE,ELA        NUMBER OF
      STA IOLEN       BYTES.
      JMP READ,I    NORMAL RETURN.
      SPC 1 
D384  DEC 384 
MD768 DEC -768
MD80  DEC -80 
RDLEN NOP 
      SKP 
* 
* SEND OPERATOR COMMAND (ASCII STRING) TO HP3000. 
* 
* CALLING SEQUENCE: 
* 
*     JSB CMNDS 
*     DEF *+3 
*     DEF BUFA       ADDR OF ASCII STRING.
*     DEF BUFL        POS. # BYTES IN STRING. 
* 
PARMS NOP           ADDR OF ASCII COMMAND STRING. 
      NOP           LENGTH OF ASCII STRING (+BYTES).
* 
CMNDS NOP 
      JSB .ENTR     GET PARAM ADDRESSES.
      DEF PARMS 
      CLA           CLEAR ERROR CODE STORAGE. 
      STA D$ERR 
      STA D$ERR+1 
* 
* BEGIN CONSTRUCTION OF REQUEST BUFFER WITH 
* CLASS, STREAM, AND BYTE LENGTH. 
* 
      LDA D3        STORE MESSAGE CLASS = 3.
      STA D$3BF 
      LDA B20       STORE STREAM TYPE = 20 OCTAL. 
      STA D$3BF+2 
      LDA PARMS+1,I SET BYTE COUNT IN REQUEST.
      STA D$3BF+7 
* 
* MOVE ASCII MESSAGE TO REQUEST BUFFER. 
* 
      INA           ROUND UP NUMBER OF BYTES. 
      CLE,ERA       MAKE WORDS. 
      STA TEMP
      LDA PARMS     SOURCE ADDRESS OF COMMAND.
      LDB D$RQB     DESTINATION ADDRESS.
      ADB D8
* 
      JSB .MVW
      DEF TEMP
      NOP 
* 
* SET UP INPUT LU FOR $STDIN REQUESTS.
* 
      LDA P.STK,I   IF CURRENT INPUT IS A LOGICAL UNIT, 
      STA B         USE IT. IF NOT, USE DEFAULT LU. 
      AND HB377 
      SZA 
      LDB DEFLU 
      LDA B         REMOVE ANY
      AND B77        CONTROL BITS.
      STA D$INP 
* 
* SEND REQUEST TO THE 3000 BY WRITING TO
* QUEX'S CLASS, AND WAIT FOR THE REPLY. 
* 
      JSB D3KMS     SHIP THE REQUEST BUFFER TO QUEX.
      DEF *+2        NO ABORT IF ERROR. 
      DEF CONWD      LONG TIMEOUT.
      JMP RFAIL     REQUEST FAILED. 
* 
      JMP CMNDS,I   RETURN. 
* 
CONWD OCT 140000
      SPC 4 
* 
* SUBROUTINE TO RELEASE ANY LOCKED LUS, THEN LOCK D$LOG.
*  CALLING SEQUENCE: JSB LOKLU
* 
LOKLU NOP           ENTRY.
      JSB LURQ      UNLOCK
      DEF *+4        ANY
      DEF UNLOK       LUS 
      DEF D$LOG        HELD.
      DEF D1
      NOP 
* 
      LDA D$LOG     IF INTERACTIVE, 
      JSB EQTYP 
      SZA,RSS 
      JMP LOKLU,I     RETURN. 
* 
      JSB LURQ      LOCK
      DEF *+4        D$LOG. 
      DEF LOCK
      DEF D$LOG 
      DEF D1
D0    NOP 
      JMP LOKLU,I   RETURN. 
* 
UNLOK OCT 140000
LOCK  OCT  40001
      SKP 
* 
* SUBROUTINE TO TEST FOR END OF FILE ON VARIOUS DEVICES.
*   CALLING SEQUENCE: <TEMP = EQT STATUS WORD>
*                     <IOLEN = EQT WORD COUNT>
*                     <LUTYP = EQUIPMENT TYPE>
*                     JSB EOFCK 
*                     <EOF RETURN>
*                     <NORMAL RETURN> 
* 
EOFCK NOP           ENTRY.
      CLE 
      LDA LUTYP     EOF DEPENDS ON DEVICE.
      SZA,RSS 
      JMP EOF5      INTERACTIVE. (NO EOF.)
      CPA D1
      JMP EOF1      PHOTOREADER.
      CPA D9
      JMP EOF4      CARD READER.
      CPA D13 
      JMP EOF4      MARK SENSE. 
      CCE           DEFAULT TO MAG TAPE.
* 
EOF1  LDA TEMP      GET STATUS WORD.
      ALF,ALF 
      SEZ,RSS       IF E=1, CHECK BIT 7.
      JMP EOF2
      SSA 
      JMP EOF6
EOF2  RAL,RAL       CHECK BIT 5.
      SSA,RSS 
      JMP EOF5      NO EOF. 
* 
EOF4  LDA IOLEN     CHECK FOR BLANK CARD. 
      SZA 
EOF5  ISZ EOFCK 
EOF6  JMP EOFCK,I 
      SKP 
* 
* KILL LEADING BLANKS IN COMMAND. 
* 
BLKIL NOP           ENTRY POINT.
LBLNK LDA INBUF     CHECK FOR LEADING BLANK 
      AND HB377     (OK FOR RTE, BUT NG FOR 3000).
      CPA BLANK 
      RSS 
      JMP BLKIL,I   NONE. RETURN. 
* 
      LDA DINBF     ADDRESS OF ASCII COMMAND. 
      STA TEMP1     SOURCE POINTER. 
      STA TEMP2     DESTINATION POINTER.
      LDA IOLEN 
      CMA,INA 
      STA TEMP3     NEGATIVE # BYTES. 
      LDB TEMP1,I   PRIME THE PUMP. 
      ISZ TEMP1 
* 
LOOP1 LDA TEMP1,I   MOVE STRING LEFT ONE BYTE.
      RRL 8 
      STB TEMP2,I 
      ISZ TEMP2 
      RRL 8 
      ISZ TEMP1 
      ISZ TEMP3 
      JMP LOOP1     LOOP TILL DONE. 
* 
      CCA           SUBTRACT 1 FROM 
      ADA IOLEN      CHARACTER COUNT. 
      STA IOLEN 
      SZA           CHECK FOR ZERO LENGTH.
      JMP LBLNK     GO LOOK FOR ANOTHER LEADING BLANK.
* 
      JMP QUERY     ALL BLANKS. GET NEXT COMMAND. 
      SKP 
* 
* SUBROUTINE TO FIND EQUIPMENT TYPE OF AN LU. 
*  RETURN DRIVER TYPE, OR 0 FOR INTERACTIVE LU. 
*  CALLING SEQUENCE: LDA <LU> 
*                    JSB EQTYP
* 
EQTYP NOP           ENTRY.
      STA TEMP1 
* 
      JSB IFTTY     CALL SYSTEM 
      DEF *+2        ROUTINE TO 
      DEF TEMP1       CHECK LU. 
      SZA 
      JMP TTY       NON-INTERACTIVE-- 
      LDA B          PLACE DEVICE 
      ALF,ALF         TYPE IN 
      AND B377         A-REG. 
      JMP EQTYP,I   RETURN. 
TTY   CLA           INTERACTIVE. TYPE=0.
      JMP EQTYP,I 
      SPC 3 
* 
* SUBROUTINE TO PRINT A RECORD ON LULOG.
*   CALLING SEQUENCE: JSB PRINT 
*                     DEF <STRING>
*                     DEC <LENGTH>
* 
PRINT NOP           ENTRY POINT 
      LDA PRINT,I   PICK
      STA MSG        UP 
      ISZ PRINT       PARAMETERS. 
      LDA PRINT 
      STA MSLEN 
      ISZ PRINT     SET RETURN ADDR.
DOPRT JSB REIO      CALL REIO FOR WRITE.
      DEF *+5 
      DEF SD2 
      DEF LULOG 
MSG   NOP 
MSLEN NOP 
      RSS 
      JMP PRINT,I   RETURN. 
* 
      LDA ERRLU     PRINT ERROR: IF ERROR 
      CPA LULOG      LU IS DIFFERENT FROM 
      JMP PRINT,I     LOG LU, STORE ERROR 
      STA LULOG        LU AS LOG LU AND 
      JMP DOPRT         DO THE PRINT AGAIN. 
      SKP 
* RESULT OF BAD INPUT LU/FILE:
*        CLOSE COMMAND FILE (IF OPEN) 
*        TERMINATE IF INPUT IS NON-INTERACTIVE. 
* 
POPTS LDA LUTYP     IF CURRENT INPUT
      SZA,RSS        IS INTERACTIVE,
      JMP QUERY       EVERYTHING IS OK. 
      JSB CLSFL     CLOSE COMMAND FILE (IF ONE IS OPEN).
* 
      LDA STKHD 
      STA P.STK     RESET STACK POINTER.
* 
      LDA P.STK,I   IF INPUT
      AND HB377      IS FROM
      SZA             A FILE, 
      JMP M0501         TERMINATE.
      LDA P.STK,I   IF INPUT LU 
      JSB EQTYP      IS NOT 
      SZA             INTERACTIVE,
      JMP M0501         TERMINATE.
      JMP QUERY     TRY TO READ AGAIN.
      SPC 3 
* SUBROUTINE TO PRINT ERROR MESSAGE.
*   CALLING SEQUENCE: <A- & B-REGS CONTAIN MESSAGE> 
*                     JSB EROUT 
* 
EROUT NOP           ENTRY.
      DST EMSG+3    SET UP MESSAGE. 
      JSB ECHP2     ECHO IF SEVERITY=2. 
      JSB PRINT     PRINT ON LULOG. 
      DEF EMSG
D5    DEC 5 
      JMP EROUT,I   RETURN. 
* 
EMSG  ASC 5,RMOTE 
      SPC 3 
* SUBROUTINE TO ECHO LAST INPUT.
*  CALLING SEQUENCE: LDA <VALID SEVERITY CODE>
*                    JSB ECHPR
* 
* 
ECHPR NOP           ENTRY.
      CPA SEVER     IF SEVERITY CODE
      RSS            NOT = A-REGISTER,
      JMP ECHPR,I        DON'T ECHO.
      LDA IOLEN 
      CMA,INA 
      STA TEMP4 
      JSB PRINT     PRINT ON LULOG. 
      DEF INBUF 
TEMP4 NOP 
      JMP ECHPR,I   RETURN
      SPC 3 
* SUBROUTINE TO CLOSE THE FILE OPEN TO DCB, IF OPEN.
*  CALLING SEQUENCE: JSB CLSFL
* 
CLSFL NOP 
      JSB CLOSE     CLOSE THE FILE. 
      DEF *+2 
      DEF DCB 
      JMP CLSFL,I   RETURN. 
      SPC 3 
*  SUBROUTINE TO CALL PNAMR WITH P1 BUFFER
PNM1  NOP           ENTRY.
      JSB PNAMR 
      DEF P1
      LDB P1        LOAD PARAMETER. 
      JMP PNM1,I    RETURN. 
      SPC 2 
*  SUBROUTINE TO CALL NAMR PARSE ROUTINE
*   CALLING SEQUENCE: <SET PNTR TO PROPER COLUMN OF INBUF>
*                      JSB PNAMR
*                      DEF <OUTPUT BUFFER>
* 
IPBUF NOP 
PNAMR NOP           ENTRY POINT 
      LDA PNAMR,I   PICK UP 
      STA IPBUF      BUFFER ADDRESS.
      ISZ PNAMR     SET RETURN. 
      JSB NAMR      CALL
      DEF *+5        NAMR 
      DEF IPBUF,I     ROUTINE.
      DEF INBUF 
      DEF IOLEN 
      DEF PNTR
      JMP PNAMR,I   RETURN. 
      SPC 2 
PNTR  NOP           COLUMN POINTER
      SPC 1 
DCB   BSS 144 
      SPC 1 
*** DO NOT CHANGE ORDER OF "IOLEN" AND "INBUF" ***********
IOLEN NOP           INPUT LENGTH (BYTES) *
INBUF BSS 384       INPUT BUFFER         *
**********************************************************
      SKP 
     UNL
     IFZ           *****
     LST
* 
*  PROCESSOR FOR MOVE COMMAND 
* 
M0900 JSB CKUDC     CHECK FOR NON-RMOTE COMMAND.
      LDA D$SMP     IF NO HELLO 
      SZA,RSS        ISSUED,
      JMP NHLLO        REPORT ERROR.
      CLA           SET RECORD
      STA COUNT      COUNT TO ZERO. 
      LDA SLFLG     IF SLAVE IS THERE,
      SZA            SKIP POPEN.
      JMP CLOSF 
* 
      LDA MAXBF     IF MAX BUFFER 
      SZA,RSS        SIZE IS ZERO,
      JMP NOSPC        ERROR! 
      STA TAG10     SET MAX LENGTH. 
      JSB POPEN      OPEN SLAVE.
      DEF *+6 
      DEF PCB 
      DEF ERROR 
      DEF SNAME 
      DEF NOD3K 
      DEF TAG 
      JSB CHKDS       CHECK FOR DS ERROR. 
      ISZ SLFLG       SET SLAVE-OPEN FLAG.
* 
CLOSF JSB CLSFL     CLOSE COMMAND FILE SO DCB CAN BE USED.
      CLA           DISABLE "BREAK" 
      STA D$BRK      AND "CONTROL-Y"
      STA D$CTY       CHECKS. 
* 
      LDA PROMP     IF PROMPT 
      CPA RPRMP      IS REMOTE, 
      JMP FRRMO         GO MOVE FROM 3000.
      SPC 1 
** MOVE FILE FROM LOCAL TO REMOTE SYSTEM
* 
*  OPEN RTE SOURCE FILE 
      LDA IPRMP     CHANGE PROMPT TO "/" IN CASE
      STA PROMP      INPUT IS FROM AN LU. 
      JSB PNAMR     GET NAMR
      DEF NAME       PARAMETERS.
      LDA STATS     IF FILE 
      AND D3         WAS SPECIFIED
      CPA D3          SPECIFIED,
      JMP OP1KF          DO THE OPEN. 
      LDA NAME      IF LU IS
      SSA            NEGATIVE,
      JMP BADLU       REPORT BAD LU.
      JMP CRMPE 
* 
OP1KF LDA HB377 
      STA LUTYP     SET LU TYPE = FILE. 
*+ CALL OPEN(DCB,ERROR,NAME,B610,SECU,CRN)
      JSB OPEN   +
      DEF *+07   +
      DEF DCB    +
      DEF ERROR  +
      DEF NAME   +
      DEF B610   +
      DEF SECU   +
      DEF CRN    +
      JSB CKRTE     FILE ERROR? 
      JMP ABEND       YES.
* 
*  CREATE MPE FILE
CRMPE JSB GMPNM     GET MPE FORMALDESIGNATOR. 
      JSB PNAMR     PICK UP MOVE MODE.
      DEF P1
* 
      LDA P1        IF USER SPECIFIED 
      CPA "UN"       UNNUMBERED FORMAT, 
      RSS 
      JMP TEST2 
      LDB D4            FOPTN := 4
      JMP STFOP         (FIXED LEN, ASCII). 
TEST2 LDB B100      ELSE, IF RTE SOURCE 
      LDA ERROR            FILE IS ASCII
      CPA D4                (TYPE = 4), 
      LDB B104                FOPTN := OCTAL 104
STFOP STB TAG                 (VARIABLE LEN, ASCII).
*                    (OTHERWISE FOPTN := OCT 100, VAR. LEN, BINARY) 
* 
      LDA P2        DID USER
      CPA "SP"       SPECIFY RTE SPOOL FILE 
      JMP SETCC 
      CPA "CC"        OR CARRIAGE CONTROL?
      JMP SETCC 
      JMP STRLN         NO--GO SET RECORD LENGTH. 
SETCC LDA TAG           YES--SET CCTL BIT IN FOPTIONS.
      IOR B404
      STA TAG 
* 
STRLN CLB           IF "UNNUMBERED" 
      LDA P1         FORMAT SPECIFIED,
      CPA "UN"        SET RECORD LENGTH 
      LDB D40          TO 40. OTHERWISE USE 0.
* 
*  SEND TAG FIELDS AND NAME TO SLAVE. 
      LDA D3        TAG(1) = 3 (FOR WRITE). 
      JSB SNDWR 
* 
      CLA           SET TOTAL LENGTH
      STA TOTLN      TO ZERO. 
* 
*  IF TAG9 = 0, FILE ALREADY EXISTED. OK TO DESTROY DATA? 
      LDA TAG9
      SZA 
      JMP LLOOP 
      JSB OVER?     ASK: "OVERWRITE?" 
      CPA "Y"       IF YES, 
      JMP LLOOP       GO TRANSFER FILE. 
      JMP ABEND      OTHERWISE, CLOSE BOTH FILES. 
* 
*  MAIN TRANSFER LOOP...
LLOOP LDA NAME      READ A
      JSB READ       RECORD.
      DEF ABEND     (ERROR RETURN)
      DEF I0000     (EOF RETURN)
      LDA LUTYP     SPECIAL CHECK: IF 
      IOR IOLEN      INTERACTIVE AND
      SZA,RSS         LEN = 0, TAKE THE 
      JMP I0000        EOF RETURN.
      ISZ COUNT     BUMP RECORD COUNT.
      NOP 
      JSB CONT      CONTINUE? 
      LDA TAG11     IF RTE FILE IS
      CPA "SP"       SUPPOSED TO BE 
      JSB CKSPL       SPOOLED, CHECK IT.
* 
      LDB IOLEN     CALCULATE WORD LENGTH :=
      ADB D3         (BYTE LENGTH + 3)/2
      CLE,ERB         (ALLOW FOR ODD BYTE & 
      STB WRDLN        COUNT WORD). 
*     IF WRDLN + TOTLN > TAG10
      ADB TOTLN 
      LDA TAG10 
      CMA,INA 
      ADA B 
      SZA 
      SSA 
      JMP I0001 
*+       CALL PWRIT(PCB,ERROR,BUFER,TOTLN,TAG)
      JSB PWRIT + 
      DEF *+06   +
      DEF PCB    +
      DEF ERROR  +
      DEF BUFER,I 
      DEF TOTLN  +
      DEF TAG    +
      JSB CHKDS     CHECK FOR DS ERROR. 
      CLA           RESET TOTAL 
      STA TOTLN      LENGTH.
*+       END
I0001 EQU * 
      LDA @REC      MOVE RECORD 
      LDB BUFER      TO BUFFER. 
      ADB TOTLN 
      JSB .MVW
      DEF WRDLN 
      NOP 
*+    TOTLN := TOTLN + WRDLN
      LDA TOTLN  +
      ADA WRDLN  +
      STA TOTLN  +
*+  ELSE
      JMP LLOOP 
* 
*  IOLEN < 0--END OF FILE. WRITE LAST XFER BUFFER.
*+    TAG3 := -1
I0000 CCA 
      STA TAG3   +
*+    CALL PWRIT(PCB,ERROR,BUFER,TOTLN,TAG) 
      JSB PWRIT + 
      DEF *+06   +
      DEF PCB    +
      DEF ERROR  +
      DEF BUFER,I 
      DEF TOTLN  +
      DEF TAG    +
      JSB CHKDS     CHECK FOR DS ERROR. 
*+    END 
      JMP EOF 
      SPC 3 
*** CODE TO INTERPRET FIRST COLUMN OF MPE RECORD AS CARRIAGE CONTROL ***
      SPC 1 
CCTL  LDA BUFAD,I   ISOLATE FIRST 
      AND HB377      CHARACTER. 
      ALF,ALF       MOVE TO RIGHT BYTE. 
      STA CNTRL 
      CPA PLUS      "+"?
      JMP HPLUS       YES.
* 
      ADA MB200     IF LESS THAN
      SSA            OCTAL 201, 
      JMP SCHTB        TRY TABLE SEARCH.
      ADA MB67      IF LESS THAN
      SSA            OCTAL 270, 
      JMP SKIPN        SKIP N LINES.
      ADA MB10      IF LESS THAN
      SSA            OCTAL 300, 
      JMP SKIPM        SKIP TWO TIMES.
* 
*  SEARCH TABLE 
SCHTB LDB STTBL     POINT TO BEGINNING OF TABLE.
LOOP3 LDA B,I       GET ENTRY.
      XOR CNTRL     IS IT WHAT
      AND B377       WE'RE LOOKING FOR? 
      SZA,RSS 
      JMP FOUND 
      INB           NO--BUMP POINTER
      JMP LOOP3      AND STAY IN LOOP.
* 
FOUND CPB ENTBL     END OF TABLE? 
      JMP GOWRT       YES--GO WRITE.
      LDA B,I       GET RTE CONTROL 
      AND HB377      WORD.
      ALF,ALF 
DCNTR JSB DOCTL     PERFORM I/O CONTROL.
      LDA IOLEN     IF RECORD ONLY
      CPA D1         CONTAINED CONTROL, 
      JMP BMPCT         SKIP THE WRITE. 
      JMP GOWRT     GO WRITE. 
      SPC 1 
*  CHANGE MPE "+" CONTROL TO RTE "*"
HPLUS LDA BUFAD,I   GET WORD. 
      AND B377      MASK OUT LEFT BYTE. 
      IOR STAR      AND "*".
      STA BUFAD,I   STORE.
      JMP GOWRT     GO WRITE. 
      SPC 1 
*** LINE SKIPPING *** 
* 
*  SKIP 56-63 LINES...
SKIPM LDA D55       SKIP 55 
      JSB DOCTL      LINES. 
      LDA CNTRL     SUBTRACT 55 
      ADA MD55       FROM MPE CONTROL.
      RSS           CONTINUE IN "SKIPN" 
* 
*  SKIP 1-55 LINES... 
SKIPN LDA CNTRL     SUBTRACT OCTAL 200
      ADA MB200      FROM MPE CCNTL.
      JMP DCNTR     GO PERFORM CONTROL. 
      SPC 1 
* SUBROUTINE TO PERFORM LINE SPACING I/O CONTROL FUNCTION.
*  CALLING SEQUENCE: LDA <CONTROL WORD> 
*                    JSB DOCTL
* 
DOCTL NOP           ENTRY.
      STA CNTRL     SAVE CONTROL WORD.
      LDA NAME      SET CONTROL 
      AND B77        BITS TO PERFORM
      IOR B1100       CONTROL FUNCTION. 
      STA TEMP
      JSB EXEC      CALL EXEC 
      DEF *+4        FOR CONTROL. 
      DEF SD3 
      DEF TEMP
      DEF CNTRL 
      NOP           IGNORE ERROR. 
      JMP DOCTL,I   RETURN. 
      SKP 
*  MOVE FILE FROM REMOTE TO LOCAL SYSTEM
* 
FRRMO JSB GMPNM     GET MPE FORMALDESIGNATOR
      JSB PNAMR     GET NAMR
      DEF NAME       PARAMETERS.
      JSB PNAMR     PICK UP 
      DEF P1         MOVE MODE. 
      LDA NAME      IF USER SPECIFIED 
      AND HB377      RTE FILE AND 
      LDB P2          ALSO CARRIAGE 
      SZA              CONTROL, 
      SZB,RSS 
      JMP OK
      JSB WARN            WARN HIM AND
      CLA                  CLEAR OPTION.
      STA P2
* 
*  SEND TAG FIELDS AND NAME TO SLAVE. 
OK    CLB           TAG(6) := 0 (RECLEN). 
      LDA D2        TAG(1) := 2 (FOR READ). 
      JSB SNDWR 
*    (SLAVE SETS UP TAG WORDS 0 AND 8 TO BE FOPTIONS AND RECLEN.) 
* 
      LDA STATS     IF RTE
      AND D3         FILE WAS 
      CPA D3          SPECIFIED,
      JMP OPN1K         GO OPEN IT. 
* 
      LDA NAME      IF LU IS
      SSA            NEGATIVE,
      JMP BADLU        REPORT BAD LU. 
      LDA SECU      IF SPOOLING OPTION
      CPA "SP"       FOR LU WAS SPECIFIED,
      JMP SETSP        SET IT UP. 
* 
TYP0  CLA           PRETEND IT'S TYPE 0 FILE. 
      JMP SETYP     SET TYPE AND GO MOVE. 
* 
*  SPOOLING REQUESTED. SET UP SPOOLING FILE: RM<LU><NN> 
SETSP JSB LUTRU     GET "REAL"
      DEF *+2        LU NUMBER
      DEF D$LOG       (IN CASE
      STA TEMP         OF SESSION). 
      JSB KCVT      SET UP
      DEF *+2        <LU> 
      DEF TEMP        PORTION OF
      IOR "00"         NAME.
      STA SPFIL+1 
      LDA D24       SET FILE
      STA SIZE       LENGTH TO
      CLA             24 BLOCKS AND 
      STA RLENG        CLEAR RECORD LEN.
      LDA D100      SET UP
      STA TEMP3      <NN> 
SETNN JSB KCVT        PORTION 
      DEF *+2          OF NAME. 
      DEF TEMP3 
      STA SPFIL+2 
* 
      LDA $SPCR     SET CARTRIDGE NUMBER
      STA SPCRN      IN SPOOL BUFFER. 
* 
      JSB CREAT     CREATE SPOOLING FILE
      DEF *+8        (TYPE = 3).
      DEF DCB 
      DEF ERROR 
      DEF SPFIL 
      DEF SIZE
      DEF D3
      DEF D0
      DEF $SPCR 
      LDA ERROR     IF ERROR = -2,
      CPA MD2        (FILE EXISTS), 
      JMP TRY2          TRY DIFFERENT <NN>. 
      JSB CKRTE     ERROR CREATING FILE?
      JMP ABEND       YES!
* 
*  FILE CREATED...
      DLD SPFIL     REPORT THE
      DST SPFLN      SPOOL FILE 
      LDA SPFIL+2     NAME TO 
      STA SPFLN+2      THE USER.
      JSB PRINT 
      DEF SPMSG 
      DEC 9 
* 
      JSB CLSFL     CLOSE IT SO SMP CAN USE IT. 
      LDA NAME      SAVE LU 
      AND NOT77      CONTROL
      STA MASK        BITS. 
      XOR NAME      SAVE LU 
      STA OUTLU      NUMBER.
      JSB EQTYP     SET DEVICE
      STA SPTYP       TYPE. 
      JSB SPOPN     OPEN FILE 
      DEF *+3        TO SMP.
      DEF SPBUF 
      DEF ERROR 
      JSB CKRTE     ERROR?
      JMP ABEND      YES. 
      STA SPFLG     SET SPOOL FLAG. 
      IOR MASK      ADD CONTROL BITS. 
      STA NAME      SET I/O LU TO SPOOL LU. 
      JMP TYP0      SET TYPE & GO MOVE. 
* 
*  DUPLICATE NAME. TRY AGAIN. 
TRY2  ISZ TEMP3     BUMP <NN> PART OF NAME. 
      LDA TEMP3     IF UP TO
      CPA D200       200, 
      RSS 
      JMP SETNN 
      JSB CKRTE       ERROR!
      NOP 
      JMP ABEND 
* 
*  SEE IF RTE FILE ALREADY EXISTS BY TRYING TO OPEN IT. 
*  CALL OPEN(DCB,ERROR,NAME,B610,SECU,CRN)
OPN1K JSB OPEN
      DEF *+7 
      DEF DCB 
      DEF ERROR 
      DEF NAME
      DEF B610
      DEF SECU
      DEF CRN 
      LDA ERROR     IF ERROR < 0, 
      SSA             TRY TO CREATE IT. 
      JMP CRT1K 
      STA TYPE      SAVE TYPE.
      SZA,RSS       IF TYPE 0 FILE, 
      JMP SETYP       GO MOVE.
*  FILE EXISTS. IS IT OK TO DESTROY EXISTING DATA?
      JSB OVER?     ASK: "OVERWRITE?" 
      CPA "Y"       IF YES, 
      JMP SETYP       GO MOVE 
      JMP ABEND      OTHERWISE, CLOSE FILES.
* 
CRT1K LDA TYPE      IF TYPE 
      SZA            IS NOT 
      JMP CKSIZ       SPECIFIED,
      LDB D3            SET TYPE TO 3 
      LDA TAG           UNLESS ASCII BIT
      AND D4            IS SET IN THE MPE 
      SZA               FOPTIONS. (THEN 
      LDB D4            SET TYPE TO 4.) 
      STB TYPE
      STB TAG2
* 
CKSIZ CCB           IF SIZE WAS NOT 
      LDA SIZE       SPECIFIED, USE 
      SZA,RSS         NEGATIVE ONE. 
      STB SIZE
* 
      LDB TAG6      IF RECORD LENGTH
      LDA RLENG      WAS NOT SPECIFIED, 
      SZA,RSS         USE MPE FILE'S. 
      STB RLENG 
* 
*  CALL CREAT(DCB,ERR1,NAME,SIZE,TYPE,SECU,CRN) 
      JSB CREAT  +
      DEF *+08   +
      DEF DCB    +
      DEF ERR1   +
      DEF NAME   +
      DEF SIZE   +
      DEF TYPE   +
      DEF SECU   +
      DEF CRN    +
* 
      LDA ERR1      IF CREATE ERROR IS -2,
      CPA MD2        IT'S MASKING THE TRUE
      RSS             ERROR. OTHERWISE STORE
      STA ERROR        IT AS THE FILE ERROR.
* 
      JSB CKRTE     ERROR?
      JMP ABEND       YES.
* 
SETYP LDA TYPE      SET TAG(2) TO 
      STA TAG2       RTE FILE TYPE. 
* 
*  MAIN TRANSFER LOOP.
*    CALL PREAD(PCB,ERROR,BUFER,TAG10,TAG)
RLOOP JSB PREAD 
      DEF *+6 
      DEF PCB 
      DEF ERROR 
      DEF BUFER,I 
      DEF TAG10 
      DEF TAG 
      JSB CHKDS     CHECK FOR DS ERROR. 
      LDA TAG7      SET TOTLN TO
      STA TOTLN       LENGTH OF PREAD BUFFER. 
      CLA 
      STA I         RESET INDEX (I := 0). 
*  LOOP TO UNPACK THE PREAD BUFFER. 
LOOP2 LDA TOTLN     IF TOTLN
      CMA,INA        >= I,
      ADA I 
      SSA,RSS          DONE WITH
      JMP EOD?         THIS BUFFER. 
      LDA BUFER     CALCULATE ADDRESS 
      ADA I          OF RECORD IN 
      STA BUFAD       PREAD BUFFER. 
      ISZ BUFAD 
      LDB A,I       GET RECORD LENGTH 
      STB IOLEN       (BYTES).
      ADB D3        UPDATE INDEX
      CLE,ERB        (WORD POINTER):
      ADB I 
      STB I            I := (IOLEN+3)/2 + I.
* 
      LDA TAG11     IF USER SPECIFIED 
      CPA "CC"       CARRIAGE CONTROL MAPPING,
      JMP CCTL        GO DO IT. 
* 
GOWRT LDA NAME      WRITE A 
      JSB WRITE      RECORD.
      DEF ABEND     (ERROR RETURN)
* 
BMPCT ISZ COUNT     BUMP RECORD COUNT.
      NOP 
      JSB CONT      CONTINUE? 
      JMP LOOP2     STAY IN LOOP UNTIL EOR. 
* 
*  END OF DATA? 
EOD?  LDA TAG3      IF TAG3 >= 0, 
      SSA,RSS 
      JMP RLOOP       CONTINUE READING. 
* 
*  END OF FILE. 
EOF   LDA NAME      IF RTE FILE 
      AND HB377      NAME WAS 
      SZA             SPECIFIED,
      JMP CLS1K         GO CLOSE IT.
* 
      LDA TAG1      IF OPERATION WAS
      CPA D3         WRITE, SKIP EOF
      JMP WTSLV       AND SPOOL CHECK.
* 
*  WRITE END OF FILE IF DEVICE IS MAG TAPE OR LINE PRINTER. 
      LDA NAME      GET DRIVER
      JSB EQTYP      TYPE.
      CPA B23       MAG TAPE? 
      JMP MAGTP       YES.
      CPA B12       LINE PRINTER? 
      JMP LINEP       YES.
      JMP CKSP1     NEITHER.
* 
MAGTP LDB B100      FUNCTION CODE := 1. 
      JMP CEXEC     CALL EXEC.
* 
LINEP LDB B1100     FUNCTION CODE := OCTAL 11.
* 
CEXEC LDA NAME      ADD LU (MINUS ANY CONTROL BITS) 
      AND B77        TO FUNCTION CODE.
      IOR B 
      STA TEMP3 
      JSB EXEC      CALL EXEC FOR I/O CONTROL.
      DEF *+4 
      DEF SD3 
      DEF TEMP3 
      DEF MD1 
      NOP           IGNORE ERRORS.
* 
CKSP1 LDA SPFLG     SPOOLING SET UP?
      SZA,RSS 
      JMP WTSLV       NO--WAIT ON SLAVE.
* 
      JSB EXEC        YES--RELEASE SPOOL FILE.
      DEF *+5 
      DEF D23 
      DEF "SMP" 
      DEF D4
      DEF SPFLG 
* 
      CLA           CLEAR SPOOLING
      STA SPFLG      FLAG.
      JMP WTSLV     WAIT FOR SLAVE. 
* 
*  DETERMINE RTE TRUNCATION FOR FILE CLOSE. 
CLS1K CLA           ITRUN := 0. 
      STA ITRUN 
      LDA SIZE      IF SIZE WAS 
      SSA,RSS        NOT NEGATIVE,
      JMP CLFIL        DON'T TRUNCATE.
      JSB LOCF
      DEF *+7 
      DEF DCB 
      DEF ERROR 
      DEF P1+1
      DEF P1+2      IRB 
      DEF P1+3
      DEF P1+4      JSEC
*  ITRUN := JSEC/2 - IRB - 1
      LDA P1+4
      CLE,ERA 
      LDB P1+2
      CMB 
      ADA B 
      STA ITRUN 
* 
*  CLOSE RTE FILE AND MPE SLAVE.
*+ CALL CLOSE(DCB,ERROR,ITRUN)
CLFIL JSB CLOSE  +
      DEF *+04   +
      DEF DCB    +
      DEF ERROR  +
      DEF ITRUN  +
* 
*  WAIT FOR SLAVE TO CLOSE FILE.
WTSLV JSB PCONT 
      DEF *+4 
      DEF PCB 
      DEF ERROR 
      DEF TAG 
      JSB CHKDS 
* 
EOTR  LDA PROMP     IF PROMPT WAS 
      CPA IPRMP      CHANGED TO "/",
      LDA LPRMP       CHANGE BACK TO "$". 
      STA PROMP 
      CPA LPRMP     IF SOURCE WAS REMOTE, 
      JMP LDLCL 
      LDA TAG12       READ COUNT = TAG12
      LDB COUNT       WRITE COUNT = COUNT 
      JMP DONOR 
LDLCL LDA COUNT      OTHERWISE READ=COUNT 
      LDB TAG12       AND WRITE = TAG12.
DONOR JSB PRNOR     PRINT NUMBER OF RECORDS.
      CCA 
      STA D$BRK     RE-ENABLE "BREAK" 
      STA D$CTY      AND "CONTROL-Y". 
      JMP M1250     REOPEN XFER FILE & GET COMMAND. 
      SKP 
*  ABNORMAL END.
ABEND JSB PCONT     SEND PCONTROL 
      DEF *+4        TO TELL SLAVE
      DEF PCB         TO SHUT DOWN. 
      DEF ERROR 
      DEF TAG 
      CLA           GET RID OF
      STA TAG4       ERROR THE
      STA TAG8        SLAVE SENDS.
      JMP EOF       GO CLOSE FILE & SLAVE.
      SPC 3 
* SUBROUTINE TO CHECK FOR DS/1000 OR MPE ERROR
*  CALLING SEQUENCE: JSB CHKDS
* 
CHKDS NOP           ENTRY POINT.
      LDA ERROR     IF ERROR = 0, 
      SZA,RSS 
      JMP CHKDS,I     RETURN. 
*  WHAT KIND OF ERROR IS IT?
      CPA D1        IF ERROR = 1, 
      JMP RERR       SLAVE REJECTED.
      CPA MD41      IF ERROR = -41, 
      JMP NOSLV       SLAVE ISN'T THERE.
      CPA MD55      ID ERROR = -55, 
      JMP PTMOT       IT'S A TIMEOUT. 
* 
*  PRINT THE DS/1000 ERROR MESSAGE. 
      CMA,INA       SINCE ERROR IS NEGATIVE,
      STA ERROR      MAKE IT POSITIVE.
* 
      JSB KCVT
      DEF *+2 
      DEF ERROR 
      IOR "00"
      STA DERR1 
* 
      JSB PRINT     PRINT THE 
      DEF DERMS      ERROR MESSAGE. 
      DEC 9 
CKP   LDA CHKDS     IF CALL WAS MADE IN 
      CPA @EOTR      LAST PCONTROL, 
      JMP EOTR        GO PRINT # OF RECORDS.
      JMP ABEND     CLOSE FILES.
* 
@EOTR DEF EOTR
DERMS ASC 8,DS/1000 ERROR  -
DERR1 BSS 1 
* 
NOSLV JSB ECHP2     ECHO IF SEVERITY=2. 
      JSB PRINT     PRINT "NO 
      DEF NSERR      SLAVE" MESSAGE.
      DEC 8 
      JMP POPTS     POP TO TOP OF STACK.
* 
NSERR ASC 8,NO SLAVE AT 3000
      SPC 1 
NOSPC JSB ECHP2     ECHO IF SEVERITY=2. 
      JSB PRINT     PRINT "NO BUFFER
      DEF SPERR      SPACE" MESSAGE.
      DEC 8 
      JMP POPTS     POP TO TOP OF STACK.
* 
SPERR ASC 8,NO BUFFER SPACE 
* 
PTMOT JSB PRINT     PRINT 
      DEF TOMSG      "TIMEOUT"
      DEC 15          MESSAGE.
      JMP CKP       GO CLEAN UP.
* 
BADLU JSB ECHP2     ECHO IF SEVERITY=2. 
      JSB PRINT     PRINT 
      DEF BLMSG      "BAD LU" 
      DEC 4           MESSAGE.
      JMP ABEND     CLOSE SLAVE.
* 
BLMSG ASC 4, BAD LU 
      SKP 
*  "REJECT" ERROR FROM SLAVE. TAG4 TELLS THE REASON:
*     1 => SLAVE WAS EXPECTING DIFFERENT CALL.
*     2 => DS/3000 ERROR. PCHECK CODE IN TAG8.
*     3 => FILE SYSTEM ERROR. FCHECK CODE IN TAG8.
* 
RERR  LDA TAG4      WHY DID SLAVE REJECT? 
      CPA D3
      JMP FERR         FILE ERROR.
      CPA D2
      JMP D3KER        DS/3000 ERROR. 
*  OTHERWISE MASTER-SLAVE COMMUNICATIONS ERROR. 
      JMP ENDCK     CLOSE FILES.
* 
*** DS/3000 ERROR 
D3KER JSB CNUMD     CONVERT 
      DEF *+3        FCHECK 
      DEF TAG8        CODE. 
      DEF DERR2 
      JSB PRINT     PRINT 
      DEF D3ERM      MESSAGE. 
      DEC 10
      JMP ENDCK     CLOSE FILES.
D3ERM ASC 7,DS/3000 ERROR 
DERR2 BSS 3 
* 
*** MPE FILE ERROR
FERR  JSB CNUMD 
      DEF *+3 
      DEF TAG8
      DEF MERR
      JSB PRINT     PRINT 
      DEF MERMS      ERROR
B12   DEC 10          MESSAGE.
* 
ENDCK CLA           RESET 
      STA TAG4       ERROR
      STA TAG8        CODES.
      LDA CHKDS     IF CALL WAS MADE IN 
      CPA @EOTR      LAST PCONTROL, 
      JMP EOTR        GO PRINT # OF RECORDS.
      JMP EOF       CLOSE FILES.
MERMS ASC 7,MPE FILE ERROR
MERR  BSS 3 
      SPC 3 
* SUBROUTINE TO CHECK IF RECORD IS FROM SPOOL FILE. 
*  CALLING SEQUENCE: JSB CKSPL
*   (IF RECORD IS NOT IN SPOOLING FORMAT, TAG11 IS SET TO 0)
* 
CKSPL NOP           ENTRY POINT.
      LDA IOLEN     CALCULATE LENGTH
      CLE,ERA        OF RECORD
      STA WRDLN       IN WORDS. 
      ADA MD2       INSURE LENGTH IS
      SSA             >= 2. 
      JMP BAD 
* 
      LDA INBUF     GET REQUEST TYPE
      AND B77        FROM FIRST WORD. 
      CPA D3        = 3?
      JMP CTRQ        YES--CONTROL REQUEST. 
      CPA D2        = 2?
      JMP WRRQ        YES--WRITE REQUEST. 
      JMP BAD       NEITHER. BAD REQUEST. 
* 
*  CONTROL REQUEST
CTRQ  LDA WRDLN     IS LENGTH 
      CPA D2         = 2? 
      JMP CKSPL,I      YES. RETURN. 
* 
BAD   CLA           BAD RECORD: 
      STA TAG11       CLEAR TAG 11. 
      JSB WARN        WARN USER.
      JMP CKSPL,I     RETURN. 
* 
*  WRITE REQUEST
WRRQ  LDA INBUF+1   CHECK DATA LENGTH.
      SSA,RSS 
      JMP POSLN 
      CMA,INA       FOR NEGATIVE DATA LENGTH, 
      INA           MAKE POSITIVE # OF WORDS. 
      CLE,ERA 
POSLN ADA D2
      CPA WRDLN     IF DATA LENGTH = RECORD LENGTH + 2, 
      JMP CKSPL,I      GOOD RECORD. 
      JMP BAD          (ELSE BAD.)
      SPC 3 
* SUBROUTINE TO PRINT WARNING MESSAGE IF USER SPECIFIED AN ILLEGAL
* OPTION. (ONLY PRINTS IF SEVERITY = 0.)
*  CALLING SEQUENCE: JSB WARN 
* 
WARN  NOP           ENTRY.
      LDA SEVER     IF SEVERITY 
      SZA            IS NOT 0,
      JMP WARN,I      RETURN. 
      JSB PRINT     PRINT MESSAGE.
      DEF WNMSG 
      DEC 12
      JMP WARN,I    RETURN. 
* 
WNMSG ASC 12,WARNING--ILLEGAL OPTION. 
      SKP 
* SUBROUTINE TO GET MPE FORMALDESIGNATOR
*  CALLING SEQUENCE: JSB GMPNM
* 
@MPFN DBL MPFN
NMLEN NOP           NAME LENGTH.
MPFN  BSS 29        FORMALDESIGNATOR. 
OFSET NOP           OFFSET INTO INBUF.
* 
GMPNM NOP           ENTRY POINT.
      LDA PNTR      STORE NEGATIVE
      CMA,INA        OF STARTING COLUMN 
      STA NMLEN       IN NMLEN. 
      CMA 
      STA OFSET     SAVE # OF BYTES OFFSET. 
      JSB PNAMR     PARSE MPE NAME
      DEF P1         (DETERMINE # OF CHARS).
      CCA 
      LDB IOLEN     IF PNTR IS
      INB            PAST THE 
      CPB PNTR       LAST COLUMN, 
      INA             ADD ONE.
      ADA PNTR      ENDING COLUMN 
      ADA NMLEN      MINUS FIRST COLUMN 
      STA NMLEN       IS NAME LENGTH. 
      ADA MD28
      SSA           IF LENGTH IF > 28,
      JMP LENOK 
      LDA D28         SET LENGTH TO 
      STA NMLEN       28. 
* 
LENOK LDA @INBF     MOVE THE
      CLE,ELA        MPE
      ADA OFSET       FILE'S
      LDB @MPFN        FORMALDESIGNATOR.
      MBT NMLEN 
      CLA           STORE 0 AT
      SBT            END OF STRING. 
      JMP GMPNM,I   RETURN. 
      SKP 
* SUBROUTINE TO PRINT NUMBER OF RECORDS COPIED IF SEVERITY CODE=0.
*  CALLING SEQUENCE: LDA "READ" COUNT 
*                    LDB "WRITE" COUNT
*                    JSB PRNOR
* 
PRNOR NOP           ENTRY POINT.
      STA TEMP1     SAVE READ 
      STB TEMP2      AND WRITE COUNTS.
      LDA SEVER     IF SEVERITY CODE
      SZA            IS NOT ZERO, 
      JMP PRNOR,I      RETURN.
      JSB CNUMD     CALL RTE
      DEF *+3        FOR NUMBER 
      DEF TEMP1       CONVERSION. 
      DEF RCNT
      JSB CNUMD     CALL RTE
      DEF *+3        FOR NUMBER 
      DEF TEMP2       CONVERSION. 
      DEF WCNT
      JSB PRINT     PRINT IT. 
      DEF RCNT
      ABS CNTLN 
      JMP PRNOR,I   RETURN. 
* 
COUNT NOP           NUMBER OF RECORDS.
RCNT  ASC 3,
      ASC 7, RECORDS READ,
WCNT  ASC 3,
      ASC 9, RECORDS WRITTEN. 
CNTLN EQU *-RCNT
      SPC 3 
* SUBROUTINE TO CHECK BREAK FLAG AND ABEND DURING MOVE. 
*  CALLING SEQUENCE: JSB CONT 
* 
CONT  NOP           ENTRY POINT.
      JSB IFBRK     IF BREAK
      DEF *+1        FLAG NOT 
      SZA,RSS         SET,
      JMP CONT,I        CONTINUE. 
      LDA TAG3      IF EOF FLAG 
      SZA            SET, 
      JMP CONT,I       IGNORE BREAK.
      JMP ABEND     OTHERWISE, CLOSE FILES. 
      SKP 
* SUBROUTINE TO SEND CONTROL INFORMATION AND FILE NAME TO SLAVE.
*  CALLING SEQUENCE: LDA <2=READ, 3=WRITE>
*                    LDB <RECORD LENGTH>
*                    JSB SNDWR
* 
SNDWR NOP           ENTRY POINT.
      STA TAG1      TAG(1) = OPERATION (READ OR WRITE). 
      STB TAG6      TAG(6) = RECORD LENGTH. 
      LDA TYPE      TAG(2) = RTE FILE TYPE. 
      STA TAG2
      LDA P1        TAG(5) = UNNUMBERED FORMAT INDICATOR. 
      STA TAG5
      LDA P2        TAG(11) = SPOOL/CCTL INDICATOR
      STA TAG11 
*  REST ARE SET TO ZERO.
      CLA 
      STA TAG3
      STA TAG4
      STA TAG7
      STA TAG8
      STA TAG9
      STA TAG12 
*  SEND CONTROL VIA PWRIT(PCB,ERROR,MPFN,D29,TAG).
      JSB PWRIT 
      DEF *+6 
      DEF PCB 
      DEF ERROR 
      DEF MPFN
      DEF D29 
      DEF TAG 
      JSB CHKDS     CHECK FOR DS ERROR. 
*  PICK UP RESULT VIA PCONT(PCB,ERROR,TAG)
      JSB PCONT 
      DEF *+4 
      DEF PCB 
      DEF ERROR 
      DEF TAG 
      JSB CHKDS     CHECK FOR DS ERROR. 
      JMP SNDWR,I   RETURN. 
      SKP 
* 
* SUBROUTINE TO ASK "OVERWRITE?" AND READ RESPONSE. 
*   CALLING SEQUENCE: JSB OVER? 
*                     <A-REG CONTAINS ANSWER> 
* 
OVER? NOP           ENTRY.
      JSB REIO      ASK QUESTION. 
      DEF *+5 
      DEF SD2 
      DEF ERRLU 
      DEF OVRW? 
      DEF D6
      NOP           IGNORE ERRORS.
* 
      JSB REIO      READ RESPONSE.
      DEF *+5 
      DEF SD1 
      DEF ERRLU 
      DEF INBUF 
      DEF D1
      NOP           IGNORE ERRORS.
* 
      LDA INBUF     LOAD RESPONSE.
      AND UMSK1     UPSHIFT LEFT BYTE & CLEAR RIGHT.
      JMP OVER?,I   RETURN. 
* 
OVRW? ASC 6,OVERWRITE? _* 
UMSK1 OCT 157400
      SKP 
* SUBROUTINE TO WRITE A RECORD. 
*  CALLING SEQUENCE: <SET UP DCB> 
*                    <BUFAD CONTAINS BUFFER ADDRESS>
*                    <IOLEN CONTAINS OUTPUT LENGTH IN BYTES>
*                    LDA <OUTPUT INDICATOR> 
*                    JSB WRITE
*                    DEF <ERROR RETURN> 
* 
EWRTN NOP 
WRITE NOP           ENTRY.
      STA IOLU      SAVE OUTPUT INDICATOR 
      LDB WRITE,I   PICK UP ERROR 
      STB EWRTN      RETURN ADDRESS.
      ISZ WRITE     SET RETURN ADDRESS. 
      AND HB377     NON-ZERO IF FILE NAME, ELSE LU. 
      SZA 
      JMP FLWR      DISC FILE.
* 
      LDA IOLEN     CONVERT LENGTH
      CMA,INA        TO NEGATIVE. 
      STA IOLEN 
      JSB REIO      WRITE ON LU.
      DEF *+5 
      DEF SD2 
      DEF IOLU
      DEF BUFAD,I 
      DEF IOLEN 
      RSS           IF ERROR ON OUTPUT LU,
      JMP WRITE,I 
      JSB EROUT       PRINT MESSAGE AND 
      JMP EWRTN,I     TAKE ERROR RETURN.
* 
FLWR  LDA IOLEN     CONVERT LENGTH
      INA            TO WORDS.
      CLE,ERA 
      STA IOLEN 
      JSB WRITF     WRITE ON FILE.
      DEF *+5 
      DEF DCB 
      DEF ERROR 
BUFAD DEF *-* 
      DEF IOLEN 
      JSB CKRTE     ERROR?
      JMP EWRTN,I    YES. 
      JMP WRITE,I    NO.
      SKP 
      SPC 3 
*** STORAGE *** 
      SPC 2 
ERR1  NOP           RTE FILE CREATE ERROR CODE. 
ITRUN NOP           RTE TRUNCATION INDICATOR. 
TOTLN NOP           TOTAL LENGTH OF BUFFERS READ. 
NOD3K NOP           NEGATIVE LU OF 3000.
I     NOP           INDEX INTO BUFER
MASK  NOP           I/O CONTROL BITS
WRDLN NOP           RECORD LENGTH (WORDS) 
      SPC 2 
B404  OCT 404 
"UN"  ASC 1,UN
"Y"   BYT 131,0     "Y" IN LEFT BYTE
* 
SNAME ASC 7,COPY3K.PUB.SYS    3000 SLAVE PROGRAM. 
      NOP                     <END OF NAME INDICATOR> 
* 
      SPC 1 
PCB   BSS 4         PROGRAM CONTROL BLOCK FOR SLAVE.
      SPC 1 
*  SLAVE TAG FIELD: 
TAG   NOP           MPE FOPTIONS
TAG1  NOP           OPERATION: 2=READ, 3=WRITE
TAG2  NOP           RTE FILE TYPE 
TAG3  NOP           0 UNTIL END OF FILE 
TAG4  NOP           0 UNTIL ERROR OCCURS
TAG5  NOP           "UN" FOR UNNUMBERED FORMAT
TAG6  NOP           MPE RECSIZE 
TAG7  NOP           LENGTH OF DATA IN PREAD 
TAG8  NOP           SPECIFIC ERROR CODE (USED WITH 4) 
TAG9  NOP           OLD(0)/NEW(-1) FILE INDICATOR 
TAG10 NOP           MAXIMUM P-TO-P BUFFER SIZE
TAG11 NOP           "SP" FOR RTE SPOOL FILE, "CC" FOR CCNTL 
TAG12 NOP           NUMBER OF RECORDS COPIED BY MPE 
      BSS 7         REST OF TAGS ARE NOT USED.
      SPC 1 
STTBL DEF TABLE     START OF TABLE. 
ENTBL DEF CNTRL     END OF TABLE. 
* 
* RTE CONTROL ON LEFT, MPE CONTROL ON RIGHT 
TABLE BYT 100,102 
      BYT 101,103 
      BYT 77,300
      BYT 76,301
      BYT 70,302
      BYT 71,303
      BYT 72,304
      BYT 73,305
      BYT 74,306
      BYT 75,307
      BYT 76,310
      BYT 103,311 
      BYT 104,312 
      BYT 105,313 
CNTRL NOP 
* 
PLUS  OCT 53
      SPC 1 
MAXBF NOP           MAXIMUM P-TO-P BUFFER SIZE. 
BUFER NOP           ADDRESS OF P-TO-P BUFFER. 
      SPC 3 
* SUBROUTINE TO CLOSE SLAVE PROGRAM, IF OPEN. 
*  CALLING SEQUENCE: JSB CLSLV
* 
CLSLV NOP           ENTRY.
      LDA SLFLG     IF SLAVE IS 
      SZA,RSS        NOT OPEN,
      JMP CLSLV,I      RETURN.
      JSB PCLOS     CLOSE SLAVE.
      DEF *+3 
      DEF PCB 
      DEF ERROR 
      CLA           CLEAR SLAVE 
      STA SLFLG      FLAG.
      JMP CLSLV,I   RETURN. 
      SPC 4 
* 
*  THESE CONSTANTS ARE USED ONLY FOR MOVE COMMAND.
* 
MB10  OCT -10 
MB67  OCT -67 
MB200 OCT -200
B23   OCT 23
B100  OCT 100 
B104  OCT 104 
B610  OCT 610 
B1100 OCT 1100
NOT77 OCT 177700
MD1   DEC -1
MD28  DEC -28 
MD41  DEC -41 
MD55  DEC -55 
D23   DEC 23
D24   DEC 24
D28   DEC 28
D29   DEC 29
D40   DEC 40
D55   DEC 55
D100  DEC 100 
D200  DEC 200 
SD3   DEF 3,I 
"SMP" ASC 3,SMP 
"SP"  ASC 1,SP
"CC"  ASC 1,CC
SLFLG NOP           SLAVE-OPEN FLAG 
SPFLG NOP           SPOOL FLAG
IPRMP ASC 1,/_      "/" PROMPT FOR FILE MOVE INPUT. 
      SPC 1 
SPMSG ASC 6,SPOOL FILE: 
SPFLN ASC 3,RM<LU><NN>
      SPC 1 
***** SPOOL BUFFER *****
SPBUF DEC 0         NO BATCH INPUT CHECKING 
      NOP 
SPFIL ASC 3,RM<LU><NN>  SPOOLING FILE NAME
      DEC 0         SECURITY CODE 
SPCRN DEC 0         CARTRIDGE 
SPTYP NOP           DEVICE TYPE 
      OCT 402       DISPOSITION: WRITE-ONLY, HOLD OUTPUT. 
      DEC 99        SPOOL PRIORITY
      NOP 
      NOP 
      NOP 
      NOP 
      NOP 
OUTLU NOP           OUTPUT LU.
     UNL
     XIF           *****
     LST
* 
      BSS 0         **** SIZE OF RMOTE **** 
* 
      END RMOTE