         TITLE    'APLUTSC-B00,09/20/73,DWG702985'
         SYSTEM   SIG7F
         SYSTEM   BPM
*
*    REF'S:
         REF      @@CONT
         REF      @@LOAD
         REF      ACCTCHK            ACCOUNT CHECK ROUTINE              18-00001
         REF      BCX              BRANCH THROUGH ROOT TO CX
         REF      BREAKFLG
         REF      CHKTERM           CHECK IF 4013,IF SO SWITCH TO TTY
         REF      CLOSR             CLOSE AND RELEASE
         REF      CLOSV             CLOSE AND SAVE
         REF      CMDB              COMMAND BRANCH VECTOR
         REF      CMDEXIT           COMMAND EXIT
         REF      CMNDTYPE          COMMZND TYPE
         REF      COPYBASE          BASE FOR COPY DB
         REF      COPYHOME          HOME FOR COPY DB
         REF      COPYSIZE          SIZE OF COPY BLOCK
         REF      CURRCS            CURRENT CODESTRING POINTER
         REF      DONTSAVE          ERROR -- NOT SAVED, THIS WS IS ...
         REF      DUMPLINE          OUTPUT ROUTINE
         REF      ERBADCMD          BAD COMMAND EXIT
         REF      ERBADWS           BAD WS EXIT
         REF      ERLIBREF          BAD LIB REF
         REF      ERRFTF            ERROR ROUTINE
         REF      ERRFWS            ERROR ROUTINE
         REF      F:TF              DCB NAME
         REF      F:WS              DCB NAME
         REF      FPARAMS           FILE PARAMETER BUFFER ADDRESS       18-00010
         REF      FPTOPNXT
         REF      FPTOPTF           OPEN TEMP-FILE FPT
         REF      FPTOPWS           OPEN FPT
         REF      FPTOP1ST
         REF      FPTWR2            FPT TO WRITE CONTROL TO 4013
         REF      FPTXCOFF          RESET EXIT CONTROL
         REF      FQTABL            TABLE OF DCB ADDRESSES
         REF      FREETBL           FREE SPACE TABLE
         REF      GRAFBUF           GRAPHICS BUFFER
         REF      HICOMMON
         REF      HOLDFLG           OFF VS HOLD FLAG
         REF      IDBUF             ID BUFFER
         REF      INBUF             INPUT BUFFER
         REF      IMAGE             IMAGE BUFFER
         REF      INTRANS           INPUT TRANSLATE TABLE
         REF      J:ACCN            ACCOUNT #
         REF      KEY1              KEY VALUE 1
         REF      LODYN             LOW DYNAMIC ADDRESS
         REF      NAMEBUF           NAME BUFFER
         REF      NAMEGRN1          GRANULE #,1ST NAME RECORD
         REF      NAMERKEY          NAME RECORD COUNT
         REF      NBIO              NO. OF BLIND IO CHANNELS
         REF      NCMDS             # OF SYSTEM COMMANDS
         REF      NUMFILES           NO. OF FIO CHANNELS                18-00004
         REF      OPWSACTC          ACCOUNT CONTROL
         REF      OPWSACT           ACCOUNT
         REF      OPWSMODE          I/O MODE
         REF      OPWSNAME          NAME
         REF      OPWSPASC          PASSWORD CONTROL
         REF      OPWSPAS           PASSWORD
         REF      OPWSWRTC           WRITE CONTROL PARAMETER            18-00012
         REF      OP1STACC          OPEN 1ST ACCOUNT CONTROL
         REF      OP1STACT          OPEN 1ST ACCT
         REF      OUTORANG
         REF      PRINTFNM          PRINT FILE NAME                     18-00014
         REF      QUIETFLG          =0 IF SAVED MSG TO BE DISPLAYED OR
*                                   =-1 IF NOT (BUT WS MUST BE OK).
         REF      READWS            ROUTINE TO READ WS FROM FILE
         REF      RELCOM            RELEASE COMMON
         REF      RELDYN
         REF      RELEASER          RELEASS UNUSED CORE
         REF      RETURN14          TEMP
         REF      SAVESIX           TEMP SAVE
         REF      SAVE14            TEMP
         REF      TELEXIT           EXIT TO TEL
         REF      TERMKEY           TERMINAL RECORD KEY
         REF      TERMSIZ           TERMINAL RECORD SIZE
         REF      TERMTYPE          TERMINAL TYPE
         REF      TOPOSTAK
         REF      WINDOW            TEMP AREA
         REF      WRITEWS           ROUTINE TO WRITE WS ON FILE
         REF      WSCKDSPL          WORKSPACE CHECKER
         REF      WSIDNAME
         REF      WSIDPASS          WSID PASSWORD
         REF      WSOFFSET          WS OFFSET
         REF      XFF               X'FF'
*    DEF'S:
         DEF      APLUTSC@          MODULE NAME
         DEF      CALOPNXT          CAL'S
         DEF      CALOPTF            DEF'D
         DEF      CALOPTRM          OPEN )TERM FILE
         DEF      CALOPWS1            TO
         DEF      CALOPWS2             ALLOW
         DEF      CALOPWS3              REF
         DEF      CALOPWS4               BY
         DEF      CALOP1ST                ERROR
         DEF      CALRDTF                  ROUTINES
         DEF      CALRDTRM                  IN
         DEF      CALRDWS                    MODULE
         DEF      CALRDWSI                    APLUTSI
         DEF      CALWRTF
         DEF      CALWRWS
         DEF      CLEARWS           MESSAGE
         DEF      CLOSTHIS          CLOSE FILE
         DEF      COPYDMES          ROUTINE TO WRITE SAVED MSG FOR COPY
         DEF      DELAY6            DELAY 6 SECONDS
         DEF      DROPFILE          ROUTINE TO DELETE FILE
         DEF      ERRFWS6           ERROR PROCESSOR
         DEF      FNEQWSID          SET FNAME TO WSID
         DEF      FPTOPTRM          FPT'S
         DEF      FPTRDTRM
         DEF      FPTRDWS
         DEF      GENOPRM           GENERATE OPR MESSAGE
         DEF      GETTERM           GET TERMINAL TRANSLATE TABLES
         DEF      KONTINUE          NAME,'CONTINUE'
         DEF      LIBUTS            UTS INT. FOR )LIB COMMAND
         DEF      LOADREAD          READ A RECORD FOR LOAD
         DEF      OPENSAVE          OPEN F:WS FOR )SAVE
         DEF      RDACTIV           READ ACTIVE WS FOR )COPY
         DEF      RDCOPY            READ FROM F:WS FOR COPY
         DEF      RDCOPYDR          READ COPY DATA RECORD
         DEF      RDNAMER           READ NAME RECORD
         DEF      RDWRLOOP          READ-WRITE LOOP
         DEF      RESACCT           RESET ACCT
         DEF      RESPASS           RESET PASSWORD
         DEF      SAVEDMES          ISSUE SAVED MESSAGE AND EXIT
         DEF      SAVWRITE          WRITE RECORD FOR SAVE
         DEF      SETACCT           SET  ACCOUNT
         DEF      SETFNAME          SET FILE NAME
         DEF      SETPASS           SET PASSWORD
         DEF      TESTACCT          TEST ACCT # VS USERS
         DEF      TESTOLDF          TEST(ON SAVE) IF OLD FILE EXISTS
         DEF      TESTPASS
         DEF      TRYLOAD
         DEF      UTSIOFF           OFF
         DEF      UTSIOFFH          OFF HOLD
         DEF      WRACTIV           WRITE ACTIVE WS FOR )COPY
         DEF      WRCOPYDR          WRITE COPY DATA RECORD
         DEF      WRNAMER           WRITE NAME RECORD
*    STANDARD EQU'S:
*        REGISTERS
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
*
*  MODULE DESCRIPTION:
*
*    THIS IS THE SECOND OF TWO MONITOR INTERFACE MODULES
*      APLUTSI-ROOT UTS INTERFACE MODULE
*      APLUTSC-SPLIT FROM APLUTSI FOR OVERLAY PURPOSES
*              PART OF PATH 1 OVERLAY-HANDLES COMMAND RELATED
*              MONITOR INTERFACES
*
         PAGE
APLUTSC@ CSECT    1
         BOUND    8
APLAPLAP TEXT     'APLAPLAP'        MAGIC WORDS FOR )LIB                18-00019
KONTINUE TEXTC    'CONTINUE'
         BOUND    8
SAYVE    TEXT     ' SAVED  '
         BOUND    8
CLEARWS  TEXTC    'CLEAR WS'
*
*  FPT'S  WHICH CONTAIN NO VARIABLE PARAMETERS EXCEPT VIA INDIRECT
*         ADDRESSING
*
*
* OPEN F:TF TO READ TERMINAL TRANSATION RECORD
*
FPTOPTRM GEN,8,7,17  X'14',0,F:TF   DCB ADDRESS
         DATA     X'C7400001'       P1,2,6,7,8  F12
         DATA     ERRFTF            ERR        (P1)
         DATA     ERRFTF            ABN        (P2)
         DATA     2                 KEYED ORG  (P6)
         DATA     2                 RANDOM ACC (P7)
         DATA     1                 INPUT MODE (P8)
         DATA     2                 SAVE       (P10)
         DATA     X'01000303'
         TEXTC    'APLTRMSB'        NAME (CHANGED BETWEEN A01 AND B00)
         DATA     X'02000202'
         TEXT     ':SYS    '        ACCOUNT= :SYS
         DATA     X'03010202'
         TEXT     'STRUDEL '        PASSWORD
*
* READ F:TF FOR KEYED RECORD WITH TERMINAL TYPE TRANSLATION TABLE
*
FPTRDTRM GEN,8,7,17  X'10',0,F:TF   DCB ADDRESS
         DATA     X'3C000010'       P3,4,5,6  AND WAIT FLAG
         DATA     TERMBUF           BUFFER WORD ADDRESS
         DATA     TERMSIZ           BUFFER SIZE IN BYTES
         DATA     TERMKEY           ADDRESS OF KEY
         DATA     0                 BYTE DISP.
TERMBUF  EQU      INTRANS           TERMINAL DEPENDANT TABLE START AD.
*
* FPTRDWS-READ A RECORD VIA F:WS FOR )LOAD OR )COPY
*
FPTRDWS  GEN,8,7,17  X'10',0,F:WS   DCB ADDRESS
         DATA     X'FC000010'       P1 TO P6 AND WAIT
         DATA     ERRFWS            ERR (P1)
         DATA     ERRFWS            ABN (P2)
         GEN,1,31 1,R11             BUF (P3)
         GEN,1,31 1,R10             SIZ (P4)
         DATA     FWSKEY            KEY (P5)
         DATA     0                 BTD (P6)
*
* FPTRDTF-READ SEQUENTIAL RECORD VIA F:TF FOR )COPY
*
FPTRDTF  GEN,8,7,17  X'10',0,F:TF   DCB ADDRESS
         DATA     X'F4000010'       P1 TO P4,P6 AND WAIT
         DATA     ERRFTF            ERR (P1)
         DATA     ERRFTF            ABN (P2)
         GEN,1,31 1,R11             BUF (P3)
         GEN,1,31 1,R10             SIZ (P4)
         DATA     0                 BTD (P6)
*
* FPTWRWS-WRITE RECORD VIA F:WS,FOR )SAVE  OR )CONTINUE
*
FPTWRWS  GEN,8,7,17  X'11',0,F:WS   DCB ADDRESS
         DATA     X'FC000030'       P1 TO P6, NEWKEY, AND WAIT
         DATA     ERRFWS            ERR  (P1)
         DATA     ERRFWS            ABN  (P2)
         GEN,1,31 1,R11             BUF  (P3)
         DATA     2048              SIZ  (P4)
         DATA     FWSKEY            KEY  (P5)
         DATA     0                 BTD  (P6)
FWSKEY   EQU      RETURN14          TEMP FOR KEY ADDR
*
* FPTWRTF-WRITE RECORD VIA F:TF  FOR )COPY
*
FPTWRTF  GEN,8,7,17  X'11',0,F:TF   DCB ADDRESS
         DATA     X'F4000010'       P1 TO P4,P6 AND WAIT
         DATA     ERRFTF            ERR (P1)
         DATA     ERRFTF            ABN (P2)
         GEN,1,31 1,R11             BUF (P3)
         GEN,1,31 1,R10             SIZ  (P4)
         DATA     0                 BTD (P6)
*
* FPTREWTF- REWIND(THAT IS, GO TO BOF) TFILE OPEN ON F:TF
*
FPTREWTF GEN,8,7,17  X'01',0,F:TF
*
* FPTPREC-BKCK UP ON TFILE FOR )COPY
*
FPTPREC  GEN,8,7,17  X'1D',0,F:TF
         DATA     X'80000010'       P1 AND REVERSE SKIP
         GEN,1,31 1,NAMEGRN1         # OF RECORD TO SKIP IN NAMEGRN1
*
* FPTOFF-EXIT VIA M:LDTRC-TO 'LOGON',WHICH LOGS OFF
*
FPTOFF   GEN,8,22,2    X'03',0,2    ACCOUNT SPECIFIED
         TEXTC    'LOGON'
         TEXT     ':SYS    '        ACCOUNT
*
* FPTMESG-OPERATOR MESSAGE
*
FPTMESG  DATA     0                 IDENTIFIES 'MESSAGE' CAL
         DATA     X'80000000'       PARAMETER  '
         DATA     IMAGE              ADDRESS OF MESSAGE
         PAGE
*
* GETTERM-ROUTINE TO LOAD NEW SET OF I/O TRANSLATE TABLES
*
*  ON ENTRY,R7=TERMINAL NO.
*
GETTERM  RES      0
         LI,R5    X'1B0F'           ESC-SI
         LI,R6    13                CHECK IF LEAVING
         CW,R6    TERMTYPE           4013
         BNE      GETT2               NO
GETT1    STH,R5   GRAFBUF             YES-SWITCH IT TO TTY MODE
CAL13SW  CAL1,1   FPTWR2
         B        GETT3
GETT2    LI,R5    X'1B0E'           ESC-SO
         CI,R7    13                CHECK IF ENTERING 4013
         BNE      GETT3               NO-PROCEED
CALSET37 CAL1,8   FPTSET37            YES,SET TO TTY37
         B        GETT1                AND SWITCH TO APL MODE
FPTSET37 DATA     X'06000002'         DECLARE TTY 37 TERMINAL
GETT3    LI,R6    3
         STW,R7   TERMKEY           SET KEY
         STB,R6   TERMKEY           AND KEY SIZE
CALOPTRM CAL1,1   FPTOPTRM          OPEN TERMINAL FILE
CALRDTRM CAL1,1   FPTRDTRM           READ RECORD
         XW,R7    TERMTYPE             SET TERMTYPE-GET OLD
         STW,R7   TERMKEY           SAVE OLD
         LI,R5    F:TF
         BAL,R6   CLOSV             CLOSE FILE
         LW,R7    TERMKEY           GET OLD
         B        OUTORANG+1         ISSUE 'WAS' MESSAGE
         PAGE
*
* DELAY6-DELAY 6 SECOND3-USED BY  @OPR
*
DELAY6   RES      0
CALWAIT6 CAL1,8   FPTWAIT6
         B       *R14
FPTWAIT6 DATA     X'0F000005'       5*1.2 SECONDS
         PAGE
*
* GENOPRM-GENERATE OPERATOR MESSAGE INDICATED IN 'IMAGE'
*
GENOPRM  RES      0
CALMESG  CAL1,2   FPTMESG           UTS CALL
         B       *R14
         PAGE
         PAGE
*
*  ROUTINES TO SET-UP AND EXECUTE OPS ON F:WS FOR
*                 )SAVE
*                 )LOAD
*                 )COPY OR )PCOPY
*                 )CONTINUE OR AUTOMATIC CONTINUE
*
* RESACCT- RESET ACCOUNT
*
*   R14=LINK   R4-R5 USED
*
RESACCT  LI,R4    2                 RESET ACCOUNT CONTROL
         LI,R5    0
         STB,R5   OPWSACTC,R4
         LW,R4    J:ACCN
         LW,R5    J:ACCN+1
         STD,R4   OPWSACT           SET ACCOUNT TO USERS ACCOUNT
         B       *R14               EXIT
*
* RESPASS- RESET PASSWORD
*
*   R14=LINK, R4-R5 USED
*
RESPASS  LI,R4    2                 RESET PASSWORD CONTROL
         LI,R5    0
         STB,R5   OPWSPASC,R4
         STD,R5   OPWSPAS           ZERO THE VALUE
         B       *R14
*
*  SETACCT-SET ACCOUNT CONTROL AND VALUE
*
*  R14= LINK, R4 AND R5 USED
*
SETACCT  LD,R4    NAMEBUF           SET ACCOUNT- 8 CHARS-TRAILING BLANKS
         STD,R4   OPWSACT
         LI,R4    2                 AND ACCOUNT CONTROL
         STB,R4   OPWSACTC,R4
         B       *R14               EXIT
*
* SETFNAME-MOVE FILENAME FROM NAMEBUF TO OPWSNAME & CONVERT TO TEXTC
*
*
* R14=LINK,  R4 AND R5 USED
*
*   ON ENTRY, R5=BYTE COUNT
*
         LOCAL    SETEXTC
SETFNAME CI,R5    11                SET FILE NAME IN OPWSNAME
         BLE      SETEXTC
         LI,R5    11                MAX 11 CHARS USED
SETEXTC  STB,R5   OPWSNAME          SET BYTE COUNT  (TEXTC FORM)
         LW,R5    MBSNAME           SET UP TO MOVE 11 BYTES
         LI,R4    BA(NAMEBUF)        FROM BA(NAMEBUF) TO
         MBS,R4   0                   BA(OPWSNAME)+1
         B       *R14               EXIT
MBSNAME  DATA     X'0B000001'+BA(OPWSNAME)
*
* SETPASS-SET PASSWORD CONTROL AND VALUE
*
*  R14=LINK  R4,R5 USED
*
SETPASS  LD,R4    NAMEBUF           GET PASS WORD
         STD,R4   OPWSPAS
         LI,R4    2                 SET PASSWORD CONTROL
         STB,R4   OPWSPASC,R4
         B       *R14               RETURN
*
* TESTACCT-TEST IF ACCOUNT NOT USERS-QUIT IF NOT
*
*
*  R14=LINK   R12,R13 USED
*
TESTACCT LW,R13   OPWSACTC
         CI,R13   X'FF00'
         BAZ     *R14               ACCT NOT SPECIFIED-NO SWEAT
         LW,R12   J:ACCN
         LW,R13   J:ACCN+1          CHECK USERS ACCT
         CD,R12   OPWSACT
         BE      *R14               OK
         B        ERLIBREF          NO DICE
*
* TEST IF PASSWORD SET-QUIT IF YES
*
* R14=LINK  R13 USED
*
*
TESTPASS LW,R13   OPWSPASC          CHECK IF PASSWORD SET
         CI,R13   X'FF00'
         BAZ     *R14               NO
         B        ERBADCMD          YES-ERROR
*
* TESTOLDF-CHECKS IF FILE EXISTS WITH INDICATED ID
*          OK IF NOT
*          IF SO,CHECKS FURTHER FOR VALIDITY OF SAVE COMMAND
*  R14=LINK   R5,R6,R7 USED.  IF ERROR EXIT, R8,R9 ALSO USED
*
*
TESTOLDF LI,R6    1
         STW,R6   OPWSMODE          SET INPUT MODE
CALOPWS1 CAL1,1   FPTOPWS            AND OPEN
         LI,R5    F:WS                OLD FILE EXISTS-CHECK COMMAND
         BAL,R6   CLOSV                VALIDITY
         LD,R6    OPWSNAME
         CD,R6    WSIDNAME
         BNE      QCONTINU          NOT WSID-CHECK CONTINUE
         LW,R6    OPWSNAME+2
         CW,R6    WSIDNAME+2
         BE      *R14               NAME MATCHES WSID- SAVE OVER-OK
         B        DONTSAVE          NO MATCH, DON'T SAVE.
SAVEXIT  LW,R6    CMNDTYPE          CHECK COMMAND
         AI,R6    NCMDS+CMDB-@@CONT  VS CONTINUE(HOLD)
         BNE      QLOAD              NO
         MTW,0    HOLDFLG              YES-CHECK HOLD VS OFF
         BEZ      UTSIOFF
         B        UTSIOFFH
QCONTINU CD,R6    KONTINUE          CHECK  '8CONTINU'
         BNE      DONTSAVE           NOPE-NO SAVE
         B       *R14                YES-CHANCE IT
QLOAD    AI,R6    @@CONT-@@LOAD     CHECK COMMAND VS LOAD
         BNE      CMDEXIT            NO-CAN'T BE AUTOSTART
         LW,R6    CURRCS              CHECK FOR AUTOSTART
         BEZ      CMDEXIT              NO
         BAL,R15  BCX                  YES-- AND AWAY WE GO ---
*
* OPENSAVE  OPEN  F:WS IN OUTPUT MODE FOR SAVE
*
*  R14=LINK  R13 USED
*
OPENSAVE LI,R13   2                 SET OUT MODE
         STW,R13  OPWSMODE
CALOPWS2 CAL1,1   FPTOPWS           OPEN
         B       *R14
*
* SAVWRITE-WRITE A 'SAVE' RECORD VIA F:WS
*
*  R7=LINK  R11=BUFFER ADDRESS(WA)  R12=KEY
*            SIZE IS FIXED-512 WORDS (2048 BYTES)
*
SAVWRITE STW,R12  FWSKEY            SAVE KEY (CAN'T BE IN REGISTER)
CALWRWS  CAL1,1   FPTWRWS            WRITE RECORD
         B        0,R7               RETURN
*
* CPYWRITE-WRITE A WS RECORD VIA F:TF FOR )COPY
*
*    R7=LINK   R11=BUFFER ADDRESS(WA)
*        SIZE IN R10 (BYTES)
*
CPYWRITE RES      0
CALWRTF  CAL1,1   FPTWRTF            WRITE RECORD
         B        0,R7                RETURN
*
* SAVEDMES-ISSUE 'SAVED' MESSAGE AND TAKE COMMAND EXIT
*
COPYDMES LI,R2    0
         B        COPYEXIT          SET OFFSET TO ZERO
SAVEDMES LW,R1    LODYN             SET R1 FOR SAVE OR LOAD
COPYEXIT BAL,R14   WSCKDSPL         CHECK OUT THE WORKSPACE
         B        LCI3               OK-CONTINUE
LCI16    LCI      0                 ERROR RETURN
         STM,R0   INBUF+40           SAVE REGISTERS
LCI3     LCI      3
         LM,R3    OPWSNAME          GET NAME (+BLANKS)
         LD,R6    SAYVE              AND ' SAVED  '
         LCI      4                 GET TIME-DATE
         LM,R8    8,R1
         LCI      9
         STM,R3   IMAGE             SET UP IMAGE
         LI,R9    X'40'
         STB,R9   IMAGE             SET INITIAL BLANK
         CI,R14   LCI16             IS WS OK...
         BE       SAVEMESS            NO, DIS PLAY SAVED MSG.
         LW,R3    QUIETFLG            YES, CK QUIET-FLAG...
         BNEZ     SAVEXIT               = -1 -- EXIT NOW.
SAVEMESS LI,R3    36                DISPLAY SAVED MSG.
         BAL,R12  DUMPLINE
         CI,R14   LCI16             WAS WS OK...
         BNE      SAVEXIT             YES -- NORMAL EXIT.
         LCI      0                   NO -- ERROR EXIT AFTER REGS RESET.
         LM,R0    INBUF+40
         B        ERBADWS
*
* FNEQWSID-SET FUNCT NAME WITH WSID
*
*   R14=LINK, R4 TO R10 MAY BE USED
*
*   IF WS IS CLEAR,(IN NAME), TAKES DONTSAVE EXIT
*   IF WSID HAS NO PASSWORD, EXITS VIA RESPASS
*   IF WSID HAS PASSWORD, EXITS VIA SETPASS
*
FNEQWSID LCI      3
         LM,R6    WSIDNAME          GET WSID
         STM,R6   OPWSNAME           PUT IN FPT
         CD,R6    CLEARWS           CHECK IF 'CLEAR'
         BE       DONTSAVE           YES-NO SAVE
         LD,R4    WSIDPASS              GET WSID PASSWORD
         BEZ      RESPASS
         B        SETPASS+1
         PAGE
*
* TRYLOAD-TRY TO OPEN FILE FOR LOAD (OR COPY)
*
* R14=LINK
*
*   ROUTINE OPENS FILE AND READS ID RECORD.
*       IF NO SUCCESSFUL OPEN OR ID RECORD DOES NOT
*       INDICATE A VALID WS, ERROR EXIT IS TAKEN
*
TRYLOAD  LI,R6    1
         STW,R6   OPWSMODE          SET INPUT MODE AND OPEN
         LI,R5    F:WS              (USED BY CLOSV)
         LI,R6    ERLIBREF           EXIT FROM CLOSV
CALOPWS3 CAL1,1   FPTOPWS           TRY TO OPEN
         LW,R10   KEY1
         STW,R10  FWSKEY
         LI,R10   IDRECSIZ          SIZE-(DELIBERATELY SML)
         LI,R11   IDBUF             BUFFER ADDRESS
CALRDWSI CAL1,1   FPTRDWS           READ ID RECORD
         B        CLOSV              NOT ABNORMAL-WRONG!
IDRECSIZ EQU      64                ID RECORD SIZE-16 WORDS
*
* LOADREAD-READ A RECORD FOR )LOAD OR )COPY
*
*  R14=LINK,R11=BUFFER ADDRESS,R12=KEY
*             R10=SIZE IN BYTES
*
LOADREAD STW,R12 FWSKEY
CALRDWS  CAL1,1   FPTRDWS           READ RECORD
         B       *R14
*
*  COPYREAD-READ A SEQUENTIAL RECORD FOR )COPY VIA F:TF
*
*   R14=LINK,R11=BUFFER ADDRESS (WA)
*           R10=SIZE IN BYTES
COPYREAD RES      0
CALRDTF  CAL1,1   FPTRDTF
         B       *R14
         PAGE
*
* RDCOPY-ROUTINE TO READ RECORDS FROM F:WS FOR )COPY
*
*  R14=LINK   FREETBL=BUFFER ADDRESS    COPYSIZE=# OF WORDS TO BE READ
*
* R2 AND R5 THROUGH R12 USED-NOT SAVED
*
*   IF,AS IS PROBABLY THE CASE, A 'SHORT' RECORD IS READ, ERRFWS6 WILL
*      BE REACHED FROM ERRFWS
*
* MOST OF WORK IS DONE BY RDWRCOPY-COMMON TO RDCOPYDR,WRCOPYDR,RDCOPY
*
RDCOPY   LW,R11   FREETBL           BUFFER ADDRESS
         LW,R12   KEY1               FIRST KEY
         LI,R2    LOADREAD          READ VIA F:WS
         B        RDWRCOPY
*
*  WRACTIV-WRITE ACTIVE WS ON TEMP FILE FOR  )COPY
*
*  R14=LINK
*
*  REGISTERS R2 THROUGH R14 USED-NOT SAVED
*
*  WRITES SEQUENTIAL RECORDS:
*        STARTS WITH RECORD # 1
*
*        SAVES FIRST 6 PARAMETERS FOR ACTIVE WS
*        AND SETS NAMEGRN1=0 TO INDICATE NO NAME RECORDS IN FILE
*
WRACTIV  STW,R14  SAVE14            SAVE R14
CALOPTF  CAL1,1   FPTOPTF            OPEN TFILE-OUTIN MODE-SEQUENTIAL
         BAL,R11  RELEASER            RELEASE UNUSED CORE
         LI,R2    CPYWRITE-SAVWRITE SET TO CALL CPYWRITE
         BAL,R14  WRITEWS            WRITE ACTIVE WS
         LCI      6
         LM,R6   *LODYN
         STM,R6   SAVESIX           SAVE FIRST 6 WS PARAMETERS
RESNAMRC LI,R12   0
         STW,R12  NAMEGRN1          INDICATE NO NAME RECORDS PRESENT
         B       *SAVE14            RETURN
*
* RDACTIV-READ ACTIVE WS FROM TFILE FOR )COPY
*
*  R14=LINK
*
*  REGISTERS R1 TO R14 USED-NOT SAVED
*
RDACTIV  STW,R14  SAVE14            SAVE R14
CALREWTF CAL1,1   FPTREWTF          POSITION TO BEGINNING OF FILE
         LI,R2    COPYREAD-LOADREAD SET UP FOR COPY-READ
         LI,R4    0
         STW,R4   WSOFFSET             RESET WS OFFSET
         LI,R4    SAVESIX           ADDRESS OF WS PARAMETERS
         BAL,R14  READWS            READ WS
         B        RESNAMRC          SET FLAG NOT TO BACK-FILE ON NAMERS
*
* RDNAMER-
* WRNAMER-
*          SHARED ROUTINE
*            FOR RDNAMER, READS NAME RECORD-512 WORDS-VIA WINDOW
*            FOR WRNAMER,WRITES NAME RECORD-512 WORDS-VIA WINDOW
*
*   R14=LINK  R2,R7,R10,R11,R12 USED-NOT SAVED
*       NAMERKEY=NAME RECORD #  0-K    INCREMENTED BY RDNAMER-WRNAMER
*       NAMEGRAN1=GRANULE # FOR 1ST NAME RECORD
*
WRNAMER  LW,R7    R14               SET EXIT FROM CPYWRITE
         LI,R2    CPYWRITE           SET I/O FUNCTION
         B        NAMER1
RDNAMER  LI,R2    COPYREAD          SET I/O FUNCTION
NAMER1   LW,R11   NAMERKEY          CHECK IF FIRST NAME RECORD OF SET
         BNEZ     NAMER2             NO
         LW,R10   NAMEGRN1            YES-CHECK IF PRIOR NAME RECORDS
         BEZ      NAMER2               NO-FILE POSITIONING NOT NEEDED
CALPREC  CAL1,1   FPTPREC           BACK UP 'NAMEGRN1' RECORDS
         STW,R11  NAMEGRN1           RESET 'NAMEGRN1' TO ZERO
NAMER2   LI,R11   WINDOW             SET BUF
         LI,R10   2048               SET SIZ
         MTW,1    NAMEGRN1          INCREMENT UTSC NAME RECORD COUNT
         MTW,1    NAMERKEY          INCREMENT NAME RECORD COUNT
         B        0,R2               DO I/O AND RETURN
*
* RDCOPYDR-READ COPY DATA 'RECORD' (ACTUALLY MAY BE SEVERAL RECORDS
*
*  R14=LINK   COPYSIZE=# OF WORDS  COPYHOME=1ST ADDRESS
*
*   CLOSE  F:TF AFTER READ
*
*   MOST REGISTERS USED, NONE SAVED
*
*   ROUTINE RDWRCOPY DOES MOST OF WORK
*
RDCOPYDR LW,R11   COPYHOME          ADDRESS
         LI,R2    COPYREAD           TYPE OF OPERATION
         B        RDWRCOPY
*
* WRCOPYDR-WRITE COPY 'DATA RECORD' (ACTUALLY MAY BE SEVERAL RECORDS)
*
*  R14=LINK  COPYSIZE=# OF WORDS  COPYBASE=1ST ADDRESS
*
*  MOST REGISTERS USED,NONE SAVED
*
*
WRCOPYDR LW,R11   COPYBASE          ADDRESS
         LI,R2    CPYWRITE           TYPE OF OPERATION
         LI,R7    RDWRLOOP            EXIT FROM CPYWRITE
RDWRCOPY STW,R14  SAVE14            SAVE R14
         LI,R14   RDWRLOOP           EXIT FROM LOADREAD OR COPYREAD
         LW,R9    COPYSIZE          SIZE (WORDS)
         LI,R10   2048               PHYSICAL RECORD SIZE
RDWRCHSZ CI,R9    512               CHECK SIZE
         BGE      0,R2               FULL RECORD-READ OR WRITE
         AI,R9    0
         BLEZ     RDWREXIT          DONE-EXIT
         LW,R10   R9
         SLS,R10  2                 SHORT RECORD
         B        0,R2               READ OR WRITE
RDWRLOOP AI,R11   512               KICK ADDRESS
         AI,R9    -512              REDUCE SIZE
         AI,R12   1                  INCREMENT GRANULE # OR KEY
         B        RDWRCHSZ          CONTINUE
RDWREXIT CI,R2    CPYWRITE          CHECK IF COPY WRITE
         BE      *SAVE14             YES-EXIT
ERRFWS6  LI,R5    F:WS              (REACHED BY RDWREXIT OR FROM ERRFWS)
         LW,R6    SAVE14
         CI,R2    LOADREAD          CHECK IF READ OF F:WS FOR COPY
         BE       CLOSV              YES-CLOSE AND SAVE AND EXIT
         LI,R5    F:TF               NO-READ OF F:TF FOR COPY
         B        CLOSR               CLOSE AND RELEASE AND EXIT
         PAGE
*
* DROPFILE-DELETE INDICATED FILE
*
*  R14=LINK  R5,R6,R7 VOLATILE
*
*            IF FILE NOT FOUND-ERROR EXIT
*
DROPFILE LI,R6    1
         STW,R6   OPWSMODE
CALOPWS4 CAL1,1   FPTOPWS
         LI,R5    F:WS
         BAL,R6   CLOSR
         B       *R14
         PAGE
*
* LIBUTS-UTS INTERFACE FOR )LIB COMMAND-WHICH IS ESSENTALLY ALL A
*           UTS INTERFACE OPERATION
*    MUCH OF WORK IS DONE BY ERRFTF1 AND PRINTFMN,IN APLUTSI
*            ERROR HANDLERS,SINCE )LIB OUTPUT IS GENERATED BY
*            DELIBERATE 'ABNORMAL' OPENS AND READS
*
*     EXIT IS FROM ERROP1ST TO CMDEXIT
*
LIBUTS   RES      0
         LI,R5    0                 PRESET 'NO' ACCOUNT
         CI,R2    X'15'              CHECK  CR
         BE       S1STACC             YES
         BAL,R14  ACCTCHK            GET ACCOUNT                        18-00006
         LD,R4    NAMEBUF              YES
         STD,R4   OP1STACT          SET ACCOUNT
         LI,R5    2                 SET ACCOUNT CONTROL
S1STACC  LI,R4    2
         STB,R5   OP1STACC,R4
CALOP1ST CAL1,1   FPTOP1ST          OPEN 1ST FILE IN ACCOUNT.
         B        CHKWRACT                                              18-00021
CLOSTHIS LI,R5    F:TF              CLOSE DCB (IF OPEN)
         BAL,R6   CLOSV
         LW,R6    BREAKFLG          CHECK BREAK
         BNEZ     CMDEXIT            YES-EXIT
CALOPNXT CAL1,1   FPTOPNXT          OPEN-'NEXT' FILE
CHKWRACT LI,R5    FPARAMS           SET TO SEARCH FPARAMS               18-00023
CHKWR1   LW,R6    0,R5              GET KEYWORD                         18-00024
         CW,R6    WRTCHKNE          CHECK FOR WRITE ACCT-4 WORDS
         BE       CHKWRAPL           (NOT LAST FILE PARAM)
         CW,R6    OPWSWRTC           CHECK FOR WRITE ACCT-4 WORDS       18-00025
         BNE      CHKWR2              NO                                18-00026
CHKWRAPL LW,R7    4,R5              YES-GET 3RD AND 4TH WORDS
         LW,R6    3,R5                                                  18-00028
         CD,R6    APLAPLAP          CHECK IF APLAPLAP                   18-00029
         BNE      CLOSTHIS            NO-NOT WS                         18-00030
         B        PRINTFNM            YES-ASSUME WS                     18-00031
WRTCHKNE DATA     X'06000404'       4-WORD WRITE ACCTS-NOT LAST PARAM
CHKWR2   CI,R6    X'10000'          CHECK IF LAST KEYWORD               18-00032
         BANZ     CLOSTHIS            YES-GO TO NEXT FILE               18-00033
         AND,R6   XFF                 NO-GET WORD COUNT                 18-00034
         AW,R5    R6                     MOVE POINTER                   18-00035
         AI,R5    1                                                     18-00036
         B        CHKWR1                  AND LOOP                      18-00037
         PAGE
*
* UTSIOFF AND UTSIOFFH   EXITS
*
UTSIOFFH RES      0                 OFF-HOLD
         BAL,R14  CLOSFILS          CLOSE BLIND I/O FILES
         B        TELEXIT           RETURN TO TEL
UTSIOFF  RES      0
         BAL,R14  CLOSFILS          CLOSE BLIND I/O FILES
         LW,R12   LODYN
         BAL,R14  RELDYN            RELEASE ALL 'DYNAMIC'
         LW,R14   HICOMMON
         AI,R14   1
         STW,R14  TOPOSTAK          RELEASE ALL 'COMMON'
         BAL,R14  RELCOM
CALXCRES CAL1,8   FPTXCOFF          RESET EXIT CONTROL
         BAL,R15  CHKTERM           CHECK IF 4013,IF SO,SWITCH
CALOFF   CAL1,8   FPTOFF            EXIT-ALL THE WA-A-A-Y!
*
* CLOSFILS-CLOSE BLIND I/O DCB'S WITH SAVE,PRIOR TO EXIT FROM APL
*
CLOSFILS LI,R4    NBIO+NUMFILES     SET LOOP FOR TABLE SEARCH
         LW,R5    FQTABL-2,R4       GET DCB ADDRESS
         BAL,R6   CLOSV               CLOSE AND SAVE (IF OPEN)
         BDR,R4   CLOSFILS+1           LOOP
         B       *R14
         END

