TITLE    'APLUTSI-B00,10/16/73,DWG702985'
         SYSTEM   SIG7F
         SYSTEM   BPM
*
*    REF'S:
         REF      @CLEAR
         REF      @@CLEAR
         REF      @@CONT
         REF      @@SAVE
         REF      APLSINON          APL'S SIGN-ON MESSAGE.
         REF      BITPOS            TABLE OF WORDS WITH SINGLE 1-BIT
         REF      CALOPNXT          CAL'S
         REF      CALOPTF             IN
         REF      CALOPTRM          OPEN )TERM FILE
         REF      CALOPWS1             MODULE
         REF      CALOPWS2              APLUTSC
         REF      CALOPWS3
         REF      CALOPWS4
         REF      CALOP1ST
         REF      CALRDTF
         REF      CALRDTRM
         REF      CALRDWS
         REF      CALRDWSI
         REF      CALWRTF
         REF      CALWRWS
         REF      CLOSTHIS          CLOSE FILE
         REF      CMDB              COMMAND BRANCH VECTOR
         REF      CMDERR            COMMAND ERROR
         REF      CMDEXIT           COMMAND EXIT
         REF      CURRCS            CURRENT CODESTRING PTR.
         REF      DIVZERO           EXEC MOD CHECK FOR SPEC. VALID DIV
         REF      DREF              DEREFERENCER.
         REF      DUMPLING          LINE OUTPUT ROUTINE
         REF      ERBADCMD          BAD COMMAND EXIT
         REF      ERDOMAIN          DOMAIN ERRER
         REF      ERRFTFIO          FIO SUBSYSTEM ERROR HANDLER
         REF      ERRFWS6           ERROR PROCESSOR
         REF      FIOERR            FIO MONITOR ERROR
         REF      FPTOPTRM          FPT'S
         REF      FPTRDTRM           IN MODULE
         REF      FPTRDWS             APLUTSC
         REF      FPTWR2            FPT TO WRITE CONTROL TO 4013
         REF      FREETBL           FREE SPACE TABLE
         REF      FREETOTL          TOTAL FREE SPACE
         REF      GARBCOLL          GARBAGE COLLECT ROUTINE
         REF      GENTEXT           TEXT GENERATOR ROUTINE
         REF      IDBUF             ID BUFFER
         REF      IDFILBSY          ERROR I.D. FOR:  FILE IN USE
         REF      IDFILREF                           BAD FILE REF
         REF      IDWSNOTF                           WS NOT FOUND
         REF      IDIOERR                            I/O ERR
         REF      IDFILSPC                           FILE SPACE TOO LOW
         REF      J:ACCN            ACCOUNT #
         REF      J:DELTAT          C
         REF      J:IDELTAT          P
         REF      J:PTIME             U
         REF      J:UTIME              TIME
         REF      J:JIT
         REF      LOADCONT          LOAD CONTINUE WS ON START-UP.
         REF      M:UC              USERS CONSOLE DCB-USED FOR TABS
         REF      NCMDS             # OF SYSTEM COMMANDS
         REF      NEWBOUND          NEW DYNAMIC BOUND
        REF      OPBREAK           BREAK IN OPERATOR
         REF      QUIETFLG          QUIET FLAG
         REF      RANKARR           ARRAY RANK
         REF      RDWRLOOP          READ-WRITE LOOP
         REF      RESACCT           RESET ACCT  TO USERS ACCT.
         REF      SAVEOPEN          OPEN FOR SAVE
         REF      SAVE312           SAVE TEMP
         REF      TABPNTR           TAB POINTER
         REF      TENSTBL           POWERS OF 10 (FIXED POINT)
         REF      UTSIOFF           FULL EXIT.
         REF      UTSIOFFH          OFF-HOLD EXIT
        REF      XSEGBRK           XSEG BREAK FLAG,SET=OPBREAK
         REF      XWLOCGLB          EXCHANGES LOCALS & GLOBALS.
         REF      X1FFFF
*
* REF'S TO MODULE ORIGINS
*
         REF      ACQCONS@          APLC1
         REF      CONSTS@           APLC2
         REF      CONTEXT@          APLC3
         REF      CS@               APLC4
         REF      INTRINS@          APLC5
         REF      WMAQ@             APLC6
         REF      LIB@              APLC7
         REF      OPR@              APLC8
         REF      MIX@              APLC9
         REF      INDX@              APLC10
         REF      EVAL@             APLC11
         REF      APLINP@           APLC12
         REF      APLOUT@           APLC13
*        REF      APLUTSI@          APLC14
         REF      FUNDEF@           APLC15
         REF      WSCOPY@           APLC16
         REF      CMD@              APLC17
         REF      APLUTSC@          APLC18
         REF      CODEXEQ@          APLC19
         REF      APLFIO@           APLC20
         REF      APLFMT@           APLC21
         REF      MAT@              APLC22
         REF      RCMD@             APLC23
         REF      SCMD@             APLC24
         REF      ERROR@            APLC25
         REF      GRAF@             APLC26
         REF      UTSG@             APLC27
*    DEF'S:
         DEF      APLSIZ            TERMINAL INPUT RECORD MAX SIZE
         DEF      APLUTSI@          START OF PROCEDURE
         DEF      APLUTSI0          START OF CONTEXT
         DEF      APLVERSN          VERSION NAME
         DEF      BCDTIME           TIME AND DATE
         DEF      BLINBUF           BLIND INPUT BUFFER.
         DEF      BLINDOUT          BLIND OUTPUT ROUTINE
         DEF      BREAKFLG          USER BREAK FLAG
         DEF      BSPFLAG           BACKSPACE VALIDITY FLAG
         DEF      CALTABS           CAL TO SET TABS
         DEF      CALTIME           GET TIME
         DEF      CALWROUT          APL WRITE OUTPUT RECORD
         DEF      CHKTERM           CHECK IF 4013 TERMINAL
         DEF      CLEARCOM          RELEASE COMMON TO CLEAR STATE
         DEF      CLEARDYN          RELEASE DYNAMIC TO CLEAR STATE
         DEF      CLEARMEM          CLEAR WS MEMORY TO MINIMUM
         DEF      CLEARSIZ          SIZE OF 'CLEAR' TABLE
         DEF      CLOSV             CLOSE AND SAVE
         DEF      CLOSR             CLOSE AND RELEASE
         DEF      CMNDTYPE          COMMAND TYPE
         DEF      COMPRMST          TABLE OF COMMON PARAMETERS
         DEF      CONSTBUF          BLK TO HOLD NOS. ACQUIRED FOR A
*                                     CONSTANT & CERTAIN CMND PARAMS.
         DEF      CONSTDT           DBLWD TEMP FOR CONSTANT ACQ.
         DEF      CONSTDTX          EXTRA DBLWD TEMP FOR CONSTANT ACQ.
         DEF      CORAVAIL          AVAIL WS CORE (TOTAL)
         DEF      CORLEFT           VARIABLE CORE REMAINING
         DEF      CPUTIME           GET CPU TIME
         DEF      CURRKEYT          CURRENT KEY IN FILE
         DEF      CXDTEMP           DBLWD TEMP FOR CODESTRING XEQ.
         DEF      DATE              GET DATE
         DEF      DELAYER           DELAY SPECIFIED TIME
         DEF      DIGITS
         DEF      DIGRANGE          DIGITS RANGE
         DEF      DWIDTH            DEFAULT PRINT WIDTH
         DEF      DYNBOUND          DYNAMIC BOUND
         DEF      ERBADWS           BAD WS ERROR EXIT
         DEF      ERLIBREF          BAD LIB REF
         DEF      ERRFTF            ERROR ROUTINE, F:TF
         DEF      ERRFWS            ERROR ROUTINE, F:WS
         DEF      ERRORCHR          ERROR SIGNAL CHARACTER
         DEF      EVALTMPS          TEMPS FOR EVAL(APLC11)              U14-0004
         DEF      EWROUTWB  ERROR CALL TO:  WROUTWB
         DEF      EWRTEXTC                  WRTEXTC
         DEF      FDBLOCK           FUNCTION DEFN MODE STORAGE BLOCK.
         DEF      FDTEMPS           FUNCTION DEFN MODE TEMP AREA.
         DEF      FFFFFE00          PAGE BOUND MASK
         DEF      FIOABNT           FIO  INABN MODE FLAG
         DEF      FIOACCC           FIO ACCOUNT CONTROL
         DEF      FIOACCT           FIO ACCOUNT
         DEF      FIOBUF            FIO BUFFER ADDRESS
         DEF      FIODCB            FIO DCB ADDRESS
         DEF      FIODCBNO          FIO DCB NO. IN USE
         DEF      FIODCBT           TABLE OF FIO DCB ADDRESSES
         DEF      FIOKEY            KEY IN USE FOR FIO
         DEF      FIOMODE           FIO  I/O MODE
         DEF      FIONAME           FIO NAME
         DEF      FIOPASC           FIO PASSWORD CONTROL
         DEF      FIOPASS           FIO PASSWORD
         DEF      FIOREADC          FIO READ    CONTROL
         DEF      FIOSIZ            FIO REC SIZE
         DEF      FIOSNC            SERIAL NUMBER CONTROL WORD          U14-0008
         DEF      FIOSN             SERIAL NO. ENTRY FOR PRIVATE PACKS  U14-0009
         DEF      FIOTIE            TABLE OF FIO TIE VALUES             U14-0010
         DEF      FIOWRITC          FIO WRITE   CONTROL
         DEF      FMTMPS            TEMPS FOR DELTAFMT
         DEF      FPARAMS           FILE PARAMETERS
         DEF      FPTOP1ST          OPEN FIRST FILE OF AN ACCOUNT
         DEF      FPTOPFIO          FPT FOR  FIO  OPEN
         DEF      FPTOPNXT          OPEN NEXT FILE OF AN ACCOUNT
         DEF      FPTOPTF           FPT OPEN TEMP FILE
         DEF      FPTOPWS           FPT TO OPEN A FILE
         DEF      FPTRD1ST          READ 1ST RECORD OF A FILE (FOR ID)
         DEF      FPTXCOFF          RESET EXIT CONTROL
         DEF      FQTABL            TABLE OF DCB ADDRESSES
         DEF      FRSTKEYT          FIRST KEY IN FILE
         DEF      FUZZBIT           FUZZ PARAMETERS
         DEF      FUZZCNT
         DEF      FUZZLIMS
         DEF      FUZZMASK
         DEF      GDIGITS           DIGITS SETTING FOR GRAPHICS
         DEF      GETCOM            GET PAGE OF COMMON
         DEF      GETDYN            GET PAGES OF DYNAMIC
         DEF      GETTIME           GET CURRENT TIME AND DATE
         DEF      GRAFBUF           GRAPHICS BUFFER                     U14-0012
         DEF      HICOMMON          HIGHEST VARIABLE CORE ADDRESS
         DEF      HOLDFLG           OFF-HOLD FLAG
         DEF      INBUF             INPUT-OUTPUT BUFFER
         DEF      INDXTMPS          TEMPS FOR INDX(APLC10)              U14-0014
         DEF      INPBLIND
         DEF      INTRANS
         DEF      IOERCODE         MONITOR I/O ERROR CODE-SUBCODE
         DEF      KEY1              KEY VALUE 1
         DEF      LASTKEYT          LAST KEY IN FILE
         DEF      LIBTEMPS          TEMPS FOR LIB(APLC07)               U14-0016
         DEF      LOADCASE          FLAG FOR LOAD CATEGORY
         DEF      LOCOMMON          LOWEST COMMON ADDRESS
         DEF      LODACCT           LOAD ACCOUNT #
         DEF      LODYN             LOWEST VARIABLE CORE ADDRESS
         DEF      LOGONTIM          LOGON TIME (TO APL)
         DEF      MIXTEMPS          TEMPS FOR MIX(APLC09)               U14-0018
         DEF      MODE              EXECUTION MODE
         DEF      NAMEGRN1          GRANULE #-1ST NAME RECORD
         DEF      NBIO              # OF BLIND I/O CHANNELS
         DEF      NCOMPRMS          SIZE OF COMMON PARAMETER TABLE
         DEF      NUMFILES          # OF DCBS FOR  FIO SUBSYSTEM
         DEF      NUMUSERS          GET # OF USERS
         DEF      ON%OFF            ONLIN-OFFLINE MODE FLAG
         DEF      OPRTEMPS          TEMPS FOR OPR(APLC08)               U14-0020
         DEF      OP1STACC          ACCOUNT IN FPTOP1ST
         DEF      OP1STACT          ACCT CONTROL IN FPTOP1ST
         DEF      OPENFN            NAME POINTER TO FORCED CLOSE FN
         DEF      OPER              DBLWD TEMP FOR OPERATOR INFO AND
*                                     SAVING OTHER INFO.
         DEF      OPTEMPS           TEMP AREA FOR OPERATOR WORK AND ALSO
*                                     FOR SAVING OTHER INFO.
         DEF      OPWSACT           WS ACCOUNT
         DEF      OPWSACTC          OPEN FPT-ACT CONTROL
         DEF      OPWSMODE          OPEN FPT MODE (I/O)
         DEF      OPWSNAME          WS NAME FOR 'OPEN'
         DEF      OPWSPAS           OPEN FPT PASSWORD
         DEF      OPWSPASC          OPEN FPT PASSWORD CONTROL
         DEF      OPWSWRTC          WRITE ACCOUNT CONTROL
         DEF      ORGADJ            ORIGIN PARAMETERS
         DEF      ORIGIN
         DEF      OUTMNEMT          OUTPUT MNEMONIC-OVST FLAG TABLE
         DEF      OUTRANST          OUTPUT TRANSLATION TABLE
         DEF      OUTSIZ            SIZE OF OUTPUT RECORD(5)
         DEF      OUTMAXSZ          TERMINAL OUTPUT BLOCKING SIZE
         DEF      OVERTIME          GET OVERHEAD TIME.
         DEF      PCOPYFLG          PROTECTED COPY FLAG
         DEF      PRINTFNM          PRINT FILE NAME
         DEF      QTABVLID          CHECK TAB VALIDITY
         DEF      QUITFLAG          FLAG TO AVOID REPEAT 'CONTINUE'
*                                   ATTEMPTS IN OFF-LINE MODE.
         DEF      RANDOM            RANDOM SEED
         DEF      RDAPL             READ APL INPUT RECORD
         DEF      RELCOM            RELEAS COMMON TO TOPOSTAK
         DEF      RELEASER          RELEASE MEMORY AS INDICATED
         DEF      RELDYN            RELEASE PAGES OF DYNAMIC
         DEF      RETURN14          SHARED TEMP
         DEF      SAVE14            SAVE REGISTER-OR TEMP
         DEF      SETDIGIT          SET DIGITS-GET OLD VALUE
         DEF      SETWIDTH          SET WIDTH-GET OLD VALUE
         DEF      SICTRL            STATE-INDICATOR CONTROL SETTING.
         DEF      SNEWTABS          SET NEW TABS
         DEF      STATEPTR          SI STATE POINTER
         DEF      STKLIMIT          EXECUTION STACK LIMIT
         DEF      SYSTERR           SYSTEM ERROR
         DEF      TABSET            SET NEW TABS-GET OLD VALUES
         DEF      TABVALS           TAB SETTING BUFFER IN FPT
         DEF      TELEXIT           RETURN TO TEL
         DEF      TERMKEY           TERMINAL RECORD KEY
         DEF      TERMSIZ           TERMINAL RECORD SIZE
         DEF      TERMTYPE          TERMINAL TYPE NO.
         DEF      TIMODAY           GET TIME OF DAY
         DEF      TOPOSTAK          TOP OF EXECUTION STACK
         DEF      TRAP
         DEF      USERACCT          USER ACCOUNT
         DEF      WIDRANGE
         DEF      WIDTH
         DEF      WINDOW            A ONE-PAGE SCRATCH AREA.
         DEF      WROUT             APL WRITE OUTPUT RECORD
         DEF      WROUTWB
         DEF      WRTEXTC
         DEF      WSIDNAME          WORKSPACE NAME
         DEF      WSIDPASS          WSID PASSWORD
         DEF      WSOFFSET          WS LOAD OFFSET
         DEF      XFF               MASK
         DEF      XSEGBASE          BASE FOR EXECUTION SEGMENTS.
*    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
*    MEMORY CONTROL PARAMETERS
MINALLOW EQU      2                 MINIMUM 'DYNAMIC' PAGES
MININCR  EQU      1                 MINIMUM INCREMENT
MINANNEX EQU      1                 MINIMUM ANNEX
*
*  BLIND AND FILE I/O CHANNEL ALLOWANCES
*
NBIO     EQU      3                 ]O. OF BLIND I/O CHANNELS+1
NUMFILES EQU      8
*
*
* USERACCT-EQUATED TO  J:ACCN (MONITOR NAME IN JIT TABLE)
*
USERACCT EQU      J:ACCN
*
*  MODULE DESCRIPTION:
*
*        THIS MODULE CONSISTS OF TWO  CSECTS  AND A NUMBER OF DSECTS
*        THE MODULE  CONTAINTS ALL DIRECT MONITOR INTERFACES AND
*        HOPEFULLY ALL MONITOR DEPENDANT CODE.
*
*        THE DSECTS ARE USED TO DEFINE THE DCBS USED BY APL.
*
*        A CSECT 0  INCLUDES THE FIXED CONTEXT FOR APL,PRIMARILY
*        NON-EXECUTABLE TABLES,FLAGSBUFFERS,ETC. THIS CSECT ALSO
*        INCLUDES THE EXECUTABLE INITIALIZATION ROUTINE,WHICH IS
*        VOLATALE,BEING UNNEEDED FOR ANY LATER OPERATIONS.
*        THE CSECT ALSO INCLUDES FPTS WHICH MUST BE VARIED DURING
*        OPERATIONS.
*
*        A CSECT 1  INCLUDES DIRECT MONITOR INTERFACES-CAL'S AND FIXED
*        FPT'S. CALS AND FPTS ARE CLEARLY LABELLED FOR LOCATION VIA
*        CONCORDANCE. THIS CSECT ALSO INCLUDES THOSE PORTIONS OF I/O
*        AND MEMORY MANAGEMENT ROUTINES WHICH ARE MONITOR SENSITIVE
*
         PAGE
*
*    DATA CONTROL BLOCK GENERATION
*
*        THIS SECTION INCLUDES THE PROCEDURES USED TO GENERATE
*        DCBS FOR APL. NO EXECUTABLE CODE IS GENERATED. THE DCBS
*        ARE LOADED  BY UTS IN A SPECIAL AREA. ACCESS IS READ ONLY
*        TO USER,READ-WRITE TO MONITOR.
*
F:APL    DSECT    1                 APL INPUT DCB
F:APL    M:DCB    (FILE,'NAME11CHARS','ACCT8CHR'),(PASS),(KEYM,3),;
                  (INSN),(ERR,ERRFAPL),(ABN,ABNFAPL),(DEVICE,'CR')
         ORG,1    BA(F:APL)+3
         DATA,1   3                 SET DCB TO DEVICE MODE
         ORG      F:APL+26
         DATA     X'02000002'       SET ACCT CONTROL OFF
ABNFAPL  EQU      ERRFAPL           USE SAME ROUTINE FOR ABN & ERR
ERRFAPL  EQU      ERRRDAPL       ** MAY BE CHANGED
*
F:OUT    DSECT    1                 APL OUTPUT DCB
F:OUT    M:DCB    (FILE,'NAME11CHARS','ACCT8CHR'),(PASS),(KEYM,3),;
                  (OUTSN),(ERR,ERRFOUT),(ABN,ABNFOUT),(DEVICE,'LP')
         ORG,1    BA(F:OUT)+3
         DATA,1   3                 SET DCB TO DEVICE MODE
         ORG      F:OUT+26
         DATA     X'02000002'       SET ACCT CONTROL OFF
*
F:WS     DSECT    1                 APL WORKSPACE I/O DCB
F:WS     M:DCB    (FILE,'NAME11CHARS','ACCT8CHR'),(PASS),(KEYM,3),;
                  (INSN),(OUTSN),(ERR,ERRFWS),(ABN,ABNFWS),;
                  (WRITE,'NONE    ','APLAPLAP')
ABNFWS   EQU      ERRFWS
*
F:TF     DSECT    1                 APL TEMP-FILE DCB
F:TF     M:DCB    (FILE),(PASS),(SYNON),(ERR,ERRFTF),(ABN,ABNFTF)
ABNFTF   EQU      ERRFTF
*
*        BLIND I/O DCBS FOLLOW:
*                 NBIO DETERMINES THE NUMBER (0 TO 9) OF DCBS
*                 TO BE CREATED FOR BLIND I/O
*                 DEFAULT IS  NBIO=2
*                 NBIO  ALSO CONTROLS PROCEDURE CODE FOR BLIND I/O
*
         GOTO,NBIO  NOBIO,BIO1,BIO2,BIO3,BIO4,BIO5,BIO6,BIO7,BIO8,BIO9
*
BIO9     SPACE    1
ERRFQ9   EQU      ERRRDQ
ABNFQ9   EQU      ERRRDQ
F:Q9     DSECT    1
F:Q9     M:DCB    (FILE,'NAME11CHARS','ACCT8CHR'),(PASS),(KEYM,3),;
                  (INSN),(OUTSN),(ERR,ERRFQ9),(ABN,ABNFQ9)
BIO8     SPACE    1
ERRFQ8   EQU      ERRRDQ
ABNFQ8   EQU      ERRRDQ
F:Q8     DSECT    1
F:Q8     M:DCB    (FILE,'NAME11CHARS','ACCT8CHR'),(PASS),(KEYM,3),;
                  (INSN),(OUTSN),(ERR,ERRFQ8),(ABN,ABNFQ8)
BIO7     SPACE    1
ERRFQ7   EQU      ERRRDQ
ABNFQ7   EQU      ERRRDQ
F:Q7     DSECT    1
F:Q7     M:DCB    (FILE,'NAME11CHARS','ACCT8CHR'),(PASS),(KEYM,3),;
                  (INSN),(OUTSN),(ERR,ERRFQ7),(ABN,ABNFQ7)
BIO6     SPACE    1
ERRFQ6   EQU      ERRRDQ
ABNFQ6   EQU      ERRRDQ
F:Q6     DSECT    1
F:Q6     M:DCB    (FILE,'NAME11CHARS','ACCT8CHR'),(PASS),(KEYM,3),;
                  (INSN),(OUTSN),(ERR,ERRFQ6),(ABN,ABNFQ6)
BIO5     SPACE    1
ERRFQ5   EQU      ERRRDQ
ABNFQ5   EQU      ERRRDQ
F:Q5     DSECT    1
F:Q5     M:DCB    (FILE,'NAME11CHARS','ACCT8CHR'),(PASS),(KEYM,3),;
                  (INSN),(OUTSN),(ERR,ERRFQ5),(ABN,ABNFQ5)
BIO4     SPACE    1
ERRFQ4   EQU      ERRRDQ
ABNFQ4   EQU      ERRRDQ
F:Q4     DSECT    1
F:Q4     M:DCB    (FILE,'NAME11CHARS','ACCT8CHR'),(PASS),(KEYM,3),;
                  (INSN),(OUTSN),(ERR,ERRFQ4),(ABN,ABNFQ4)
BIO3     SPACE    1
ERRFQ3   EQU      ERRRDQ
ABNFQ3   EQU      ERRRDQ
F:Q3     DSECT    1
F:Q3     M:DCB    (FILE,'NAME11CHARS','ACCT8CHR'),(PASS),(KEYM,3),;
                  (INSN),(OUTSN),(ERR,ERRFQ3),(ABN,ABNFQ3)
BIO2     SPACE    1
ERRFQ2   EQU      ERRRDQ
ABNFQ2   EQU      ERRRDQ
F:Q2     DSECT    1
F:Q2     M:DCB    (FILE,'NAME11CHARS','ACCT8CHR'),(PASS),(KEYM,3),;
                  (INSN),(OUTSN),(ERR,ERRFQ2),(ABN,ABNFQ2)
BIO1     SPACE    1
ERRFQ1   EQU      ERRRDQ
ABNFQ1   EQU      ERRRDQ
F:Q1     DSECT    1
F:Q1     M:DCB    (FILE,'NAME11CHARS','ACCT8CHR'),(PASS),(KEYM,3),;
                  (INSN),(OUTSN),(ERR,ERRFQ1),(ABN,ABNFQ1)
NOBIO    RES      0
*
*        FILE I/O DCBS FOLLOW:
*                 NUMFILES DETERMINES THE NUMBER (0 TO 8) OF DCBS
*                 TO BE CREATED FOR FILE I/O SYSTEM
*                 DEFAULT IS NUMFILES=3
*                 NUMFILES ALSO CONTROLS PROCEDURE CODE FOR FILE I/O
*
         GOTO,NUMFILES+1  NOFIO,FIO1,FIO2,FIO3,FIO4,FIO5,FIO6,FIO7,FIO8
*
FIO8     SPACE    1
F:F8     DSECT    1
F:F8     M:DCB    (FILE,'NAME11CHARS','ACCT8CHR'),(PASS),(KEYM,3),;
                  (INSN),(OUTSN),(READ,'NONE'),(WRITE,'NONE'),;
                  (ERR,ERRFF),(ABN,ABNFF)
FIO7     SPACE    1
F:F7     DSECT    1
F:F7     M:DCB    (FILE,'NAME11CHARS','ACCT8CHR'),(PASS),(KEYM,3),;
                  (INSN),(OUTSN),(READ,'NONE'),(WRITE,'NONE'),;
                  (ERR,ERRFF),(ABN,ABNFF)
FIO6     SPACE    1
F:F6     DSECT    1
F:F6     M:DCB    (FILE,'NAME11CHARS','ACCT8CHR'),(PASS),(KEYM,3),;
                  (INSN),(OUTSN),(READ,'NONE'),(WRITE,'NONE'),;
                  (ERR,ERRFF),(ABN,ABNFF)
FIO5     SPACE    1
F:F5     DSECT    1
F:F5     M:DCB    (FILE,'NAME11CHARS','ACCT8CHR'),(PASS),(KEYM,3),;
                  (INSN),(OUTSN),(READ,'NONE'),(WRITE,'NONE'),;
                  (ERR,ERRFF),(ABN,ABNFF)
FIO4     SPACE    1
F:F4     DSECT    1
F:F4     M:DCB    (FILE,'NAME11CHARS','ACCT8CHR'),(PASS),(KEYM,3),;
                  (INSN),(OUTSN),(READ,'NONE'),(WRITE,'NONE'),;
                  (ERR,ERRFF),(ABN,ABNFF)
FIO3     SPACE    1
F:F3     DSECT    1
F:F3     M:DCB    (FILE,'NAME11CHARS','ACCT8CHR'),(PASS),(KEYM,3),;
                  (INSN),(OUTSN),(READ,'NONE'),(WRITE,'NONE'),;
                  (ERR,ERRFF),(ABN,ABNFF)
FIO2     SPACE    1
F:F2     DSECT    1
F:F2     M:DCB    (FILE,'NAME11CHARS','ACCT8CHR'),(PASS),(KEYM,3),;
                  (INSN),(OUTSN),(READ,'NONE'),(WRITE,'NONE'),;
                  (ERR,ERRFF),(ABN,ABNFF)
FIO1     SPACE    1
F:F1     DSECT    1
F:F1     M:DCB    (FILE,'NAME11CHARS','ACCT8CHR'),(PASS),(KEYM,3),;
                  (INSN),(OUTSN),(READ,'NONE'),(WRITE,'NONE'),;
                  (ERR,ERRFF),(ABN,ABNFF)
NOFIO    RES      0
*
         PAGE
APLUTSI0 CSECT    0
*
*   START-INITIALIZATION ROUTINE-VOLATILE
*         THIS ROUTINE IS ORG'D IN A BUFFER AREA AND IS AVAILABLE
*         ONLY AT INITIALIZATION TIME.
*
*         THE FUNCTIONS PERFORMED ARE THOSE ASSOCIATED WITH INITIAL
*         SETUP FOR APL. IN SUMMARY:
*                 ESTABLISH ON-LINE VS OFFLINE MODE-SET UP DCB'S
*                 AND TERMINAL TYPE ACCORDINGLY
*
*                 SET BREAK AND TRAP CONTROL AND MODES
*
*                 ESTABLISH RANGE OF VARIABLE MEMORY AVAILABLE AND
*                 GET INITIAL PAGES OF MEMORY
*
*                 SET TFILE NAME-UNIQUE TO USER
*
*                 GET 'CONTINUE' OR 'CLEAR' WORKSPACE
*
         LOCAL    OFFLINE,TEMPNAME,TERMKEY4
START    STW,R0   LSPD              SAVE ADDRESS OF STACK POINTER DW
         LD,R2   *LSPD
         STD,R2   ISPD              SAVE INITIAL VALUE OF SPD
         BAL,R14  RESACCT    *BREF* RESET ACCT CONTROL-SET USERS ACCT.
         LFI      0                 RESET FLOATING TRAPS
CALINT   CAL1,8   FPTINT            SET BREAK ROUTINE ADDRESS
CALXCON  CAL1,8   FPTXCON           SET EXIT CONTROL ADDRESS
CALTRAP  CAL1,8   FPTTRAP           SET TRAP ROUTINE ADDRESS
CALMCAC  CAL1,8   FPTMCAC           CHANGE ACTIVATION CHARACTER SET
         LW,R2    J:JIT             GET ON-OFF MODE BIT AND UNIQUE
         BGEZ     OFFLINE            JOB ID
         MTW,1    ON%OFF            SET MODE ONLINE
CALAPLUC CAL1,1   FPTAPLUC          SET F:APL TO USERS CONSOLE
CALOUTUC CAL1,1   FPTOUTUC          SET F:OUT TO USERS CONSOLE
         LI,R1    100
         STW,R1   APLSIZ            SET INPUT RECORD SIZE-ONLINE MODE
         LI,R8    64                  (MUST BE MULTIPLE OF 4)
         STW,R8   OUTMAXSZ          SET MAX SIZE OF F:OUT RECORD
CALQTERM CAL1,8   FPTQTERM           GET TERMINAL TYPE AND COC MODES
         LI,R2    8
         LI,R1    3
QTERM1   LB,R3    R8,R1             SAVE COC MODES FOR
         STH,R3   FPTRSTRM,R2        RESTORING ON EXIT
         AI,R2    -2
         BDR,R1   QTERM1            LOOP
CALSTRMB CAL1,8   FPTSTRMB          SET BS EDIT OFF
         LB,R8    R8                CHECK TERMINAL TYPE ONLY
         CI,R8    6
         BE       CALSTERM          APL-2741-EBCD
         CI,R8    10
         BE       CALSTERM          APL-2741-SELECTRIC
         LI,R5    2
         CI,R8    4
         BE       CALSTRM2          NONAPL-2741-EBCD
         CI,R8    8
         BE       CALSTRM2          NONAPL-2741-SELECTRIC
         LI,R5    3
         LI,R6     72
         STW,R6   DWIDTH            DEFAULT WIDTH=72 FOR TTY
         B         SETTERM
CALSTERM CAL1,8   FPTSETRM          RESET TAB SIM,TAB REL, AND
*                                    SPACE INSERTION
         B        TEMPNAME
CALSTRM2 CAL1,8   FPTSETRM
         B        SETTERM           SET TERMINAL TYPE
OFFLINE  LI,R1    400
         STW,R1   APLSIZ            SET INPUT RECORD SIZE-OFFLINE MODE
         LI,R1    256                OFF-LINE,USE FULL IMAGE RECORDS
         STW,R1   OUTMAXSZ          SET MAX SIZE OF F:OUT RECORD
         LI,R1     X'15'            SET END-OF.-RECORD VALUE TO CR FOR
         STW,R1    EORVAL            OFF-LINE MODE(NO 'LOOK-AHEAD')
         LI,R1    15                MASK
         AND,R1   F:APL              CHECK F:APL
         CI,R1    3                   IF DEVICE,ASSUME CARD READER
         BNE      CALPAGE             NOT DEVICE                        U14-0022
         LI,R1    X'FFFF'            CHECK IF CR                        U14-0023
         AND,R1   F:APL+1                                               U14-0024
         CI,R1    X'C3D9'            'CR'                               U14-0025
         BNE      CALPAGE             NO
         LI,R8    THROWAPL          BUFFER TO THROW OUT !APL CARD
         LI,R9    0                 WHICH IS LEFT FOR FIRST READ
*                                   FOR SHARED PROCESSOR WITH SOURCE
*                                   FROM THE M:C DEVICE (CR)
CALAPLCR CAL1,1   FPTRDAPL          READ THE !APL CARD AND FORGET IT
CALPAGE  CAL1,1   FPTPAGE             PAGE EJECT
         LI,R5    4
SETTERM  STW,R5   TERMTYPE            SET TERMINAL TYPE
         AWM,R5   TERMKEY
CALOPTRI CAL1,1   FPTOPTRM            OPEN TO READ TERMINAL TRANS. REC.
CALRDTRI CAL1,1   FPTRDTRM            READ TRANSLATE TABLES
         LI,R5    F:TF
         BAL,R6   CLOSV             CLOSE AND SAVE  F:TF
TEMPNAME LI,R1    3
         STH,R2   TFNAME,R1         SET UNIQUE JOB ID IN TEMP FILE NAME
CALGDDL  CAL1,8   FPTGDDL           GET MEMORY LIMITS
         STW,R8   LODYN             LOWEST ADDRESS OF DYNAMIC STORAGE
         CI,R10   128
         BLE      WSSIZE            ALLOW UP TO 128 PAGES
         LI,R10   128
WSSIZE   SLS,R10  9
         STW,R10  CORAVAIL          NO. OF WORDS OF CORE AVAILABLE
         AI,R8    -1
         AW,R8    CORAVAIL
         STW,R8   HICOMMON          HIGHEST ADDRESS OF COMMON
         AI,R8    -511
         STW,R8   LOCOMMON          PRESET LOCOMMON-1 PAGE
         LW,R13   R8
CALGCPI  CAL1,8   FPTGVP            GET COMMON PAGE AS VIRTUAL PAGE
         LI,R1    MINALLOW          SET MINIMUM DYNAMIC ALLOWANCE
         LW,R13   LODYN
CALGDPI  CAL1,8   FPTGVP            GET INITIAL DYNAMIC PAGES AS
         AI,R13   512                VIRTUAL PAGES
         BDR,R1   CALGDPI
         STW,R13  HIDYN               SAVE IT
         LW,R13   LOCOMMON          COMPUTE
         SW,R13   HIDYN              CORE
         STW,R13  CORLEFT             LEFT
         BAL,R14  TIMODAY           GET TIME ADL CALLED
         STW,R11  LOGONTIM           SAVE IT
         LI,R8    APLSINON
         BAL,R7   WRTEXTC           SIGN-ON MESSAGE
         LW,R11   J:DELTAT
         SW,R11   J:IDELTAT
         AW,R11   J:PTIME
         AW,R11   J:UTIME
         STW,R11  INITCPU           SAVE INITIAL CPU USAGE.
         LW,R11   J:PTIME+1
         AW,R11   J:UTIME+1
         STW,R11  INITOVH           SAVE INITIAL OVERHEAD USAGE.
         LI,R1    4                 INOUT MODE
         LI,R5    F:WS              (FOR CLOSV)
         LI,R6    BCLEAR             'CLEAR' IF NO VALID AUTO-CONTINUE
         STW,R1   OPWSMODE
CALOPWS5 CAL1,1   FPTOPWS           TRY TO OPEN 'CONTINUE'
         LW,R10   KEY1
         STW,R10  FWSKEY
         LI,R10   2048              512 WORD RECORD
         LW,R11   LODYN             BUFFER
CALRDAC1 CAL1,1   FPTRDWS           READ 1ST RECORD
         LW,R4    LODYN
         LW,R9    6,R4
         CW,R9    APLVERSN          CHECK IF WS
         BNE      CLOSV              NO-)CLEAR
         LW,R9    12,R4             CHECK IF SAVED BY 'CONTINUE'
         AI,R9    NCMDS+CMDB-@@CONT
         BNE      CLOSV             NO-)CLEAR
         LI,R9    @@SAVE-NCMDS-CMDB YES,DAMN IT
         STW,R9   12,R4              SWITCH TO 'SAVED'
CALWRSC1 CAL1,1   FPTWRWS1          WRITE REC 1-INDICATE NOT AUTOSAVE
         BAL,R6   CLOSV
         LI,R6    0                 SET SO SAVED MSG WILL BE DISPLAYED.
         STW,R6   QUIETFLG
         B        LOADCONT          DO A LOAD OF THE CONTINUE WS.
BCLEAR   LI,R6    @@CLEAR-NCMDS-CMDB
         STW,R6   CMNDTYPE          SET 'CLEAR' COMMAND TYPE
         B        @CLEAR            GO TO CLEAR ROUTINE
ERFWSCS0 CI,R8    CALOPWS5+1        CHECK IF OPEN FOR AUTO-CONTINUE
         BE       BCLEAR             YES-)(CLEAR
         CI,R8    CALRDAC1+1        CHECK IF ID-READ FOR AUTO CONTINUE
         BE       CLOSV              YES
         B        IOERR              NO-MYSTERY ERROR
         LOCAL
*
*  FPT'S USED AT INITIALIZATION ONLY
*
*        OPEN F:APL TO 'UC'
*
FPTAPLUC GEN,8,7,17  X'14',0,F:APL  DCB ADDRESS
         DATA     X'00040000'       DEVICE FLAG
         DATA     X'0000E4C3'       'UC'
*
*        OPEN F:OUT TO 'UC'
*
FPTOUTUC GEN,8,7,17  X'14',0,F:OUT  DCB ADDRESS
         DATA     X'00040000'       DEVICE
         DATA     X'0000E4C3'       'UC'
*
*        PAGE EJECT ON F:OUT (OFF-LINE MODE)
*
FPTPAGE  GEN,8,7,17  X'04',0,F:OUT
*
*        GET RANGE OF MEMORY AVAILABLE
*
FPTGDDL  DATA     X'1B000000'
*
*        FREE ALL PAGES-INITIALIZATION ONLY
*
FPTFP    GEN,8,7,17  X'09',0,128
*
*        INTERRUPT CONTROL FPT
*
FPTINT   GEN,8,7,17  X'0E',0,BREAK  ADDRESS OF BREAK ROUTINE
*
*        TRAP CONTROL FPT-IGNORE TRAPS FOR FIXED POINT AND DECIMAL ARITH
*
FPTTRAP  GEN,8,7,17  X'14',0,TRAP   ADDRESS OF TRAP ROUTINE
         DATA     X'003C8003'       TRAP CONTROL BITS
*
* FPTMCAC-CHANGE ACTIVATION CHARACTER SET
*
FPTMCAC  DATA     X'06820000'       CHANGE ACTIVATION TO EOT ONLY
*
*
* FPTWRWS1-REWRITE RE"ORD   1 OF 'CONTINUE' TO INDICATE 'SAVED'
*
FPTWRWS1 GEN,8,7,17  X'11',0,F:WS   DCB ADDRESS
         DATA     X'FC000050'       P'S, WAIT, AND ONEMKEY
         DATA     ERRFWS            ERR
         DATA     ERRFWS            ABN
         GEN,1,31 1,LODYN           BUF
         DATA     2048              SIZ
         DATA     FWSKEY            KEY
         DATA     0                 BTD
FWSKEY   EQU      RETURN14          TEMP FOR KEY ADDR
*
*  FPTSETRM-SETS COC MODES AS INDICATED
*
FPTSETRM DATA     X'06200000'
         DATA     X'E0000000'        P1,2,3
         DATA     8                  RESET TAB SIMULATION
         DATA     X'20'              RESET SPACE INSERTION
         DATA     X'A0'              RESET BS EDIT AND TAB REL.
FPTSTRMB DATA     X'06200000'
         DATA     X'20000000'
         DATA     X'20'             TURN BS EDIT OFF
*
*  FPTQTERM-CHECK TERMINAL TYPE
*
FPTQTERM DATA     X'06400000'
*
* FPTXCON-SET EXIT CONTROL ADDRESS
*
FPTXCON  DATA     X'19000000'+HANGUP     EXIT CONTROL ADDRESS
THROWAPL RES      0                 THROW-AWAY BUFFER FOR !APL CARD
         PAGE
         ORG      START
*
* OVERLAY THE START AREA WITH INBUF,THE APL INPUT-OUTPUT BUFFER
*         NOTE THAT INITIAIZATION PROCESSES MUST NOT USE INBUF
*
         BOUND    8
WINDOW   RES      512               A ONE-PAGE SCRATCH AREA.
 SPACE 3
TLOC     SET      0                 ************************************
TEMP     CNAME    1                 *                                  *
DTEMP    CNAME    2                 *  PROC TO ALLOCATE N WORDS OR     *
         PROC                       *  DOUBLEWORDS IN THE WINDOW AREA. *
         DO       NAME=2            *  EXAMPLE FORMS:                  *
TLOC     SET      ((TLOC+1)/2)*2    *     A  TEMP  1   ONE WORD.       *
         FIN                        *     B  DTEMP 3   THREE DBLWDS.   *
LF       EQU      WINDOW+TLOC       *                                  *
TLOC     SET      TLOC+AF(1)*NAME   *                                  *
         PEND                       ************************************
 SPACE 3
INBUF    DTEMP    65                INPUT(F:APL)-OUTPUT(F:OUT) BUFFER.
BLINBUF  EQU      INBUF             BLIND INPUT BUFFER OF 128 WORDS.
CONSTBUF DTEMP    66                BLK FOR CONST ACQ & CMND PARAMS.
XSEGBASE EQU      CONSTBUF          BASE FOR EXECUTION SEGMENTS.
FMTMPS   EQU      CONSTBUF          TEMPS FOR DELTAFMT
FPARAMS  EQU      CONSTBUF+40       TEMP FOR FILE PARAMETERS
CONSTDT  DTEMP    1                 FOR CONST ACQ.
CONSTDTX DTEMP    1                 FOR CONST ACQ.
CXDTEMP  DTEMP    1                 FOR CODESTRING EXECUTION.
OPTEMPS  TEMP     50                TEMP BLK FOR OPERATOR & INDEXING
*                                     EXECUTION.  CONTAINS, FOR EXAMPLE,
*                                     RSTYPE, RSRANK, AND RSSIZE.
*                                     SO, MAY BE USED BY INTRINSIC FUNS.
OPER     DTEMP    1                 TEMP & COMM DBLWD FOR CODESTRING &
*                                     OPERATOR EXECUTION.
FDTEMPS  DTEMP    19                FUNCTION DEFN MODE TEMP AREA.
GRAFBUF  EQU      FDTEMPS           SHARE FDTEMPS WITH GRAPHICS BUFFER  U14-0029
FDBLOCK  TEMP     47                FUNCTION DEFN MODE STORAGE BLOCK.
*                                                                       U14-0031
* NOTE--THE FOLLOWING TEMPS MUST BE DW ALIGNED: LIBTEMPS                U14-0032
*                                               OPRTEMPS                U14-0033
*                                               MIXTEMPS                U14-0034
*                                               INDXTMPS                U14-0035
*                                               EVALTMPS                U14-0036
*                                                                       U14-0037
LIBTEMPS EQU      FDBLOCK           SHARE FDBLOCK                       U14-0038
OPRTEMPS EQU      FDBLOCK+10         WITH LIB AND OPR TEMPS             U14-0039
MIXTEMPS DTEMP    14                TEMPS FOR MIX                       U14-0040
INDXTMPS DTEMP    20                          INDX
EVALTMPS DTEMP     5                          EVAL                      U14-0042
 SPACE 3
WINDOWSZ SET      TLOC              DISPLAY AMOUNT OF WINDOW USED       U14-0044
         ERROR,X'F',TLOC>512 'TOO MUCH FOR WINDOW TO HOLD'
         PAGE
*
* TERMINAL TRANSLATION TABLES-OVERLAID BY )TERM COMMAND
*
         PAGE
*
* INPUT TRANSLATION TABLE
*        THIS VERSION IS FOR ADL STANDARD TERMINAL (2741)
*         ALTERNATE VERSIONS ARE LOADED FOR OTHER TERMINAL TYPES
*
         BOUND    4
INTRANS  DATA     0,X'04050000',X'08000000',X'00010000'
         DATA     0,X'00010600',0,0
         DATA     X'07000000',0,0,0
         DATA     0,0,0,0
         DATA     X'40004200',X'44450000',X'48494A4B',X'4C4D4E4F'
         DATA     X'50000053',X'00555600',X'00005A5B',X'5C5D5E5F'
         DATA     X'60616200',X'64006667',X'00006A6B',X'6C6D6E6F'
         DATA     X'70717200',X'74007600',X'00797A7B',X'7C097E7F'
         DATA     0,0,0,0
         DATA     0,0,0,0
         DATA     0,0,0,0
         DATA     X'00B10000',X'B4B50000',0,0
         DATA     X'00C1C2C3',X'C4C5C6C7',X'C8C90000',0
         DATA     X'00D1D2D3',X'D4D5D6D7',X'D8D90000',0
         DATA     X'0000E2E3',X'E4E5E6E7',X'E8E90000',0
         DATA     X'F0F1F2F3',X'F4F5F6F7',X'F8F9FAFB',X'FCFDFE00'
         PAGE
*
*  OUTMNEMT AND OUTRANST-APLOUT TRANSLATION TABLES
*     THE LISTED TABLES ARE FOR APL STANDARD TERMINAL (2741)
*         ALTERNATE VERSIONS ARE LOADED FOR DIFFERENT
*         OUTPUT DEVICES,AS DICTATED BY )TERMINAL COMMAND
*
*  THESE TABLES ARE USED AS A PAIR IN TRANSLATING FROM APL
*        INTERNAL FORMAT (NOT CODESTRING) TO OUTPUT
*
*        IN SOME CASES (NON-APL TERMINALS) CHARACTERS ARE REMAPPED
*
*        THE OUTMNEMT IS USED TO DETERMINE IF OUTPUT CHARACTERS ARE
*        TO BE EXPANDED INTO MNEMONICS OR OVERSTRIKE CHARACTERS
*
*        IF ENTRY IN MNEMT IS:
*               0 -SINGLE CHARACTER-OUTPUT FROM OUTRANST
*               1-SINGLE CHAR. MNEMONIC-OUTRANST ENTRY HAS BYTE OFFSET
*                 FROM TABLE MNEMT1. OUTPUT % AND CHAR FROM MNEMT1
*               2-TWO CHAR. MNEMONIC. OUTRANST ENTRY HAS BYTE OFFSET
*                  FROM TABLE MNEMT2. OUTPUT % AND 2 CHARS FROM MNEMT2
*               3 -THREE CHAR. MNEMONIC. OUTRANST HAS BYTE OFFSET FROM
*                  MNEMT3. OUTPUT % AND 3 CHARS.
*               4 -OVERSTRIKE.  OUTRANST ENTRY HAS BYTE OFFSET FROM
*                  OVHWTABL. OUTPUT CHAR-BS-CHAR
*               5 -UNDERSCORED LETTER-OUTPUT UNDERSCORE-BACKSPACE
*                  THEN CHAR FROM OUTRANST
*
*       ***********
*       *
*       * ANY CHANGES IN MNEMT3,MNEMT2, OR OVHWTABL
*       *  REQUIRE CHANGES IN OUTMNEMT
*       *   AND,POSSIBLY,IN OUTRANST
*       *
*       * IF NBIO IS CHANGED THE IN-CORE VERSIONS OF
*       *  OUTMNEMT AND OUTRANST ARE AUTOMATICALLY
*       *   CORRECTED ON REASSEMBLY
*       *    THE VERSIONS FOR OTHER TERMINALS-KEPT ON FILE-
*       *     MUST ALSO BE REASSEMBLED AND REPLACED
*       *
*       *
*       *
*       **********
*
*
OUTMNEMT DATA     0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0                  00-3F
         DATA,1   0,4,0,4,0,0,4,4,0,0,0,0,0,0,0,0                  40-4F
         DATA,1   0,4,4,0,4,0,0,4,4,4,0,0,0,0,0,0                  50-5F
         DATA,1   0,0,0,4,0,0,0,0,4,0,0,0,0,0,0,0                  60-6F
         DATA,1   0,0,0,4,0,4,0,4,4,0,0,0,0,0,0,0                  70-7F
         DATA,1   0,5,5,5,5,5,5,5,5,5,0,0,0,0,0,0                  80-8F
         DATA,1   0,5,5,5,5,5,5,5,5,5,0,0,0,0,0,0                  90-9F
         DATA,1   0,0,5,5,5,5,5,5,5,5,0,0,0,0,0,0                  A0-AF
         DATA,1   4,0,4,0,0,0                                      B0-B5
OJ1      WHILE    OJ1<NBIO
         DATA,1   4                                                B6-XX
         FIN
OJ2      WHILE    OJ2<10-OJ1
         DATA,1   0                                                XX-BF
         FIN
         DATA     0,0,0,0,0,0,0,0,0,0,0,0                          C0-EF
         DATA     0,0,0,X'00000400'                                F0-FF
*
*
OUTRANST DATA     X'00010203',X'04050607',X'08090A0B',X'0C0D0E0F'  00-0F
         DATA     X'10111213',X'14151617',X'18191A1B',X'1C1D1E1F'  10-1F
         DATA     X'20212223',X'24252627',X'28292A2B',X'2C2D2E2F'  20-2F
         DATA     X'30313233',X'34353637',X'38393A3B',X'3C3D3E3F'  30-3F
         DATA,1   X'40',17,X'42',22                                40-43
         DATA,1   X'44',X'45',11,12                                44-47
         DATA     X'48494A4B',X'4C4D4E4F'                          48-4F
         DATA,1   X'50',3,28,X'53'                                 50-53
         DATA,1   33+2*NBIO,X'55',X'56',36+2*NBIO                  54-57
         DATA,1   18,24,X'5A',X'5B'                                58-5B
         DATA     X'5C5D5E5F'                                      5C-5F
         DATA,1   X'60',X'61',X'62',51+2*NBIO                      60-63
         DATA     X'64656667'                                      64-67
         DATA,1   37+2*NBIO,X'69',X'6A',X'6B'                      68-6B
         DATA     X'6C6D6E6F'                                      6C-6F
         DATA,1   X'70',X'71',X'72',21                             70-73
         DATA,1   X'74',50+2*NBIO,X'76',45+2*NBIO                  74-77
         DATA,1   49+2*NBIO,X'79',X'7A',X'7B'                      78-7B
         DATA     X'7C7D7E7F'                                      7C-7F
         DATA     X'80C1C2C3',X'C4C5C6C7',X'C8C98A8B',X'8C8D8E8F'  80-8F
         DATA     X'90D1D2D3',X'D4D5D6D7',X'D8D99A9B',X'9C9D9E9F'  90-9F
         DATA     X'A0A1E2E3',X'E4E5E6E7',X'E8E9AAAB',X'ACADAEAF'  A0-AF
         DATA,1   55+2*NBIO,X'B1',39+2*NBIO,X'B3'                  B0-B3
         DATA,1   X'B4',X'B5'                                      B4-B5
OL1      WHILE    OL1<NBIO
         DATA,1   28+NBIO+OL1                                      B6-XX
         FIN
OL2      WHILE    OL2<10-OL1
         DATA,1   X'B5'+OL1+OL2                                    XX-BF
         FIN
         DATA     X'C0C1C2C3',X'C4C5C6C7',X'C8C9CACB',X'CCCDCECF'  C0-CF
         DATA     X'D0D1D2D3',X'D4D5D6D7',X'D8D9DADB',X'DCDDDEDF'  D0-DF
         DATA     X'E0E1E2E3',X'E4E5E6E7',X'E8E9EAEB',X'ECEDEEEF'  E0-EF
         DATA     X'F0F1F2F3',X'F4F5F6F7',X'F8F9FAFB'              F0-FB
         DATA,1   X'FC',X'FD',29+2*NBIO,X'FF'                      FC-FF
         PAGE
*
*  BSPFLAG-BACKSPACE VALIDITY FLAG-TERMINAL ATTRIBUTE
*
BSPFLAG  DATA     1                 YES-FOR 2741
*
* ERRORCHR        TERMINAL ATTRIBUTE
*
*                 BYTE 0 IS ERROR INDICATOR
*                 BYTES 1 AND 2 ARE EVALUATED INPUT PROMPT
*                 BYTE 3 IS FLAG(IF NON-ZERO) FOR QQUAD PROMPT
ERRORCHR DATA     X'70537A00'       CARET-QUAD-COLON-0
*
ENDTERM  RES      0                 END OF TERMINAL TRANSLATION AREA
TERMSIZ  EQU      BA(ENDTERM)-BA(INTRANS) TERMINAL TRANS. TBL. SIZE
         PAGE
*
*  THE FOLLOWING AREA INCLUDES FPT'S WITH VARIABLE ELEMENTS
*
*
* FPTTABS-FPT TO SET TABS
*
FPTTABS  GEN,8,7,17   X'28',0,F:OUT   DCB ADDRESS
         GEN,1,31    1,0
TABVALS  DATA     0,0,0,0,0         BYTES FOR TAB VALUES
*
* FPTOPTF-OPEN TEMP FILE IN SCRATCH MODE
*
FPTOPTF  GEN,8,7,17  X'14',0,F:TF   DCB ADDRESS
         DATA     X'07400001'       P6-P8,P10,F12
         DATA     1                 ORG-CONSEL     (P6)
         DATA     1                 ACC-SEQUENTIAL (P7)
         DATA     8                 MODE  (OUTIN)
         DATA     1                 REL
         DATA     X'01000202'       NAME CONTROL                        14-00001
TFNAME   TEXTC    'APLTF00'
         DATA     X'02000000',X'03010000'  RESET ACCT AND PASSWORD      14-00003
NAMEGRN1 DATA     0                 GRANULE # FOR 1ST NAME RECORD
         BOUND    8                                              @@@@@@@
OPWSFLR1 DATA     0   ** SPACE FILLER                                  @
*
* FPTOPWS-FPT TO OPEN F:WS FOR  )SAVE,)LOAD,)COPY, ETC.
*
*  THIS FPT IS IN  CSECT 0 BECAUSE OF VARIABLE PARAMETERS USED
*
FPTOPWS  GEN,8,7,17  X'14',0,F:WS   DCB ADDRESS                        @
         DATA     X'07400001'       P6,P7,P8,P10,F12                   @
OPWSORG  DATA     2                 ORG  (P6)                          @
OPWSACC  DATA     2                 ACC  (P7)                          @
OPWSMODE DATA     0                 MODE (P8)                          @
         DATA     2                 SAVE (P10)                         @
         DATA     X'01000303'       NAME-3 WORDS RESERVED-3 WORDS USED @
OPWSNAME TEXTC    'CONTINUE'        WS NAME-3WORDS                     @
OPWSPASC DATA     X'03000003'       PASSWORD CONTROL-DEFAULT OFF       @
OPWSPAS  DATA     0,0 ** DW BOUND **PASSWORD-                          @
OPWSFLR2 DATA     0   ** SPACE FILLER **                               @
OPWSACTC DATA     X'02000002'      LACCOUNT CONTROL-DEFAULT OFF
OPWSACT  DATA     0,0  ** DW BOUND
OPWSWRTC DATA     X'06010404'       WRITE ACCOUNT CONTROL
         TEXT     'NONE    APLAPLAP'
*
* FPTOP1ST-USED TO INITIALIZE SEARCH OF AN ACCOUNT
*
         BOUND    8                                                  @@@
FPTOP1ST GEN,8,7,17  X'14',4,F:TF   DCB ADDRESS AND 'TEST' OPEN
         DATA     X'07600401'       P6,7,8,10,11  F2,12
         DATA     1                 ORG (P6)
         DATA     1                 ACC (P7)
         DATA     1                 MODE(P8)
         DATA     2                 SAVE(P10)
         DATA     FPARAMS           (P11) FILE PARAMETER ADDRESS
         DATA     X'01000101'       NAME CONTROL
         DATA     0                 EMPTY NAME
OP1STACC DATA     X'02010002'       ACCT CONTROL
OP1STACT DATA     0,0         ** DW BOUND  EMPTY ACCOUNT
*
* FPTOPFIO-OPEN F:FN IN INDICATED MODE TO INDICATED FILE
*
* MUST START AT ODD LOCATION FOR DW BOUND CONTROL                @@@@@@@
         BOUND    8                                                    @
FIODCB   DATA     F:F1           **  DEFAULT TO 1ST FIODCB              U14-0046
FPTOPFIO GEN,1,7,7,17  1,X'14',0,FIODCB      DCB ADDRESS         @@@@@@@
         DATA     X'07400001'       P6,P7,P8,P10,F12
         DATA     2                 ORG  (P6)
         DATA     2                 ACC  (P7)
FIOMODE  DATA     0                 MODE (P8)
         DATA     2                 SAVE (P10)
         DATA     X'01000303'       NAME CONTROL
FIONAME  DATA     0,0,0             NAME-3 WORDS
FIOACCC  DATA     X'02000003'       ACCOUNT CONTROL
FIOACCT  DATA     0,0               ACCOUNT                      @@@@@@@
FIOKEY   DATA     0             **  FILLER FOR DW BOUND CONTROL        @
FIOSNC   DATA     X'07000003'        PRIVATE PACK CONTROL WORD          U14-0048
FIOSN    DATA     0,0,0              SERIAL NUMBER ENTRIES              U14-0049
FIOPASC  DATA     X'03000002'       PASSWORD CONTROL             @@@@@@@
FIOPASS  DATA     0,0               PASSWORD
         DATA     X'05000101'       READ CONTROL
FIOREADC TEXT     'NONE'            READ OPTION-NONE OR ALL
         DATA     X'06010101'       WRITE CONTROL
FIOWRITC TEXT     'NONE'            WRITE OPTION-NONE OR ALL
*
*  FPTWAIT-SUSPEND OPERATIONS FOR INDICATED TIME
*
FPTWAIT  DATA     X'0F000000'
*
* FPTRSTRM-RESET TERMINAL MODES ON LEAVING APL
*
FPTRSTRM DATA     X'06200000'       CHANGE TERMINAL MODE
         DATA     X'E0000000'        PRESENCE BITS
         DATA     X'8C'                MASK-MODE
         DATA     X'6F'                     MODE2
         DATA     X'A0'                     MODE3
         PAGE
*
*  THE FOLLOWING AREA INCLUDES VALUES WHICH ARE SET AND MODIFIED
*      DURING EXECUTION BUT CANNOT BE CONSIDERED TEMPS
*
*
*      DATA TO RESET TSTACK AFTER TRAP
* ISPD-(INITIAL STACK-POINTER-DOUBLEWORD) AND LSPD-(ADDRESS OF SPD)
*
         BOUND    8
ISPD     RES      2                 INITIAL SPD VALUE
LSPD     EQU      OPWSFLR1          LOCATION OF STACK PTR DW
*
* WSIDNAME-DEFAULTED TO 'CLEAR WS'
*
         BOUND    8
WSIDPASS DATA     0,0               WSID PASSWORD
WSOFFSET DATA     0                 WS LOAD OFFSET
LOADCASE DATA     0                 LOAD CATEGORY
WSIDNAME TEXTC    'CLEAR WS'        WORKSPACE ID NAME-UP TO 11 CHAR'S.
*
*      ONLINE-OFFLINE MODE FLAG
*
ON%OFF   EQU      OPWSFLR2          ON%OFF-1=ON-LINE   0=OFF-LINE
*
*      MAXIMUM INPUT RECORD SIZE (DIFFERS FOR ON-LINE VS OFFLINE)
APLSIZ   RES      1
EORVAL   DATA     0                 ON-LINE DEFAULT(ALLOWS 'LOOK-AHEAD')
DWIDTH   DATA     120               DEFAULT PRINT WIDTH
*      OUTPUT RECORD(F:OUT) BLOCKING SIZE (DIFFERS FOR ON-LINE VS OFF)
OUTMAXSZ RES      1                 MAX F:OUT BLOCK SIZE-GLOBAL
*
*      TERMINAL TYPE FLAG
TERMTYPE DATA     1                 DEFAULT TO  2741-APL
TERMKEY  DATA     X'03000000'         KEY OF TERMINAL RECORD
*
* LOGON TIME IN  60THS OF SECONDS
*
LOGONTIM RES      1
*
INITCPU  RES      1                 INITIAL CPU USAGE.
INITOVH  RES      1                 INITIAL OVERHEAD USAGE.
*
*      MEMORY BOUNDS
*
         BOUND    8
HIDYN    RES      2                 HIGH END OF DYNAMIC (+1)
LOCOMMON EQU      HIDYN+1           LOW  END OF COMMON
DYNBOUND EQU      HIDYN             DYNAMIC BOUND
STKLIMIT EQU      LOCOMMON
LODYN    RES      1                 LOWEST ADDRESS IN 'DYNAMIC'-FIXED
HICOMMON RES      1                 HIGHES ADDRESS IN 'COMMON'-FIXED
CORAVAIL RES      1                 NUMBER OF WORDS AVAIL-TOTAL-FIXED
CORLEFT  RES      1                 WORDS OF MEMORY YET AVAILABLE
*
*    BREAK  FLAG
*
BREAKFLG DATA     0                 BREAK FLAG
*
*     QUITFLAG-USED TO PREVENT RUNAWAY OF ERROR MESSAGES ON
*              ATTEMPTS TO 'CONTINUE' IN OFF-LINE MODE
*
QUITFLAG DATA     1
*
OUTSIZ   RES      1                 OUTPUT RECORD SIZE
*
* THIS REGION INCLUDES PARAMETERS WHICH MUST BE TRANSFERRED TO THE
*        COMMON AREA OF A WORKSPACE BY )SAVE  OR )CONTINUE
*        AND WHICH MUST BE SET FROM THE COMMON AREA OF A WORKSPACE
*        BY  )LOAD.
*
         BOUND    8
COMPRMST RES      0                 START OF COMMON PARAMETERS TABLE
FUZZBIT  DATA     0,X'200'                  1 BIT IN LEAST SIG. POS.
FUZZLIMS DATA     -X'35200000',X'35200000'  FUZZ LIMITS
FUZZMASK DATA     -X'400'                   RIGHT HAND SIGNIFICANCE MASK
FUZZCNT  DATA     10                        COUNT OF BITS TO BE IGNORED
ORGADJ   DATA     0                 1-ORIGIN
ORIGIN   DATA     1                 1 OR 0
DIGITS   DATA     10
WIDTH    DATA     120
RANDOM   DATA     123456789         RANDOM SEED (MUST BE + AND ODD)
ECLEARST RES      0
CLEARSIZ EQU      ECLEARST-COMPRMST SIZE OF 'CLEAR' TABLE
STATEPTR DATA     0                 SI STATE POINTER
TOPOSTAK DATA     0                 TOP OF EXECUTION STACK
MODE     DATA     1      -1=FORCED CLOSE 0=FN OPEN 1=DIR INP 2=EVAL INP
OPENFN   DATA     0                 POINTER TO FN OF FORCED CLOSE
ECOMPRMS RES      0
NCOMPRMS EQU      ECOMPRMS-COMPRMST SIZE OF COMMON PARAMETERS TABLE
*
PCOPYFLG RES      1                 PROTECTED COPY FLAG
         BOUND    8
LODACCT  TEXT     '        '        LOAD ACCOUNT-INITIALLY BLANK
CMNDTYPE RES      1                 COMMAND TYPE-NEG. POS. IN VECTOR
HOLDFLG  DATA     0                 HOLD-OFF FLAG FOR CONTINUE
SICTRL   DATA     0 = ON & NZ=OFF=NO FN.SUSP ON ERR.  STATE-INDIC.CTRL.
GDIGITS  DATA     3                 GRAPHIC DIGITS SETTING
IOERCODE DATA     0                 MONITOR I/O ERROR CODE-SUBCODE
         PAGE
*
*  TEMPS USED BY APLUTSI
*
RETURN14 RES      1                 RETURN FROM MEMORY ACCESS ROUTINES
BCDTIME  RES      4                 BCD TIME VALUE
SAVE14   RES      1                 SAVE R14
         BOUND    8
ERMSAV   RES      2                 SAVE R4-5 FOR ERMS
ERMSBUF  RES      10                BUFFER FOR ERROR MESSAGES
         PAGE
*
* CONTEXT USED BY FIO SUBSYSTEM
*
FIOBUF   RES      1                 POINTER TO FIO BUFFER (DATA BLOCK)
FIOSIZ   RES      1                 SIZE OF FIOBUF
FIOABNT  RES      1                 FIO INABN FLAG
FIODCBNO DATA     1                  FIO DCB NO,DEFAULT=1               U14-0053
*
* KEY TABLES FOR FIO SUBSYSTEM
FRSTKEYT DO1      NUMFILES          # OF FIO DCB'S
         DATA     0                 PRESET TO 0
CURRKEYT DO1      NUMFILES          # OF FIO DCB'S
         DATA     0                 PRESET TO 0
LASTKEYT DO1      NUMFILES          # OF FIO DCB'S
         DATA     0                 PRESET TO 0
*                                                                       U14-0055
*  TABLE OF FIO TIE VALUES                                              U14-0056
*                                                                       U14-0057
FIOTIE   DO1      NUMFILES           NO. OF FIO DCBS                    U14-0058
         DATA     0                   PRESET TO ZERO                    U14-0059
         PAGE
*
* PATCH REGION-TO BE REMOVED BEFORE RELEASE
*
         DEF      IVIE
IVIE     B        IVIE
         STW,R14  IVIE+7
         BAL,R14  WSCHEK
         B        IVIE+5
         DATA     0
         LW,R14   IVIE+7
         B        0
         DATA     0
         REF      WSCHEK
         PAGE
APLUTSI@ CSECT    1
*
*  CONSTANT REGION
*
         BOUND    8
APLVERSN TEXT     'APLWSB00'        MUST BE APLWS---, ---=VERSION
DIGRANGE DATA     1,16              DIGITS RANGE
WIDRANGE DATA     30,254            WIDTH RANGE
KEY1     DATA     X'03000001'       KEY VALUE 1
F0       DATA     X'F0'             MASK
XFF      DATA     X'FF'             MASK
FFFFFE00 DATA     X'FFFFFE00'       MASK FOR PAGE BOUNDING
SIX      DATA     6
*
*  FPT'S  WHICH CONTAIN NO VARIABLE PARAMETERS EXCEPT VIA INDIRECT
*         ADDRESSING
*
*
* FPTOPNXT-USED TO GET 'NEXT' FILE IN AN ACCOUNT
*
FPTOPNXT GEN,8,7,17  X'14',4,F:TF   DCB NAME AND 'TEST' OPEN
         DATA     X'00200401'       P11   F2,F12
         DATA     FPARAMS           (P11) FILE PARAMETER BUFFER
*
* FPTRDAPL  READ  F:APL  -TERMINAL  OR CARD READER-
*
FPTRDAPL GEN,8,7,17  X'10',0,F:APL  DCB ADDRESS
         DATA     X'F4000010'       P1,2,3,4,6   AND WAIT FLAG
         DATA     ERRRDAPL          ERR  (P1)
         DATA     ERRRDAPL          ABN  (P2)
         GEN,1,31 1,R8              BUF  (P3)
         GEN,1,31 1,APLSIZ          SIZ  (P4)
         GEN,1,31 1,R9              BTD  (P6)
*
* FPTRD1ST-READ FIRST RECORD OF A FILE-FOR FILE ID PURPOSES
*
FPTRD1ST GEN,8,7,17  X'10',0,F:TF   DCB ADDRESS
         DATA     X'F4000010'       P1-P4,P6,F3
         DATA     ERRFTF            ERR (P1)
         DATA     ERRFTF            ABN (P2)
         DATA     IDBUF             BUF (P3)
         DATA     32                SIZ  (P4)
         DATA     0                 BTD (P6)
*
* FPTWROUT-FPT FOR OUPUT ON F:OUT
*
FPTWROUT GEN,8,7,17  X'11',0,F:OUT  DCB ADDRESS
         DATA     X'F4000010'       OPTIONS AND WAIT FLAG
         DATA     ERRWROUT          ERROR EXIT    P1
         DATA     ABNWROUT          ABN   EXIT    P2
         GEN,1,31 1,R8                            P3
         GEN,1,31 1,R9                            P4
         GEN,1,31 1,R10                           P6
ERRWROUT EQU      ERRFOUT           F:OUT WRITE ERROR-QUIT
ABNWROUT EQU      ABNFOUT           F:OUT WRITE ABN  -QUIT
*
* FPTRDQ  READ 'BLIND INPUT' VIA M:QN (N=1,2...NBIO)
*
FPTRDQ   GEN,1,7,7,17  1,X'10',0,R11    DCB ADDRESS IN R11
         DATA     X'F4000010'       P1,P2,P3,P4,P6 AND WAIT
         DATA     ERRRDQ            ERR (P1)
         DATA     ABNRDQ            ABN (P2)
         DATA     QINBUF            BUF (P3)
         DATA     QINSIZ            SIZ (P4)
         DATA     0
QINBUF   EQU      BLINBUF           BLIND INPUT BUFFER
QINSIZ   EQU      512               BLIND INPUT BUFFER SIZE
ABNRDQ   EQU      ERRRDQ
*
* FPTWRQ -WRITE RECORD VIA F:QN (BLIND OUTPUT)
*
FPTWRQ   GEN,1,7,7,17  1,X'11',0,R6  DCB ADDRESS IN R6
         DATA     X'F4000010'       P1,P2,P3,P4,P6 AND WAIT
         DATA     ERRWRQ            ERR (P1)
         DATA     ABNWRQ            ABN (P2)
         GEN,1,31 1,RQWRBUF         BUF (P3)
         GEN,1,31 1,RQWRSIZ         SIZ  (P4)
         DATA     0                 BTD  (P6)
ABNWRQ   EQU      ERRWRQ
RQWRBUF  EQU      R4
RQWRSIZ  EQU      R1
*
* FPTCLOSV-CLOSE AND SAVE A DCB
*
FPTCLOSV GEN,1,7,7,17  1,X'15',0,R5  DCB ADDRESS IN R5
         DATA     X'80000000'        P1
         DATA     2                  SAVE
*
* FPTCLOSR-CLOSE AND RELEASE A DCB
*
FPTCLOSR GEN,1,7,7,17  1,X'15',0,R5  DCB ADDRESS IN R5
         DATA     X'80000000'        P1
         DATA     1                  REL
*
*  GET  VIRTUAL PAGE
*
FPTGVP   GEN,1,7,7,17  1,X'04',0,R13 ADDRESS IN R13
*
*  FREE VIRTUAL PAGE
*
FPTFVP   GEN,1,7,7,17  1,X'05',0,R13 ADDRESS IN R13
*
* FPTTIME-GET TIME,EBCDIC IN 4-WORD BLOCK AT *R6,BINARY IN R8-R10
*
FPTTIME  DATA     X'90800006'       'TIME',TUN, ADDRESS *R6
*
* FPTSNAPT-SNAPSHOT-TRAP
*
FPTSNAPT DATA     0
         DATA     MODTBLS           DISPLAY ADDRESSES
         DATA     MODTBLE            OF ASSEMBLY MODULES
         TEXT     '**TRAP**'
         B        CALSNAPT+1        EXIT TO CALSNAPT+1
*
* FPTSNAPS-SNAPSHOT-SYSTERR
*
FPTSNAPS DATA     0
         DATA     MODTBLS           DISPLAY ADDRESSES
         DATA     MODTBLE            OF ASSEMBLY MODULES
         TEXT     'SYS ERR '
         B        CALSNAPS+1
*
* FPTSNAPI-SNAPSHOT-I/O ERROR
*
FPTSNAPI DATA     0
         DATA     MODTBLS           DISPLAY ADDRESSES
         DATA     MODTBLE             OF ASSEMBLY MODULES
         TEXT     'I/O ERR '
         B        CALSNAPI+1          GO TO ERR EXIT
*
* FPTSNAPW-FPT SNAPSHOT-WS DAMAGE DETECTED
*
FPTSNAPW DATA     0
         DATA     MODTBLS           DISPLAY ADDRESSES
         DATA     MODTBLE            OF ASSEMBY MODULES
         TEXT     '*BAD WS*'
         B        CALSNAPW+1
*
* FPTSNAPA-FPT SNAPSHOT-RUN ABORTED BY OPERATOR
*
FPTSNAPA DATA     0
         DATA     MODTBLS
         DATA     MODTBLE
         TEXT     'ABORTED '
         B        CALSNAPA+1
         PAGE
*
*  BREAK-RESPONSE TO USERS INTERRUPT
*        IF XSEGBRK IS SET,RESETS XSEGBRK,RESETS STACK,EXITS TO OPBREAK
*        OTHERWISE,SETS BREAK FLAG,RETURNS TO INTERRUPTED OPERATION
*                 FOR DELAYED BREAK RESPONSE
*
BREAK    MTW,1    BREAKFLG          SET BREAK FLAG
        LW,R2    XSEGBRK           CHECK FOR BREAK IN EXECUTION SEG.
         AI,R2    -OPBREAK
         BNEZ     DLYBREAK           NO
         STW,R2   XSEGBRK            YES-RESET FLAG
         LD,R8    ISPD                RESTORE
         STD,R8  *LSPD                 STACK
         B        OPBREAK     *BREF*      EXIT TO OPBREAK
DLYBREAK LI,R2    CALWROUT          CHECK FOR BREAK ON TERMINAL OUTPUT
         LW,R3    X1FFFF
         CS,R2   *R1
         BNE      CALTRTN            NO
         MTW,1   *R1                 YES-SKIP THE CAL
CALTRTN  CAL1,9   5                 TRAP-BREAK RETURN
*
*  TRAP-ROUTINE TO HANDLE TRAPS
*
*        IF NOT FL PT TRAP: SYSTEM ERROR
*        IF FL PT OVERFLOW: DOMAIN ERROR
*        IF DIV BY 0 BUT NOT R6:DOMAIN ERROR
*        IF DIV BY 0 AND R6:CALL DIVZERO
*                             RETURN TO CALL+1:DOMAIN ERROR
*                             RETURN TO CALL+2:RESTORE R6-7 AND TRTN
*
*        TRAP (TSTACK) IS RESET  BY RESTRAP IF EXIT IS TO ERROR ROUTINE
*
        LOCAL    FLTRAP,DOMERR
TRAP     LW,R0    18,R1             GET TYPE OF TRAP
         STW,R0   XSEGBRK              RESET IMMEDIATE BRK RSP FLAG     14-00007
         CI,R0    X'44'              CHECK IT
         BE       FLTRAP             FLOATING
         LW,R0    0,R1              R0= 1ST HALF OF PSD
         LW,R1    3,R1              R1= PRE-TRAP VALUE OF R1
         BAL,R15  CHKTERM           SWITCH IF 4013
CALSNAPT CAL1,3   FPTSNAPT          GENERATE SNAPSHOT
         B        ERREXIT           CRASH
FLTRAP   LW,R2    0,R1              CHECK WHICH FLOATING TRAP
         LC       R2
         BCS,3    DOMERR            OVERFLOW
         LW,R4   *R1                DIV-BY-ZERO,GET PSD WORD 1
         LH,R4   *R4                 GET TRAPPED INSTRUCTION
         AND,R4   F0                  MASK 'R' FIELD
         CI,R4    X'60'                 CHECK IF R6
         BNE      DOMERR               DOMAIN ERROR
         LW,R6    8,R1              GET OLD R6 AND R7
         LW,R7    9,R1
         BAL,R5   DIVZERO           LET OPERATOR EXECUTION ROUTINE TEST
         B        DOMERR             NOT VALID-DOMAIN ERROR
         STW,R6   8,R1               VALID-PUT R6 AND R7
         STW,R7   9,R1                BACK IN TSTACK
         MTW,1    0,R1                 KICK INSTRUCTION ADDRESS
         B        CALTRTN               TRAP RETURN
DOMERR   LD,R8    ISPD              RESET
         STD,R8  *LSPD               TRAP AND
         B        ERDOMAIN    *BREF*      EXIT
         PAGE
*
* HANGUP-EXIT CONTROL ROUTINE-REACHED BY
*        HANGUP OR OTHER EXTERNAL CAUSE
*
HANGUP   RES      0
CALXCOPH CAL1,8   FPTXCOFF          RESET EXIT CONTROL
         CI,R8    8+4               CHK 4 LINE DISCONNECT OR LIMIT
         BAZ      HANGUP1            NO
         LI,R7    -5                 YES-SET FLAG FOR HANGUP
         STW,R7   BREAKFLG
CALXRTN  CAL1,9   256+5             RETURN TO WIND UP PROCESSING
HANGUP1  CI,R8    X'F0'             CHECK FOR OPERATOR ABORT
         BANZ     HANGUP2            YES
         CI,R8    1                  NO-CHECK FOR TRAP
         BANZ     CALSNAPT               YES
         B        IOERR                  NO-ASSUME IO ERROR
HANGUP2  RES      0
CALSNAPA CAL1,3   FPTSNAPA          SEND ABORT MESSAGE
         B        CALRSTRM           AND EXIT
*
* FPTXCOFF-TURN OFF EXIT CONTROL
*
FPTXCOFF DATA     X'19000000'
         PAGE
*
* DELAYER-ROUTINE  TO DELAY SPECIFIED INTERVAL
*
*  R5=LINK  R7=NO. OF SECONDS TO DELAY
*
*
DELAYER  AI,R7    1
         MI,R7    5
         DW,R7    SIX               (THE CAL USES  1.2 SECOND UNITS)
         STW,R7   FPTWAIT
         LI,R7    X'0F'
         STB,R7   FPTWAIT
CALWAIT  CAL1,8   FPTWAIT           GENERATE WAIT CALL TO UTS
         B        0,R5
         PAGE
*
* RELEASER-ROUTINE TO RELEASE PAGES AS INDICKTED BY
*          TOPOSTAK AND FREETOTL
*
*        R11=LINK
*        R8,12,13,AND 14 USED INTERNALLY
*
*        ROUTINES CALLED:RELCOM   LINK R14
*                        GARBCOLL LINK R8 -NO OTHER R'S CHANGED
*                        RELDYN   LINK R14-USES R12
*
*        LOC'S UPDATED:DYNBOUND,FREETBL+1,FREETOTL,STKLIMIT
*
         LOCAL    OVRLAP
RELEASER MTW,0    CORLEFT           CHECK IF ALL PAGES IN USE
         BLEZ     OVRLAP             YES
         BAL,R14  RELCOM             NO-RELEASE COMMON TO TOPOSTAK
         LW,R14   FREETOTL           CHECK DYNAMIC STATUS
         AI,R14   -((MINANNEX+1)*512)
         BLEZ    *R11               NO DYNAMIC PAGES TO RELEASE
         BAL,R8   GARBCOLL           GARBAGE COLLECT BEFORE RELEASE
SRELDYN  LW,R12   FREETBL
         AI,R12   MINANNEX*512       GET NEW DYNBOUND
         BAL,R14  RELDYN
         LW,R14   DYNBOUND
         SW,R14   FREETBL           SET SINGLE FREETABLE ENTRY TO
         STW,R14  FREETBL+1          THE WHOLE SCHMEER
         STW,R14  FREETOTL            WHICH EQUALS FREETOTL
         B       *R11               EXIT
OVRLAP   BAL,R8   GARBCOLL          GARBAGE COLLECT IF OVERLAP
         LW,R13   TOPOSTAK
         AND,R13  FFFFFE00          GET PAGE BOUND FOR STAKLIM
         LW,R14   R13                SAVE IT
         SW,R14   FREETBL             CHECK IF RELEASE POSSIBLE
         AI,R14   -((MINANNEX+1)*512)
         BLEZ    *R11                NO-EXIT
         STD,R13  DYNBOUND             YES-SET DYNBOUND AND STKLIMIT
         B        SRELDYN               THEN RELEASE DYNAMIC
         PAGE
*
*  CLEARMEM-CLEAR COMMON AND DYNAMIC     )CLEAR OR )LOAD
*
*   R11=LINK, USES CLEARCOM AND CLEARDYN ROUTINES
*    R7,R12,R14 VOLATILE
* NOTE:RESOLVES OVERLAPPED COMMON-DYNAMIC USE OF PAGE BY SHIFTING LIMIT
*        BOUNDS TO COMMON SIDE OF PAGE
*
         LOCAL    NOVERLAP
CLEARMEM MTW,0    CORLEFT           CHECK IF ALL CORE USED
         BGZ      NOVERLAP           NO
         LW,R7    DYNBOUND           YES-FORCE DYNBOUND AND
         AI,R7    511                     STKLIMIT TO START
         AND,R7   FFFFFE00                  OF PAGE
         CW,R7    HICOMMON           CHECK IF TOO MUCH
         BL       NOVERLAP-1          NO
         AI,R7    -512                YES-MOVE BACK 1 PAGE
         STD,R7   DYNBOUND
NOVERLAP BAL,R14  CLEARDYN          CLEAR DYNAMIC
         BAL,R14  CLEARCOM          CLEAR COMMON
         B       *R11               RETURN
         PAGE
*
* RELDYN-ROUTINE TO RELEASE ONE OR MORE 'DYNAMIC' PAGES
*        TWO ENTRIES:
*         1. RELDYN-RELEASE PAGES TOWARD ADDRESS IN R12
*                   THIS IS PARTIAL CLEAR
*         2. CLEARDYN-RELEASE PAGES TOWARD LODYN,SUBJECT TO MINALLOW.
*                   THIS ENTRY FOR TOTAL CLEAR TO MINIMUM.
*        REGISTERS:R14 IS LINK. R13 IS USED BUT RESTORED.
*                  R12 USED.
*        IF PAGES ARE RELEASED,HIDYN AND CORLEFT ARE CHANGED
         LOCAL    FREEDYN,CHECK
RELDYN   STW,R14  RETURN14          SAVE LINK
FREEDYN  XW,R13   HIDYN             GET HIDYN-SAVE R13 TEMPORARILY
         AI,R13   -512               MOVE BACK TO START OF HIGHEST PAGE
CHECK    CW,R13   R12                 CHECK IF PAGE TO BE RELEASED
         BGE      CALFVPDY
         AI,R13   512                NO-SET FORWARD
         B        SETCORHY            EXIT
CALFVPDY CAL1,8   FPTFVP            YES-RELEASE PAGE-ADDRESS IN R13
         AI,R13   -512               BACK UP 1 PAGE
         B        CHECK
CLEARDYN LI,R12   MINALLOW*512      GET INITIAL ALLOWANCE
         AW,R12   LODYN              SET UP COMPARISON ADDRESS
         B        RELDYN
         LOCAL
*
* RELCOM-ROUTINE TO RELEASE ONE OR MORE COMMON PAGES
*        TWO ENTRIES:
*         1. RELCOM-RELEASE TOWORD TOPOSTAK
*         2. CLEARCOM-RELEASE TOWARD HICOM
*        REGISTERS:R14 IS LINK. R13 IS USED BUT RESTORED.
*        IF PAGES ARE RELEASED,LOCOMMON AND CORLEFT ARE CHANGED
*        IF PAGES ARE RELEASED,LOCOM IS CHANGED.
*
*
         LOCAL    FREECOM,CHECK
RELCOM   STW,R14  RETURN14          SAVE LINK
         LW,R14   TOPOSTAK          GET LOWEST COMMON ADDRESS NEEDED
FREECOM  AND,R14  FFFFFE00          REDUCE TO PAGE ADDRESS
         XW,R13   LOCOMMON          GET LOCOMMON, SAVE R13
CHECK    CW,R13   R14                CHECK IF PAGE TO BE RELEASED
         BGE      SETCORLO            IF NOT,RESTORE LOCOM AND R13
CALFVPCO CAL1,8   FPTFVP            YES-RELEASE PAGE-ADDRESS IN R13
         AI,R13   512                MOVE UP 1 PAGE
         B        CHECK
CLEARCOM STW,R14  RETURN14          SAVE LINK
         LW,R14   HICOMMON           SET UP TO RELEASE
         B        FREECOM             ALL BUT 1 PAGE OF COMMON
         LOCAL
*
* GETDYN-ROUTINE TO GET DYNAMIC PAGES AS INDICATED BY ADDRESS
*        NEWBOUND AND MININCR(MINIMUM INCREMENT)
*        (VIRTUAL ACCESS IS USED)
*        IF PAGES ARE ACCESSED,HIDYN IS CHANGED
*
*        ROUTINE ALSO HAS COMMON EXIT FOR RELDYN,RELCOM,AND GETCOM
*                 ROUTINES,WHICH UPDATES CORLEFT AFTER ANY CHANGE.
*        REGISTERS:R14 IS LINK. R13 IS USED BUT RESTORED.
*
         LOCAL    CHECK,SETCOR,SETCORZ
GETDYN   STW,R14  RETURN14          SET RETURN
         LW,R14   NEWBOUND           GET TARGET ADDRESS
         AI,R14   MININCR*512        -AND INCREMENT-
         XW,R13   HIDYN             GET LAST IN-CORE ADDRESS+1
CHECK    CW,R13   R14               CHECK IF DONE
         BG       SETCORHY          YES
         CW,R13   LOCOMMON           NO-CHECK FOR ENCROACHMENT ON
         BGE      SETCORHY             COMMON
CALGVPDY CAL1,8   FPTGVP             NO-GET A PAGE
         AI,R13   512                   AND LOOP
         B        CHECK
SETCORHY XW,R13   HIDYN             SET HIDYN-RESTORE R13
SETCORZ  LW,R14   LOCOMMON
         SW,R14   HIDYN             CALCULATE  CORE LEFT
         STW,R14  CORLEFT           STASH IT
         LW,R14   RETURN14           RESTORE R14
         B       *R14                 AND EXIT
SETCORLO XW,R13   LOCOMMON          SET LOCOMMON-RESTORE R13
         B        SETCORZ
*
* GETCOM-ROUTINE TO GET A PAGE OF COMMON (VIRTUAL ACCESS IS USED)
*
*        IF PAGE IS ACCESSED,LOCOMMON IS CHANGED
*
*        REGISTERS:R14 IS LINK. R13 IS USED BUT RESTORED.
*
         LOCAL
GETCOM   STW,R14  RETURN14          SAVE RETURN
         XW,R13   LOCOMMON          GET LOWEST COMMON ADDRESS-SAVE R13
         AI,R13   -512               BACK 1 PAGE
CALGVPCO CAL1,8   FPTGVP              GET IT
         B        SETCORLO             EXIT (UPDATE LOCOM,RESTORE R13)
         PAGE
*
* CALTIME-ROUTINE TO GET TIME
*
*  R7=LINK   R6 HAS ADDRESS OF 4-WORD BLOCK TO HOLD  EBCDIC VERSION
*  ON EXIT, R8,R9,R10 HAVE BINARY VERSION OF TIME-DATE
*
GETTIME  LI,R6    BCDTIME           SET ADDRESS FOR BLD VERSION
CALTIME  CAL1,8   FPTTIME
         B        0,R7
         PAGE
*
* NUMUSERS-DELIVERS NUMBER OF USERS IN R11
*
*        R14=LINK  R5,R6,R7 VOLATIILE
*
NUMUSERS RES      0
CALDSPL  CAL1,8   FPTDSPL           CALL UTS 'DISPLAY'
         LW,R11   R7                 NO. USERS INTO R11
         B       *R14                 RETURN
FPTDSPL  DATA     X'13000000'
         PAGE
*
* CPUTIME-DELIVERS CPU TIME (60THS OF A SECOND) IN R11
*
*        R14=LINK   R10 VOLATILE
*
CPUTIME  LW,R11   J:DELTAT
         SW,R11   J:IDELTAT
         AW,R11   J:PTIME
         AW,R11   J:UTIME
         SW,R11   INITCPU
CV60THS  MI,R11   12
         DW,R11   TENSTBL+2         CONVERT TO 1/60THS' OF SECONDS
         B       *R14
*
* OVHTIME-DELIVERS OVERHEAD TIME (60THS OF A SECOND) IN R11
*
*        R14=LINK   R10 VOLATILE
*
OVERTIME LW,R11   J:PTIME+1
         AW,R11   J:UTIME+1
         SW,R11   INITOVH
         B        CV60THS
         PAGE
*
* TIMODAY-DELIVERS TIME OF DAY IN 60THS OF SECONDS IN R11
*
*  R14=LINK, R6-R13 VOLATILE
*
         LOCAL    TIMLOOP
TIMODAY  BAL,R7   GETTIME           GET TIME
         LI,R7    3
         LB,R11   R9,R7             'TMS'
         MI,R11   12
         DW,R11   TENSTBL+2         CONVERT TO 60'THS OF SECONDS
TIMLOOP  AI,R7    -1
         BLZ     *R14
         LB,R13   R9,R7             HOURS,MINUTES,SECONDS
         MW,R13   T60S,R7
         AW,R11   R13
         B        TIMLOOP
T60S     DATA     216000,3600,60
         PAGE
*
* DATE-DELIVERS DATE-IN WEIRD(THANKS TO IBM) UNITS-IN R17
*
*  R14=LINK, R6-R10 VOLATILE
*
         LOCAL    MONLOOP,ADDMONS,MONTBL
DATE     BAL,R7   GETTIME
         LH,R11   R8                YEAR
         LB,R7    BCDTIME+2         3RD CHAR OF MON
         LW,R6    BCDTIME+1          D-BLANK-FIRST 2 CHARS OF MON
         STB,R7   R6                3RD CHAR-BLANK-1ST CHAR-2ND CHAR
         LI,R7    12
MONLOOP  CW,R6    MONTBL-1,R7
         BE       ADDMONS
         BDR,R7   MONLOOP
ADDMONS  MI,R7    10000
         AW,R11   R7                YEARS+10,000*MONTHS
         LI,R6    10                TENS OF DAYS PTR
         LB,R7    BCDTIME,R6
         AI,R7    -X'F0'            CONVERT TO BINARY
         MI,R7    1000
         AW,R11   R7
         LI,R6    11                DAYS-UNITS PTR
         LB,R7    BCDTIME,R6
         AI,R7    -X'F0'            CONVERT TO BINARY
         MI,R7    100               10;000*MONTHS+100*DAYS+YEARS
         AW,R11   R7
         B       *R14
MONTBL   TEXT     'N JAB FER MAR APY MAN JUL JUG AUP SET OCV NOC DE'
         PAGE
*
* CLOSV-CLOSE AND SAVE
*
*        DCB ADDRESS IN R5
*        R6=LINK  R7 USED
*
CLOSV    LW,R7   *R5                GET WORD 0 OF DCB
         CW,R7    BITPOS-10          CHECK IF DCB OPEN
         BAZ      0,R6                NO-RETURN
CALCLOSV CAL1,1   FPTCLOSV             YES-CLOSE IT
         B        0,R6              RETURN
*
* CLOSR-CLOSE AND RELEASE
*
*        DCB ADDRESS IN R5
*        R6=LINK  R7 USED
*
CLOSR    LW,R7   *R5                GET WORD 0 OF DCB
         CW,R7    BITPOS-10          CHECK IF DCB OPEN
         BAZ      0,R6                NO
CALCLOSR CAL1,1   FPTCLOSR             YES-CLOSE IT
         B        0,R6                  EXIT
*
*    RDADL-READ AN INPUT RECORD FROM F:ADL
*
*        R11 IS LINK
*        R7,R8,R9  ARE USED INTERNALLY
*        ON ENTRY:OUTSIZ CONTAINS # OF BYTES OFFSET FROM INBUF
*                 TO START INPUT
*
*        RECORD IS READ INTO INBUF AS OFFSET BY OUTSIZ
*
*        IF INPUT IS VIA CARD READER,CR IS INSERTED IN COLUMN 73
*        IF INPUT IS VIA OTHER SOURCE, '0' IS SET AFTER LAST BYTE AS
*                 END-OF-RECORD FLAG
*
*        OUTSIZ IS RESET TO 0
*        ON EXIT, R7=-1
*
         LOCAL    CARDIN,SETEOR
RDAPL    LW,R8    OUTSIZ            GET PROMPF OFFSET-IF ANY
         CI,R8    520               CHECK IF TOO BIG
         BL       RDAPL1             NO
         BAL,R15  SYSTERR            YES-SYSTEM ERROR
RDAPL1   LI,R9    0
         SLD,R8   -2                SHIFT TO WORD OFFSET
         SCS,R9   2                 SET BYTE DISPLACEMENT
         AI,R8    INBUF             BASE OF INPUT BUFFER
CALRDAPL CAL1,1   FPTRDAPL          *  READ A RECORD *
         LI,R7    0
         LW,R8    BREAKFLG          CHECK BREAK
         BLEZ     %+2               OK-OR HANG-UP
         STW,R7   BREAKFLG           BREAK-RESET IT
         XW,R7    OUTSIZ            RESET PROMPT OFFSET-SAVE IN R7
         LH,R8    F:APL+4           SET END-OF-RECORD FLAG
         SLS,R8   -1                    AT BYTE AFTER
         AW,R7    R8                     LAST INPUT BYTE
         LW,R8    EORVAL            GET ON-LINE OR OFF-LINE EOR VALUE
SETEOR   STB,R8   INBUF,R7          SET END-OF-RECORD
         LI,R7    -1                PRESET  INCOL POSITION
         B       *R11               RETURN
         PAGE
*
* CALWROUT-OUTPUTS RECORD VIA F:OUT
*
*        R7=LINK
*        R8=BUFFER ADDRESS
*        R9=SIZE IN BYTES
*        R10=BYTE  DISPLACEMENT
*
*   IF ENTRY IS VIA WROUT-
*    OUTPUT IS ABORTED IF BREAKFLG IS SET
*
EWROUTWB EQU      WROUTWB           ERROR CALL TO WROUTWB.
WROUTWB  LI,R10   0                 WRITE FROM WORD BOUND
WROUT    MTW,0    BREAKFLG          CHECK FOR BREAK
         BNEZ     0,R7               YES-EXIT
CALWROUT CAL1,1   FPTWROUT           OUTPUT A RECORD ON F:OUT
         B        0,R7               THEN EXIT
*
* WRTEXTC-WRITE TEXTC ERROR MESSAGE
*
*  R7=LINK  R8,R9,R10 USED
*
*   ON ENTRY, R8=ADDR OF MESSAGE
*
EWRTEXTC EQU      WRTEXTC           ERROR CALL TO WRTEXTC.
WRTEXTC  STD,R4   ERMSAV            SAVE R4-R5
         LB,R4    *R8                SET COUNT
WRTEXTC1 LB,R5    *R8,R4              GET BYTE
         LB,R5    OUTRANST,R5          TRANSLATE IT
         STB,R5   ERMSBUF,R4            SAVE IT
         BDR,R4   WRTEXTC1               LOOP
         LD,R4    ERMSAV            RESTORE R4-R5
         LB,R9    *R8               SET COUNT
         LI,R10   1                     OFFSET
         LI,R8    ERMSBUF               AND BUFFER ADDRESS
         B        WROUT              USE WROUT
         PAGE
*
* QTABULID-CHECK VALIDITY OF TABS
*
*  ON ENTRY-R4=ADDRESS OF 1ST  TAB    R6= # OF TABS
*           R4,R8 VOLATILE
*           R6 SAVED IN SAVE312, THEN VOLATILE
*           R5=LINK
*
*   RETURNS TO CALL+1 ON ERROR, CALL+2 IF OK
*
         LOCAL    GETNUTAB,ONETABV
QTABVLID STW,R6   SAVE312           SAVE # OF TABS
         CI,R6    1
         BL       1,R5              NO VALUE-OK RETURN
         BE       ONETABV            ONE VALUE
         CI,R6    16                CHECK IF TOO MANY
         BG       0,R5               YES
         AI,R6    -1
GETNUTAB LW,R8    0,R4
         CI,R8    2
         BLE      0,R5              TOO LOW-ERROR RETURN
         CI,R8    128
         BGE      0,R5              TOO HIGH-ERROR RETURN
         CW,R8    1,R4
         BGE      0,R5              NOT ASCENDING-ERROR RETURN
         AI,R4    1
         BDR,R6   GETNUTAB          LOOP
         B        1,R5               NORMAL EXIT
ONETABV  LW,R8    0,R4              SINGLE VALUE
         BLZ      0,R5               NEGATIVE-BAD
         BEZ      1,R5               0-OK
         AI,R8    -2
         BLEZ     0,R5              1 OR 2-BAD
         AI,R8    -126
         BGEZ     0,R5              128 OR MORE-BAD
         B        1,R5              OK
*
* SNEWTABS-SET NEW TABS(IF INDICATED)
*
* R5=LINK,R6 AND R8 VOLATILE
*
*   ON ENTRY, SAVE312=# OF TABS TO BE SET
*             IF ZERO,RETURN WITHOUT CHANGING TAB SETTING
*             R4=ADDRESS OF FIRST NEW TAB
*
*             VALUES HAVE BEEN VALIDATED BY 'QTABVLID'
*
         LOCAL    TABLOOP1,SEVTABS,LASTAB,TABLOOP2
SNEWTABS LW,R6    SAVE312           GET # OF TABS
         CI,R6    1
         BL       0,R5              NONE
         BG       SEVTABS           SEVERAL
         LW,R8   *R4                ONE-TAB INTERVAL
         STW,R8   TABPNTR            SET TAB POINTER WITH INTERVAL
TABLOOP1 STB,R8   TABVALS,R6          SET A TAB
         AI,R6    1
         CI,R6    16                CHECK HOW MANY
         BG       LASTAB             ENOUGH
         AW,R8   *R4                INCREMENT BY INTERVAL
         CI,R8    128                CHECK SIZE
         BL       TABLOOP1            OK
LASTAB   AI,R6    -1                DONE
         STB,R6   TABVALS           SET COUNT
         B        CALTABS            DO CAL
SEVTABS  STB,R6   TABVALS           SEVERAL TABS-SET COUNT
         AI,R6    1
         LI,R8    0
         STB,R8   TABVALS,R6        SET END FLAG
         AI,R6    -1
         AI,R4    -1
TABLOOP2 LW,R8   *R4,R6             SET VALUES
         STB,R8   TABVALS,R6
         BDR,R6   TABLOOP2
         LI,R8    128               SET HI VALUE
         STW,R8   TABPNTR
CALTABS  CAL1,1   FPTTABS
         B        0,R5              RETURN
*
* TABSET-CHECK VALIDITY OF NEW TABS-SET NEW-GET OLD VALUE(S)
*        IN CONSTBUF
*   R2=LINK    QTABVLID AND SNEWTABS ARE USED
*
*    ON ENTRY- R6=# OF TABS  R4=ADDRESS OF 1ST TAB
*
*    ERROR-EXIT TO CALL+1  NORMAL EXIT TO CALL+2
*
*        R4,R5,R6,R8  VOLATILE
*
         LOCAL    SOLDTABS,TABSET1,TABSET2
TABSET   STW,R4   SAVE312+1         SAVE ADDRESS OF 1ST TAB
         BAL,R5   QTABVLID          CHECK VALIDITY
         B        0,R2               NO
         LW,R6    TABPNTR           YES
         CI,R6    128                CHECK VARIETY
         BL       TABSET2             1 VALUE
         LB,R6    TABVALS              VECTOR
         STW,R6   CONSTBUF              SET SIZE
SOLDTABS LB,R4    TABVALS,R6
         STW,R4   CONSTBUF,R6       SET OLD VALUES
         BDR,R6   SOLDTABS
TABSET1  LW,R4    SAVE312+1         GET ADDRESS OF 1ST NEW TAB
         BAL,R5   SNEWTABS           SET NEW TABS
         B        1,R2                RETURN
TABSET2  STW,R6   CONSTBUF+1        SET 1 VALUE
         LI,R5    1
         STW,R5   CONSTBUF          INDICATE 1 VALUE
         B        TABSET1
         PAGE
*
* SETWIDTH-SET NEW WIDTH,GET OLD
*
*   R5=LINK
*
*   ON ENTRY:R7=NEW WIDTH(INTEGER)
*        ERROR EXIT-CALL+1 (OUT OF RANGE)
*        NORMAL EXIT-CALL+2  R7=OLD VALUE
*
SETWIDTH CLM,R7   WIDRANGE          CHECK RANGE
         BCS,9    0,R5               NO
         XW,R7    WIDTH               OK-SET NEW,GET OLD
         B        1,R5
*
* SETDIGIT-SET NEW DIGIT VALUE,GET OLD
*
*  R5=LINK   R7 IS NEW VALUE ON ENTRY, OLD ON EXIT
*
*   ERROR RETURN TO CALL+1  NORMAL TO CALL+2
*
SETDIGIT CLM,R7   DIGRANGE          CHECK RANGE
         BCS,9    0,R5               NO
         XW,R7    DIGITS             OK
         B        1,R5
         PAGE
*
* INPBLIND-BLIND INPUT ROUTINE  READ UP TO 512 BYTES FROM F:QN
*
*    R14=LINK
*    R6 =QUAD NUMBER-CHANGED IN ROUTINE
*    ON EXIT,R11=# OF CHARACTERS IN BLINBUF
*    NO OTHER REGISTERS USED
INPBLIND LW,R11   FQTABL-1,R6       GET DCB ADDRESS
CALRDQ   CAL1,1   FPTRDQ             READ RECORD
         LI,R6    8
         LH,R11  *R11,R6
         SLS,R11  -1                GET ACTUAL RECORD SIZE
RDQEX    AI,R14   1                 NORMAL RETURN IS TO CALL+2
         B       *R14
ERRRDQ   RES      0
ERRWRQ   RES      0
         STW,R10  IOERCODE          SAVE MONITOR CODE-SUBCODE
         LB,R10   IOERCODE
         CI,R10   6                 CHECK FOR EOF
         BNE     *R14               NO-ERROR EXIT
         LI,R11   0                 YES-SET LENGTH TO 0
         B        RDQEX
*
* FQTABL-USED BY INPBLIND AND BLINDOUT
*
         DATA     F:OUT             (FQTABL-1)-USED BY CLOSFILS
VDATA    CNAME
         PROC
N        DO       AF(1)
LF(N)    DATA     AF(N+1)
         FIN
         PEND
FQTABL   VDATA    NBIO-1,F:Q1,F:Q2,F:Q3,F:Q4,F:Q5,F:Q6,F:Q7,F:Q8,F:Q9
*
* FIODCBT-TABLE OF DCB ADDRESSES
*   USED BY FIO SUBSYSTEM
*
*    NOTE:ASSEMBLY WILL INDICATE ERRORS UNLESS NUMFILES=8
*         THE ORG AT THE BOTTOM OF THE TABLE NULLIFIES THE APPARENT
*         ERROR
*
FIODCBT  VDATA    NUMFILES,F:F1,F:F2,F:F3,F:F4,F:F5,F:F6,F:F7,F:F8
*
* BLINDOUT-BLIND OUTPUT ROUTINE GENERATE UNTRANSLATED TEXT OUTPUT
*
         LOCAL    GETSIZE,BLIND1
BLINDOUT LW,R6    FQTABL-1,R6       GET DCB ADDRESS IN R6
         LI,R1    1
         LB,R5   *R4,R1             GET RANK
         BEZ      BLIND1             SCALAR
         STW,R5   RANKARR
         AI,R4    1                 R4=LOC OF 61-1
         LI,R1    1
GETSIZE  MW,R1   *R4,R5             GET SIZE IN R1
         BDR,R5   GETSIZE
         AW,R4    RANKARR
         AI,R4    1                 GET DATA WORD ADDRESS IN R4
CALWRQ   CAL1,1   FPTWRQ            WRITE RECORD
         AI,R14   1                 NORMAL RETURN TO CALL+2
         B       *R14
BLIND1   LI,R1    1                 SET LENGTH TO 1
         AI,R4    2                  AND POINTER TO SCALAR
         B        CALWRQ
         PAGE
*
* ERROR ROUTINES ASSOCIATED WITH MONITOR INTERFACES
*
*
ERRFOUT  EQU      IOERR
ABNFOUT  EQU      ERRFOUT           F:OUT OPEN  ABN  -QUIT
*
* ERRFTF-ERROR ON F:TF OPERATION
*
ERRFTF   AND,R8   X1FFFF            ADDRESS MASK
         STW,R10  IOERCODE           SAVE MONITOR ERROR CODE-SUBCODE
         CI,R8    CALOPTRI+1         CHECK IF OPEN FOR INITIAL TERM
         BE       IOERR               YES-CRASH
         CI,R8    CALRDTRI+1         CHECK IF READ FOR INITIAL TERM
         BE       IOERR               YES-CRASH
         CI,R8    CALOPTRM+1        CHECK IF OPEN FOR )TERM
         BE       IOERRCM            YES-TERM FILE LOST
         CI,R8    CALRDTRM+1        CHECK IF READ FOR )TERM
         BNE      ERRFTF1            NO
         LI,R5    F:TF               YES-INDICATE DCB
         BAL,R6   CLOSV             CLOSE AND SAVE
         B        ERBADCMD
ERRFTF1  CI,R8    CALOP1ST+1        CHECK IF FIRST  )LIB FILE
         BE       ERROP1ST           YES
         CI,R8    CALOPNXT+1          NO-CHECK IF LATER )LIB FILE
         BNE      ERRFTF2
ERROP1ST LI,R9    2
         CB,R9    R10               CHECK IF LAST FILE
         BNE      PRINTFNE           NO-CONTINUE
BCMDEXIT B        CMDEXIT     *BREF*    COMMAND EXIT
PRINTFNM LI,R9    0                 FLAG-NOT PROTECTED FILE
PRINTFNE LI,R7    1
         LI,R6    F:TF+23           ADDRESS OF NAME
         LB,R10  *R6                 BYTE COUNT
         SLS,R6   2                  BYTE ADDRESS (OF COUNT)
         LI,R3    0                 IMAGE OFFSET
         BAL,R13  GENTEXT           GENERATE NAME
         CI,R9    2                 CHECK IF PROTECTED
         BNE      BCLOSTHS-1         NO
         LB,R10   PROTECTD
         LI,R6    BA(PROTECTD)
         BAL,R13  GENTEXT           ISSUE RESTRICTED ACCESS MESSAGE
         BAL,R12  DUMPLING           SHOVE LINE OUT
BCLOSTHS B        CLOSTHIS    *BREF*  RESUME FILE SEARCH
PROTECTD TEXTC    '*RESTRICTED ACCESS*'
ERRFTF2  RES      0
         CI,R8    CALOPTF+1         CHECK IF  OPEN FOR COPY TFILE
         BE       ERRCOPY            YES-QUIT
         CI,R8    CALRDTF+1         CHECK IF COPY TFILE READ
         BE       IOERR              YES-QUIT
         CI,R8    CALWRTF+1         CHECK IF COPY TFILE WRITE
         BE       IOERR              YES-QUIT
         LB,R10   R10               SET CODE-ONLY IN R10
         B        ERRFTFIO          FIO SUBSYSTEM ERROR HANDLER
*
* ERRFWS-ERROR OR ABN RETURN ON CAL TO  F:WS
*
*  CHECKS WHICH CALL ERRORED AND-AS APPROPRIATE-THE ERROR CONDITION
*
         LOCAL    LBRFMSG,ERFWS1,FBSYMSG,ERFWS2
ERRFWS   AND,R8   X1FFFF            ADDRESS MASK
         STW,R10  IOERCODE           SAVE MONITOR ERROR CODE-SUBCODE
         CI,R8    CALOPWS1+1        CHECK IF THIS IS OPEN FOR TESTOLDF
         BNE      ERFWS1             NO
         LI,R9    3                  YES-CHECK IF 'FILE NOT FOUND'
         CB,R9    R10
         BE       SAVEOPEN            GOOD-NORMAL IN THIS CASE
ERLIBREF LI,R8    IDFILREF          = ERR I.D. FOR 'BAD FILE REF'.
         B        CMDERR            CMD ERROR EXIT.
ERFWS1   CI,R8    CALOPWS2+1        CHECK IF THIS IS OPEN FOR SAVE
         BNE      ERFWS2             NO
         LI,R9    X'1402'           'CHECK IF BUSY'
         CH,R9    R10
         BNE      IOERRCM           I/O ERR IN CMD.
         LI,R8    IDFILBSY          = ERR I.D. FOR 'FILE IN USE'.
         B        CMDERR            CMD ERROR EXIT.
ERFWS2   CI,R8    CALOPWS3+1        CHECK IF OPEN FOR LOAD
         BNE      ERFWS3             NO
ERXWSNF  LI,R6    BCMDERR            YES-
         LI,R8    IDWSNOTF          = ERR I.D. FOR 'WS NOT FOUND'.
         B        CLOSV
*
*  ERFFS2-REACHED BY 'TRYLOAD' IF OPEN OK AND RECORD LONGER THAN
*          IDRECSIZ-(WHICH IT SHOULD BE)
*
ERFWS3   CI,R8    CALRDWSI+1        CHK IF READ OF ID REC
         BNE      ERFWS4             NO
         LI,R9    7                  CHECK IF RECORD TOO BIG
         CB,R9    R10
         BNE ERXWSNF                  NO
         LI,R4    IDBUF               YES-OK-GET ID RECORD ADDRESS
         LW,R9    6,R4              'APLVERSN' FOR FILE
         CW,R9    APLVERSN          CHECK IF APL FILE
         BNE      CLOSV              NO-CLOSE AND ERROR EXIT
         LW,R9    LODYN             COMPUTE AND
         SW,R9    4,R4               SAVE
         STW,R9   WSOFFSET            WS DYNAMIC OFFSET
         LI,R6    BCMDERR             SET NEW ERROR EXIT
         B       *R14                  RETURN
ERFWS4   CI,R8    CALOPWS4+1        CHECK IF OPEN FOR 'DROP'
         BNE      ERFWS5            NO
         LI,R8    IDWSNOTF          = ERR I.D. FOR 'WS NOT FOUND'.
BCMDERR  B        CMDERR      *BREF*  NO SCORE
ERFWS5   RES      0
         CI,R8    CALWRWS+1         CHECK IF WS WRITE
         BE       ERRSAVE            YES-ABORT THE SAVE.
         CI,R8    CALRDWS+1         CHECK IF WS READ
         BNE      ERFWSCS0           NO-ASSUME INITIALIZATION PROBLEM
         LI,R9    7                 CHECK IF RECORD TOO BIG
         CB,R9    R10
         BNE      IOERR              NO-QUIT
         CI,R14   RDWRLOOP          CHECK IF READ FOR COPY
         BE       ERRFWS6            YES-OK
         B        IOERR              NO-QUIT
*
*  ERBADWS-ERROR RETURN FROM WS CHECKER ON LOAD,SAVE,OR COPY
*
ERBADWS  RES      0
CALSNAPW CAL1,3   FPTSNAPW          GENERATE SNAPSHOT
         B        BCLEAR            GO TO CLEAR.
*
* ERRSAVE-ERROR DURING )SAVE AFTER SUCCESSFUL OPEN.
* ERRCOPY-ERROR DURING FILE COPY ON OPEN OF TFILE
*
ERRCOPY  LI,R5    F:TF              DCB
         B        ERRSAVE1
ERRSAVE  LI,R4    0                 MAY BE SAVE FOR AUTOSTART
         XW,R4    CURRCS
         BEZ      ERRSAVE0           NO.
         AI,R4    -2                  YES, DEREF. CODESTRING.
         BAL,R7   DREF
ERRSAVE0 LI,R5    F:WS              DCB
ERRSAVE1 BAL,R14  XWLOCGLB          RE-EXCHANGE LOCALS & GLOBALS.
         BAL,R6   CLOSR             CLOSE AND RELEASE.
         LI,R8    IDFILSPC          = ERR I.D. FOR 'FILE SPACE TOO LOW'.
         LB,R1    IOERCODE
         CI,R1    X'57'               CK FOR ERROR CODE 57...
         BE       CMDERR                YES, FILE SPACE TOO LOW.
IOERRCM  LI,R8    IDIOERR           = ERR I.D. FOR 'I/O ERR'.
         B        CMDERR
*
* SYSTERR-SYSTEM ERROR ROUTINE
*
SYSTERR  RES      0
         STW,R15  XSEGBRK              RESET IMMEDIATE BRK RSP FLAG     14-00009
         LW,R0    R15               SAVE R15 IN R0
         BAL,R15  CHKTERM           SWITCH IF 4013
CALSNAPS CAL1,3   FPTSNAPS          GENERATE SNAPSHOT
         B        ERREXIT            CRASH
*
* IOERR-UNRESOLVABLE I/O ERROR-NOT ON F:OUT
*
IOERR    RES      0
         STW,R8   XSEGBRK              RESET IMMEDIATE BRK RSP FLAG     14-00011
         BAL,R15  CHKTERM           SWITCH IF 4013
CALSNAPI CAL1,3   FPTSNAPI          GENERATE SNAPSHOT
         B        ERREXIT            CRASH
*
* ERRRDAPL-ERROR ON APL READ (M:APL)
*
ERRRDAPL LB,R9    R10               ERROR CODE
         CI,R9    7                  CHECK FOR PARITY ERROR
         BE       CALRDAPL+1          YES-USE THE DATA
         CI,R9    6                 CHECK FOR EOF
         BNE      IOERR              NO-IO ERROR
         MTW,0    ON%OFF             YES-CHECK IF ON-LINE
         BGZ      CALRDAPL+1           ON-LINE,CONTINUE
BOFFH    B        UTSIOFFH  * BREF * RETURN TO MONITOR
*
* ERREXIT-CRASH EXIT
*
ERREXIT  LI,R15   -1                SET FLAG TO ABORT
         STW,R15  HOLDFLG
         B        CALXCOFF
TELEXIT  RES      0
         BAL,R15  CHKTERM           SWITCH IF 4013
CALXCOFF CAL1,8   FPTXCOFF          RESET EXIT CONTROL
CALRSTRM CAL1,8   FPTRSTRM          RESET TERMINAL MODE
         MTW,0    HOLDFLG           TEST FOR ABORT
         BGEZ     CALEXIT            NO
         MTW,0    ON%OFF             YES-TEST IF OFF-LINE
         BGZ      CALEXIT            NO-CONTINUE
CALERR   CAL1,9   2                 ERROR RETURN TO MONITOR
CALEXIT  CAL1,9   1                  RETURN TO TEL
*
*
CHKTERM  XW,R15   TERMTYPE
         AI,R15   -13               CHECK IF TERMINAL TYPE 13
         BNEZ    *TERMTYPE           NO
         LI,R15   X'1B0F'            YES
         STH,R15  GRAFBUF
CAL13TTY CAL1,1   FPTWR2            SWITCH 4013 TO TTY MODE
         B       *TERMTYPE           EXIT
         PAGE
*
* ERRFF-FILE IO MONITOR ERROR PROCESSOR
*
*  ERROR PROCESSOR RESIDES IN APLFIO MODULE
*
ERRFF    B        FIOERR            IN MODULE APLFIO
ABNFF    EQU      ERRFF             ABN-OPEN
*
* MODTBL-TABLE OF ASSEMBLY MODULE ORIGINS
*        USED IN CRASH ANALYSIS
*
MODTBLS  RES     0
         GEN,8,24 X'01',ACQCONS@
         GEN,8,24 X'02',CONSTS@
         GEN,8,24 X'03',CONTEXT@
         GEN,8,24 X'04',CS@
         GEN,8,24 X'05',INTRINS@
         GEN,8,24 X'06',WMAQ@
         GEN,8,24 X'07',LIB@
         GEN,8,24 X'08',OPR@
         GEN,8,24 X'09',MIX@
         GEN,8,24 X'10',INDX@
         GEN,8,24 X'11',EVAL@
         GEN,8,24 X'12',APLINP@
         GEN,8,24 X'13',APLOUT@
         GEN,8,24 X'14',APLUTSI@
         GEN,8,24 X'15',FUNDEF@
         GEN,8,24 X'16',WSCOPY@
         GEN,8,24 X'17',CMD@
         GEN,8,24 X'18',APLUTSC@
         GEN,8,24 X'19',CODEXEQ@
         GEN,8,24 X'20',APLFIO@
         GEN,8,24 X'21',APLFMT@
         GEN,8,24 X'22',MAT@
         GEN,8,24 X'23',RCMD@
         GEN,8,24 X'24',SCMD@
         GEN,8,24 X'25',ERROR@
         GEN,8,24 X'26',GRAF@
         GEN,8,24 X'27',UTSG@
MODTBLE  EQU     %-1
         END      START