*DECK MISC
          IDENT  BASCHAN
* 
*                C H A I N
* 
*CALL COPYRITE
* 
          IPARAMS 
* 
*     ENTRIES / EXTERNALS 
* 
          ENTRY  BASCHAN,BATCHAN
          EXT    ASCII             ASCII MODE FLAG
          EXT    OLDFILE           OLD FILENAME 
          EXT    BASWRAP           CLOSE ALL FILES
          EXT    BASUSRN           USER NUMBER ROUTINE
          EXT    BASEGEN           ERROR ROUTINE
          EXT    RNBLOCK,RNLIST,DBUGON
          EXT    DXMESS            DISPLAY EXECUTION TIME 
          EXT    BASSYS=,BASCIO=
       EXT    RPVBLK
 SYS=     EQU    BASSYS=
 CIO=     EQU    BASCIO=
* 
*     EQUATES 
* 
          IFC    EQ,,"OS.NAME",KRONOS,
          SYSCOM
          SST 
          ELSE
 PGNR     EQU    64B
 LWPR     EQU    65B
          ENDIF 
 CMVALUE  EQU    35000B            CM GIVEN TO COMPILER OR LOADER 
*CALL ERMNUM
* 
*     ERROR MESSAGES
* 
 ERM144   DATA   C* CHAIN FILE NOT FOUND *
 ERM145   DATA   C* ILLEGAL CHAIN PARAMETER * 
 RPVRSET   BSS   0
           VFD   36/0,12/31B,11/1,1/0 
* 
 ER144    BSS    0
          RTERROR ERMN144,ERM144,BASEGEN   *CHAIN FILE NOT FOUND *
* 
 ER145    BSS    0
          RTERROR ERMN145,ERM145,BASEGEN   *ILLEGAL CHAIN PARAM * 
* 
* 
* 
*  CHAIN STRING EXP   OR   CHAIN FILE ORDINAL 
* 
*  AT ENTRY X0 = 0/1 FOR STRING/ORDINAL 
*           A5 = STRING ADDR  OR  B5 = FET ADDR 
* 
          DATA   10HBASCHAN 
 BASCHAN  DATA   0
          SB1    1
* 
          ZR   X0,SCANSTR           JUMP IF STRING FORM 
          SA1    B5                FETCH FILENAME FROM FET
          MX2    42 
          BX6    X2*X1
          SA6    LFN
          SA1    ASCII             COPY CURRENT MODE TO AS OPTION 
          BX6    X1 
          SA6    ASOPT
          EQ   LOCCHEK
* 
*  SCAN STRING FOR LFN, UN, PW, MODE
* 
 SCANSTR   BSS    0 
          SB6    A5 
          ZR     X5,CHAN.A   NULL STR 
          SB6    X5 
          PL     X5,CHAN.A   VARIABLE STR 
          SB6    X5+B4       CONST STR
 CHAN.A   SA1    B6          A1/X1 = FWA/FIRST WORD OF STRING 
          SB5    10                B5 = CHARS LEFT IN WORD
          SX2    77B
          MX6    0                 CLEAR RESULT FIELDS
          SA6    LFN
          SA6    A6+B1
          SA6    A6+B1
          SA4    ASOPT+1           *ASCII*                               BAS0021
          SA3    ASCII
          NZ   X3,CHAN1            JUMP IF ASCII MODE                    BAS0021
          SA4    A4+B1             *NORMAL*                              BAS0021
 CHAN1    BX6    X4                                                      BAS0021
          SA6    A6+B1             DEFAULT MODE = CURRENT 
          SB6    1R=
          SA6    LFN-1             PRESET A6
*         START IN POSITIONAL MODE, FIRST KEYWORD SWITCHES TO KEY MODE
          SX3    4                 MAX NUMBER OF POSITIONAL PARAMS
* 
 CHAN2    RJ   SCAN                X6 = CHARS, B7 = 453949359 
          EQ   B6,B7,KEY           KEYWORD= 
          SA6    A6+B1             STORE VALUE
          ZR   B7,VALCHEK          EXIT IF EOS
          SX3    X3-1              COUNT
          NZ   X3,CHAN2            LOOP FOR NEXT PARAM
*                                  4 POSITIONAL PARAMS HAVE BEEN STORED 
 CHAN3    RJ   SCAN                CHECK FOR POSSIBLE KEYWORDS
          NE   B6,B7,ER145         NO MORE POSITIONALS ALLOWED
 KEY      BSS    0                 PROCESS KEYWORD PARAM
          RJ   DECODE              CONVERT KEYWORD INTO ADDR IN X7
          RJ   SCAN                GET VALUE
          EQ   B6,B7,ER145         KEY=VALUE= IS ERROR
          SA6    X7                STORE VALUE AT ADDR
          NZ   B7,CHAN3            LOOP FOR MORE IF NOT EOS 
* 
 VALCHEK  BSS    0                 CHECK VALIDITY OF VALUES 
          SA1    LFN               FILENAME 
          ZR   X1,ER145            NOT SPECIFIED
          MX2    42 
          BX3    -X2*X1 
          NZ   X3,ER145            LONGER THAN 7 CHAR 
          LX1    6
          SX2    77B
          BX3    X1*X2             FIRST CHARACTER
          ZR   X3,ER145            FIRST IS COLON 
          SX3    X3-1R0 
          PL   X3,ER145            FIRST IS NOT LETTER
* 
          IFC    EQ,,"OS.NAME",KRONOS,
          MX2    42 
          SA1    UN                USER NUMBER
          ZR   X1,CHAN20           JUMP IF NOT SPECIFIED
          BX3    -X2*X1 
          NZ   X3,ER145            LONGER THAN 7 CHAR 
          RJ   BASUSRN             GET OUR USERNUMBER 
          MX2    42                RESTORE IN CASE CLOBBERED
          SA1    UN                RESTORE X1 
          SA3    B7                X3 = REL ADDR
          SA3    X3+B2       X3 = STR POINTER 
          SA3    X3          X3 = USER NUMBER STRING
          BX6    X3-X1             COMPARE
          NZ   X6,CHAN20           JUMP IF DIFFERENT
          SA6    A1                CLEAR UN WHEN SAME AS OURS 
* 
 CHAN20   SA1    PW                PASSWORD 
          ZR   X1,CHAN30           JUMP IF NOT SPECIFIED
          BX3    -X2*X1 
          NZ   X3,ER145            LONGER THAN 7 CHAR 
 CHAN30   BSS    0
          ENDIF 
* 
          SA1    ASOPT             MODE = ASCII OR NORMAL 
          ZR   X1,LOCCHEK          JUMP IF NOT SPECIFIED
          SX2    77B
          LX1    6
          BX3    X2*X1             FIRST CHAR 
          SX4    X3-1RA 
          NZ   X4,CHAN51           NOT *A*
          SA3    ASOPT+1           MUST BE ASCII
          SX6    B1                SWITCH VALUE 
          EQ   CHAN52              GO CHECK REST OF LETTERS 
 CHAN51   SX4    X3-1RN 
          NZ   X4,ER145            NOT *N*
          SA3    ASOPT+2           MUST BE NORMAL 
          MX6    0
 CHAN52   RJ   CHKVAL              CHECK REST OF MODE VALUE 
          SA6    A1                SET MODE SWITCH 0/1
* 
* 
* 
* 
 LOCCHEK  BSS    0
* 
*  DETERMINE IF FILE IS ALREADY LOCAL 
          SA1    LFN
          SA2    INFOBUF
          MX6    59 
          IFC    EQ,,"OS.NAME",SCOPE ,
*  CLEAR BIT 0 IN FIRST WORD OF PARAMETER BLOCK BEFORE
*  ISSUING  THE -FILINFO- MACRO ON NOS/BE.
          BX2    X2*X6             CLEAR BIT 0. 
          ELSE
*  SET BIT 0 TO -1- IN FIRST WORD OF PARAMETER BLOCK
*  BEFORE ISSUING THE -FILINFO- MACRO ON NOS. 
          BX2    -X6+X2            SET BIT 0. 
          ENDIF 
          BX6    X1+X2
          SA6    A2 
          FILINFO INFOBUF        SEE IF LFN IS LOCAL
          SA1    INFOBUF+1
          ZR     X1,NOTLCL   LFN IS NOT LOCAL 
          LX1    43 
          NG     X1,ER145    LFN IS CONNECTED 
          EQ     WRAP 
 NOTLCL   BSS    0
* 
          IFC    EQ,,"OS.NAME",KRONOS,
* 
*  TRY TO GET OR ATTACH THE FILE
* 
          SA1    LFN               SET UP FET FOR GET 
          BX6    X1                FILENAME=PERMFILENAME
          SX1    1
          BX6    X6+X1
          SA6    FET
          SA1    UN                USERNUMBER 
          BX6    X1 
          SA6    FET+9
          SA1    PW                PASSWORD 
          SA2    FET+10            PRESERVE LOWER PART
          BX6    X1+X2
          SA6    A2 
          SYSTEM   PFM,RECALL,FET,2*100B    GET 
          SA1    FET               CHECK RETURN CODE
          AX1    10 
          SX2    377B 
          BX1    X1*X2
          ZR   X1,WRAP             JUMP IF FILE WAS OBTAINED
          SX2    X1-2              CHECK FOR *NOT FOUND* CODE 
*                                  IN CASE OLD VERSION OF NOS.
          ZR     X2,TRYATT         GO TRY ATTACH IF *NOT FOUND* 
          SX2    X1-75B            CHECK FOR FDA CODE-*FILE IS DIRECT 
*                                  ACCESS AND AN INDIRECT OPERATION 
*                                  WAS REQUESTED*.
          NZ     X2,ER144          ERROR JUMP IF ANY OTHER CODE 
 TRYATT   BSS    0
          SX6    1
          SA6    FET+10B     SET ACCESS MODE TO READ
          SYSTEM   PFM,RECALL,FET,11B*100B   ATTACH 
          SA1    FET
          AX1    10 
          SX2    377B 
          BX1    X1*X2
          NZ   X1,ER144            JUMP IF NOT OBTAINED 
* 
          ELSE
* 
*  TRY TO ATTACH THE FILE 
* 
          SA1    LFN               SET UP FDB FOR ATTACH
          BX6    X1                PERMFILENAME=FILENAME
          SA6    FDB               PFN
          SX1    10B               ATTACH CODE
          BX6    X6+X1
          SA6    FDB+4             LFN, CODE
          SA1    UN                ID 
          ZR   X1,CHAN72A          JUMP IF NOT SPECIFIED
          SX2    77B               RIGHT JUSTIFY IT 
          LX1    60-6 
 CHAN71   BX3    X2*X1
          NZ   X3,CHAN72           EXIT WHEN JUSTIFIED
          AX1    6
          EQ   CHAN71              LOOP 
 CHAN72   LX1    6                 MAKE ROOM FOR ID CODE
          SX3    14B
          BX6    X1+X3
          SA6    A6+B1             STORE IN FDB 
 CHAN72A  SA1    PW                PASSWORD 
          ZR   X1,CHAN75           JUMP IF NOT SPECIFIED
          LX1    60-6              RIGHT JUSTIFY
 CHAN73   BX3    X2*X1
          NZ   X3,CHAN74           EXIT 
          AX1    6
          EQ   CHAN73              LOOP 
 CHAN74   LX1    6
          SX3    20B               PW CODE
          BX6    X1+X3
          SA6    A6+B1             IN FDB 
 CHAN75   SA1    FDB+7             MULTIREAD
          BX6    X1 
          SA6    A6+B1
          SA1    A1+B1             END OF FDB 
          BX6    X1 
          SA6    A6+B1
          SYSTEM   PFA,RECALL,FDB+4  ATTACH THE FILE
          SA1    FDB+4             CHECK RETURN CODE
          AX1    9
          MX2    51 
          BX1    -X2*X1 
          NZ   X1,ER144            JUMP IF NOT OBTAINED 
* 
          ENDIF 
* 
* 
* 
 WRAP     BSS    0
* 
*   WRAP UP THIS PROGRAM - CLOSE ALL FILES
* 
* 
*    BUT FIRST CHECK TO SEE IF WE ARE IN CID MODE 
* 
          SA1    DBUGON      FETCH CID MODE FLAG
          NZ     X1,CON1     BR,CID MODE
*                            DONT CLOSE ANY FILES IN CID MODE 
          RJ     BASWRAP     NORMAL MODE - CLOSE ALL FILES
 CON1     BSS    0
* 
          IFC    EQ,,"OS.NAME",KRONOS,
* 
*     MAKE NEW FILE PRIMARY IF POSSIBLE 
* 
          SA1    JOPR              CHECK JOB ORIGIN 
          LX1    36 
          SX1    X1-TXOT
          NZ   X1,CLOSE            JUMP IF NOT INTERACTIVE
          SA1    LFN               PUT NAME IN FET
          BX6    X1 
          SX1    1
          BX6    X6+X1
          SA6    FET
          SYSTEM   LFM,RECALL,FET,31B*100B   MAKE IT PRIMARY
*         IF UNSUCCESSFULL (EG DIRECT ACCESS) IT DOES NOT MATTER
* 
* 
 CLOSE    BSS    0
          ENDIF 
* 
* 
*  CLOSE OLD FILE IF DIFFERENT FROM NEW AND NOT INPUT 
* 
          SA1    OLDFILE           OLD FILE FLAG
          NZ   X1,OLD1             JUMP IF NAME EXISTS FROM COMPILER
          SA1    PGNR              THIS WAS BINARY EXECUTION
          MX2    42                SO USE FILENAME FROM LOADER WORD 
          BX1    X1*X2
 OLD1     SA2    LFN               NEW FILENAME 
          BX2    X2-X1
          ZR   X2,SRCCHEK          JUMP IF OLD=NEW
          SA2    INP               *INPUT*
          BX2    X2-X1
          ZR   X2,SRCCHEK          JUMP IF OLD=INPUT
          BX6    X1                CLOSE OLD
          SX1    1
          BX6    X6+X1
          SA6    FET
          SX6    BUF               RESET IN, OUT
          SA6    A6+2 
          SA6    A6+B1
          CLOSE  FET,RETURN,RECALL
* 
 SRCCHEK  BSS    0
* 
*  DETERMINE IF FILE IS SOURCE OR BINARY
* 
          SA1    LFN               PREPARE TO READ FIRST PRU OF FILE
          BX6    X1                PUT LFN IN FET 
          SX1    1
          BX6    X6+X1
          SA6    FET
          SX6    BUF               RESET IN,OUT 
          SA6    FET+2
          SA6    A6+B1
          MX7    0                 PUT ZERO IN BUF IN CASE FILE EMPTY 
          SA7    X6 
          REWIND   FET,RECALL 
* 
          READ   FET,RECALL        READ ONE PRU 
          SA1    BUF               CHECK FIRST CHARACTER OF FILE
          SX2    77B
          LX1    6
          BX1    X1*X2             FIRST CHAR 
          BX6    X1-X2             COMPARE TO 77B (77-TABLE FOR BINARY) 
          SA6    SOURCE            ZERO IF BINARY 
* 
          REWIND   FET,RECALL 
* 
          SA1    DBUGON      CHECK FOR CID MODE 
          NZ     X1,INCRFL   BR, IN CID MODE WE DONT SETUP
                             THE LOW CORE CELLS BECAUSE CIDS
                             LIST OF FILES USES THEM
* 
          SA1    SOURCE 
          ZR   X1,INCRFL           JUMP IF BINARY 
* 
*   SET UP LOW CM FOR COMPILER AS IF CRACKED CONTROL CARD 
*   I=LFN,L=0,AS=0.  OR  I=LFN,L=0,AS.
* 
          SA1    LOWCM             I= 
          BX6    X1 
          SA6    2
          SA1    A1+B1             LFN, 
          SA2    LFN
          BX6    X1+X2
          SA6    A6+B1
          SA1    A1+B1             L= 
          BX6    X1 
          SA6    A6+B1
          SA1    A1+B1             0, 
          BX6    X1 
          SA6    A6+B1
          SA2    ASOPT
          NZ     X2,CHAN100        JUMP IF ASCII
          SA1    A1+B1             AS=
          BX6    X1 
          SA6    A6+B1
          SA1    A1+B1             0. 
          BX6    X1 
          SA6    A6+B1
          SX6    6                 SET PARAMETER COUNT
          EQ    CHAN101 
 CHAN100  SA1    A1+3              AS.
          BX6    X1 
          SA6    A6+B1
          SX6    5                 SET PARAMETER COUNT
 CHAN101  BSS    0
          SA6    PGNR              STORE AT RA+64B
* 
* 
 INCRFL   BSS   0 
* 
* 
* 
*         SINCE WE OPERATE IN A POSSIBLE CMM ENVIRONMENT, WE MUST CHECK 
*           FOR THE POSSIBILITY THAT CMM EXISTS. FOR SIMPLICITY, IF CMM 
*           EXISTS IN MEMORY (SATISFIED WEAK EXTERNAL), WE CALL MEM IN
*           SUCH A WAY AS TO INSURE CMM IS NOT ACTIVE. THIS PROTECTS OUR
*           LDV AND MEM REQUESTS FROM BEING ABORTED SINCE THEY ASSUME 
*           A NON-CMM ENVIRONMENT. THIS ALLOWS CODE FROM HERE ON TO 
*           FORGET ABOUT THE DUAL ENVIRONMENT, KEEPING LOGIC SIMPLE.
* 
* 
*         CHECK FOR CMM BEFORE CHANGING FL
* 
          SX6    =YCMM.ALF
          PL     X6,INCRFL2  IF CMM IS LOADED.
          BX6    X6-X6
          SA6    MEMAREA
          MEMORY CM,MEMAREA,RECALL  REQUEST CURRENT FL OF NON-CMM JOB 
          EQ     INCRFL3     CHECK IF CURRENT FL IS ENOUGH
* 
* 
*         FOLLOWING SPECIAL CASE CODE SETS BIT 2 OF THE MEM REQUEST WORD
*           SO MEM THINKS WE ARE CMM. THIS ALSO RESULTS IN THE CONTROL
*           POINT CMM-ACTIVE INDICATOR BEING SET (IF NOT ALREADY SET).
* 
 INCRFL2  SX6    1S2         (X6) = BIT 2 SET 
          SA6    MEMAREA
          MEMORY CM,MEMAREA,RECALL  INSURE CMM-ACTIVE SET 
*                                                                       000150
*         FOLLOWING SPECIAL CASE CODE SETS BITS 2 AND 3 OF MEM REQUEST
*           WORD. THIS IS SO MEM WILL THINK WE ARE CMM (BIT 2), AND TURN
*           OFF THE CONTROL POINT CMM-ACTIVE INDICATOR (BIT 3). THIS
*           WILL ALLOW US TO LATER ALTER THE RUNNING FL OR CALL LDV AS
*           IF WE WERE A NON-CMM PROGRAM. 
* 
          SX6    1S2+1S3     (X6) = BITS 2 AND 3 SET. 
          SA6    MEMAREA
          MEMORY CM,MEMAREA,RECALL  REQUEST CURRENT FL, CLEAR CMM-ACTIVE
* 
*         INSURE ENOUGH FL TO LOAD COMPILER OR BINARY FILE. AT THIS 
*           POINT WE KNOW CMM CANNOT BE ACTIVE, SO FORGET ABOUT IT. 
*                                                                       000420
 INCRFL3  SA1    MEMAREA     (X1) = 30/FL,30/STUFF
          AX1    30D         (X1) = FL
          SX1    X1-CMVALUE                                             000440
          PL     X1,INCRFL4  IF CURRENT FL >= MIN REQUIRED (CMVALUE)
          SX6    CMVALUE
          LX6    30D         (X6) = 30/REQUIRED FL,30/0 
          SA6    MEMAREA
          MEMORY CM,MEMAREA,RECALL REQUEST CHANGE IN FL 
 INCRFL4  SA1    MEMAREA     (X1) = 30/CURRENT FL,30/STUFF
          AX1    30D
          SA0    X1          (A0) = CURRENT FL
* 
          SX6    B0                TURN OFF ERROR RECOVERY               BAS0015
          SA6    70B               MAKE SURE ZERO AT DUMMY ADDRESS       BAS0015
          SA1    DBUGON      FETCH CID MODE FLAG
          NZ     X1,CON2     BR, CID ACTIVE 
       SA1    RPVRSET        FETCH RPV RESET
       BX6    X1
       SA6    RPVBLK
       MX6    0 
       MX7    0 
       SA6    RPVBLK+3      CLEAR RPV ERROR MASK
       SA7    A6+B1         CLEAR ANY PENDING INTERRUPTS
       SA6    A7+B1         CLEAR ANY RA+1 REQUESTS 
       SA7    A6+B1         CLEAR ANY INTERRUPTED INPUT REQUESTS
       SYSTEM RPV,R,RPVBLK,1
* 
 CON2     BSS    0
          SA1    SOURCE 
          ZR   X1,BINFILE          JUMP IF FILE IS BINARY 
* 
* 
*    LOAD THE COMPILER OVER US
* 
          SA2    INFOBF2           ADDR OF PARAMETER BLOCK
          MX6    59 
          IFC    EQ,,"OS.NAME",SCOPE ,
*  CLEAR BIT 0 IN FIRST WORD OF PARAMETER BLOCK BEFORE
*  ISSUING THE -FILINFO- MACRO ON NOS/BE. 
          BX6    X2*X6             CLEAR BIT 0. 
          ELSE
*  SET BIT 0 TO -1- IN FIRST WORD OF PARAMETER BLOCK
*  BEFORE ISSUING THE -FILINFO- MACRO ON NOS. 
          BX6    -X6+X2            SET BIT 0. 
          ENDIF 
          SA6    A2 
          FILINFO INFOBF2   SEE IF BASIC IS LOCAL 
          SA1    INFOBF2+1
          ZR   X1,CALLSYS          JUMP IF NO LOCAL FILE
          SA3    NAMEBAS           LOAD FROM FILE. GET FILE NAME (BASIC)
          SA1    PGNR              GET NEW PAR COUNT
          BX6    X3+X1             ADD FILE NAME (BASIC)
          SA6    A1                RESTORE INTO RA+64B
          SA1    LDVAREA+2         REQUEST WORD FOR LOAD FROM FILE
          EQ   CALLIT 
 CALLSYS  BSS    0                 LOAD FROM SYSTEM 
          SA1    LWPR              SET LIBRARY BIT (18) IN LWPR (RA+65B)
          MX2    1
          LX2    19 
          BX6    X1+X2
          SA6    A1 
          SA3    NAMENUC           USE FILE NAME NUCLEUS
          SA1    PGNR              GET NEW PAR COUNT
          BX6    X3+X1             ADD FILE NAME (NUCLEUS)
          SA6    A1                RESTORE INTO RA+64B
          SA1    LDVAREA+1         REQUEST WORD FOR LOAD FROM SYSTEM
* 
 CALLIT   BX6    X1                SET UP LOADER REQUEST IN RA+60,61B 
          SA6    61B
          SA1    LDVAREA
          BX6    X1                FILENAME OR OVERLAY NAME (BASIC) 
          SA6    60B
          RJ     DXMESS            DISPLAY EXECUTION TIME 
          SA1    DBUGON      FETCH CID MODE FLAG
          NZ     X1,CON3     BR, CID ACTIVE 
          SYSTEM   LDV,,60B 
 CALLIT1  SYSTEM   RCL             WAIT TO BE OVERLAYED 
          EQ   CALLIT1
* 
* 
*  LOAD BINARY FILE OVER US 
* 
 BINFILE  BSS    0
          SA1    LFN               PUT FILENAME IN RA+64B 
          BX6    X1 
          SA6    PGNR 
          RJ     DXMESS            DISPLAY EXECUTION TIME 
          SA1    DBUGON      FETCH CID MODE FLAG
          NZ     X1,CON3     BR, CID ACTIVE 
          SYSTEM   LDV             CALL LOADER
 BIN2     SYSTEM   RCL             WAIT TO BE OVERLAYED 
          EQ   BIN2 
* 
* 
 CON3     BSS    0
* 
*   CONTROL PASSES HERE WHEN CID IS ACTIVE TO ISSUE 
*   AN ENDRUN 
* 
*   NOTE: 
*        CHAINING UNDER CID IS INHIBITED
* 
          ENDRUN             TERMINATE - CID MODE 
* 
* 
* 
*  SUBROUTINES
* 
* 
 SCAN     DATA   0                 SCAN UP TO COMMA, EQUALS, OR EOS 
*  RETURN X6 = CHAR STRING,  B7 = DELIMITER 
          SB3    9                 MAX STRING LENGTH
          MX6    0                 CLEAR RESULT 
 SCAN1    BSS    0                 GET NEXT CHARACTER 
          NZ   B5,SCAN2            MORE IN WORD 
          SA1    A1+B1             NEXT WORD
          SB5    10 
 SCAN2    LX1    6                 NEXT CHAR
          SB5    B5-B1
          BX4    X2*X1             ISOLATE
          SB7    X4                POSSIBLE DELIMITER 
          EQ   B6,B7,SCAN3         EQUALS SIGN
          ZR   B7,SCAN3            EOS (ASSUME) 
          SX5    X4-1R, 
          ZR   X5,SCAN3            COMMA
          LX6    6                 NOT DELIM, ADD CHAR TO RESULT
          BX6    X6+X4
          SB3    B3-B1             SPACE LEFT IN RESULT 
          NG   B3,ER145            RESULT LONGER THAN MAX LENGTH
          EQ   SCAN1               LOOP FOR NEXT CHAR 
* 
 SCAN3    BSS    0                 DELIMITER MET
          SB3    B3+B1             LEFT JUSTIFY RESULT
 SCAN4    ZR   B3,SCAN             EXIT WHEN RESULT POSITIONED
          LX6    6
          SB3    B3-B1
          EQ   SCAN4               LOOP 
* 
* 
* 
 DECODE   DATA   0                 CONVERT KEYWORD TO ADDR
*  ENTRY X6 = KEYWORD,  EXIT X7 = ADDR
          MX4    42 
          SA5    KEYTAB-1          PRESET A5
 DECODE1  SA5    A5+B1             NEXT TABLE ENTRY 
          ZR   X5,ER145            NOT FOUND IN TABLE 
          BX7    X4*X5             ISOLATE KEYWORD
          BX7    X6-X7             COMPARE
          NZ   X7,DECODE1          NOT EQUAL, LOOP FOR NEXT 
          SX7    X5                EXTRACT ADDR 
          EQ   DECODE              RETURN 
* 
* 
* 
 CHKVAL   DATA   0                 CHECK VALUE OF PARAMETER 
*  CHECK THAT VALUE IN X1 IS EQUAL TO X3 FOR AS MANY CHARACTERS 
* AS ARE SPECIFIED IN X1.  EG. ALLOW  A,AS,ASC,ASCI,ASCII  FOR ASCII
          LX3    6                 FIRST CHAR WAS ALREADY CHECKED 
 CHKVAL1  LX1    6                 NEXT CHAR
          BX4    X2*X1
          ZR   X4,CHKVAL           EXIT IF DONE 
          LX3    6                 CHAR MUST MATCH NEXT IN PATTERN
          BX5    X2*X3
          BX5    X5-X4             COMPARE
          NZ   X5,ER145            NO MATCH, BAD PARAM
          EQ   CHKVAL1             LOOP 
* 
* 
*   DATA AREAS
* 
* 
 KEYTAB   BSS    0                 TABLE OF KEYWORDS AND ADDRESSES
          VFD    42/2LUN,18/UN     UN 
          VFD    42/2LID,18/UN     ID=UN
          VFD    42/2LPW,18/PW     PW 
          VFD    42/4LMODE,18/ASOPT   MODE
          DATA   0                 END OF TABLE 
* 
* 
 LOWCM    BSS    0                 CRACKED CONTROL CARD IMAGE 
          VFD    54/1LI,6/2        I= 
          VFD    54/0,6/1          (LFN), 
          VFD    54/1LL,6/2        L= 
          VFD    54/1L0,6/1        0, 
          VFD    54/2LAS,6/2       AS=
          VFD    54/1L0,6/17B      0. 
          VFD    54/2LAS,6/17B     AS.
* 
          BSS    1                 THIS AND FOLLOWING 4 WORDS MUST BE CONTIGUOUS
 LFN      BSS    1                 NAME OF FILE TO CHAIN TO 
 UN       BSS    1                 USER NUMBER (ID) 
 PW       BSS    1                 PASSWORD 
 ASOPT    BSS    1                 NONZERO IF MODE IS ASCII 
          DATA   L*ASCII*          VALUES FOR MODE PARAM
          DATA   L*NORMAL*
* 
 SOURCE   BSS    1                  NONZERO IF FILE IS SOURCE 
 INP      DATA   L*INPUT* 
* 
 LDVAREA  DATA   L*BASIC*          LOADER PARAMETERS
          VFD    6/0,6/0,12/0141B,18/0,18/000B   FROM SYSTEM
          VFD    6/0,6/0,12/0041B,18/0,18/000B   FROM FILE
 NAMENUC  DATA   L*NUCLEUS*        FILE NAME FOR SYSTEM LOAD OF COMPILER
 NAMEBAS  DATA   L*BASIC*          FILE NAME FOR FILE LOAD OF COMPILER
 INFOBUF  VFD    42/0,6/5,12/1
          BSSZ   4
 INFOBF2  VFD    42/0LBASIC,6/5,12/1
          BSSZ   4
 MEMAREA  BSS    1                 MEM PARAMETER AREA 
          IFC    EQ,,"OS.NAME",KRONOS,
 FET      BSS    0                 FET TO GET, ATTACH, READ FILE
          VFD    60/0              FILENAME 
          VFD    12/0,3/0,1/1,20/0,6/6,18/BUF    EPR,LEN,FIRST
          VFD    60/0              IN 
          VFD    60/0              OUT
          VFD    60/BUFEND         LIMIT
          DATA   0,0,0,0           UNUSED 
          VFD    60/0              USER NUMBER
          VFD    42/0,18/BUF       PASSWORD, MSG AREA 
          ELSE
 FDB      BSS    0                 FDB FOR ATTACH 
          BSS    1                 PERMFILENAME 
          DATA   0,0,0
          BSS    1                 LFN, ATTACH CODE 
          BSS    1                 54/ID,6/14B
          BSS    1                 54/PW,6/20B
          VFD    54/1,6/11B        MULTIREAD
          VFD    48/1H ,12/0       END OF FDB 
 FET      BSS    0                 FET FOR READ, CLOSE
          BSS    1                 FILENAME 
          VFD    60/BUF            FIRST
          BSS    2                 IN, OUT
          VFD    60/BUFEND         LIMIT
          ENDIF 
 BUF      BSS    65 
 BUFEND   BSS    0
* 
 BATCHAN  BSS    0
          END 
