
      HED ASSIGN
      SPC 2 
* THE ASSIGN ROUTINE IS USED BY THE BASIC STATEMENT EXECUTION PROCESSOR 
* (PHASE III) TO PROCESS AN ASSIGN STATEMENT. THE PURPOSE OF THE ROU- 
* TINE IS TO REPLACE THE INFORMATION CURRENTLY IN THE FILE CONTROL
* BLOCK REFERENCED BY A SPECIFIED ORDINAL NUMBER WITH INFORMATION ABOUT 
* THE NEW FILE BEING ASSIGNED TO THAT ORDINAL NUMBER. INPUT PARAMETERS
* TO THE ASSIGN ROUTINE ARE AS FOLLOWS: 
* 
*     ASBFP: => BUFFER CONTAINING FILE NAME 
*     ASNID: 0= USER LIBRARY, 1= SYSTEM LIBRARY, 2= GROUP LIBRARY 
*     ORDNO: SPECIFIED ORDINAL NUMBER 
*     FILTB: => FILE TABLE
* 
* THE CALLING SEQUENCE TO THE ASSIGN ROUTINE IS AS FOLLOWS: 
* 
*     JSB SCHLB,I 
*     DEF ASNIB 
*     <EXIT FOR RECORD SIZE TOO LARGE>
*     <EXIT FOR NON-EXISTENT FILE>
*     <EXIT FOR 'READ-ONLY' (GROUP OR SYSTEM LIB.) FILE>
*     <EXIT FOR 'READ-ONLY' (IN USE) FILE>
*     <NORMAL EXIT> 
      ORG LIBRA 
      LDA MLINK+1   GET USER ID AND STORE 
      ADA .+?ID-?LINK 
      LDA 0,I 
      STA ASNID 
* 
      AND HI6       LOSE NUMERICS 
      STA LTEMP     SAVE
      LDA ASNID     GET THE ID BACK 
      XOR LTEMP     LOSE THE TOP
      CLB           SET UP FOR DIVISION 
      DIV .100      PRODUCE GROUP 
      MPY .100        LIBRARY ID
      IOR LTEMP         AND SAVE
      STA LTEMP           IN LTEMP
      LDA TEMP1     WAS A PROTECT                [B]
      CPA PRGCT       MASK REQUESTED?            [B]
      JMP ASN1      NO                           [B]
      LDA A,I       MAYBE                        [B]
      AND OPMSK                                  [B]
      CPA B2000     COMMA NEXT?                  [B]
      RSS           YES                          [B]
ASN1  CLA,RSS       NO, CLEAR MASK BIT           [B]
      LDA BIT15     SET MASK BIT                 [B]
      STA AMASK                                  [B]
      LDA ASFBF     INITIALIZE INFORMATION
      STA ASBUF       BUFFER POINTER
* 
      LDB ASNID     GET USER ID 
      LDA ASTYP     GET LIBRARY INDICATOR 
      CPA .+1       SYSTEM LIBRARY? 
      LDB A000      YES 
      CPA .+2       GROUP LIBRARY?
      LDB LTEMP     YES 
      STB ASBUF,I   STORE CORRECT ID IN BUFFER
* 
      LDA ORDNO     SAVE SPECIFIED
      STA ASORD       ORDINAL NUMBER
      MPY .+FTEL    SAVE POINTER
      ADA FILTB       TO FILE TABLE 
      STA ASFCB         ENTRY 
      INA 
      LDB A,I       CLEAR 
      CLE,ELB         "DIRTY" RECORD AND
      CLE,ELB           "DIRTY" FILE
      RBR,RBR             BITS
      STB ASSAV     SAVE OLD RECORD SIZE
      SEZ,RSS       DID WRITE OCCUR ON OLD FILE?
      JMP ASN21     NO
* 
* UPDATE LAST CHANGED DATE OF OLD FILE
* 
      LDB ASNID     YES, SET UP 
      STB LTEMP       LTEMP(0:3)
      ADA .+10          WITH OLD
      LDB 0,I             FILE NAME 
      STB LTEMP+1 
      INA 
      DLD 0,I 
      DST LTEMP+2 
      LDA ASBFP     SAVE
      LDB 0,I         NEW FILENAME
      STB LTEMP+10      BEFORE SWAP 
      INA                 OCCURS
      DLD 0,I 
      DST LTEMP+11
      JSB DLOKP,I   FIND DIRECTORY ENTRY FOR OLD FILE 
      RSS 
      JMP ASN20     NOT FOUND 
      LDA LTEMP+4   SAVE CURRENT
      ADA .+5         DIRECTORY TRACK 
      STA DIRWD         FOR DLOOK 
      LDA DATIM     GET HOUR OF YEAR
      LDB LTEMP+5     AND UPDATE
      ADB .+6           'LAST CHANGE' 
      STA 1,I             LOCATION
ASN20 LDA LTEMP+10  GET 
      STA LTEMP+1 
      DLD LTEMP+11    NEW 
      DST LTEMP+2 
      JMP ASN22 
ASN21 LDB ASBFP 
      LDA 1,I           FILE NAME 
      STA LTEMP+1 
      INB                 IN
      DLD 1,I 
      DST LTEMP+2      LTEMP(1:3) 
ASN22 LDA ASBUF,I   SET APPROPRIATE 
      STA LTEMP       ID IN LTEMP 
* 
      JSB DLOKP,I   SEARCH FOR FILE 
      CLB,RSS       IF FOUND, CLEAR B 
      CCB           IF NOT, B GETS -1 
      LDA LTEMP+4   GET CURRENT 
      ADA .+5         DIRECTORY TRACK POINTER 
      CPA DIRWD     SAME AS OTHER ONE?
      JMP ASN23     YES (SO NONE HAS BEEN WRITTEN)
      CLA           NO, SO UPDATED ONE HAS
      STA DIRWD       BEEN WRITTEN OUT
ASN23 SZB,RSS       IF ENTRY WAS FOUND
      JMP ASN4        GO CHECK IT OUT 
ASN24 ISZ SCHLQ 
ASN3  LDA DIRWD     IS THERE A CHANGED
      SZA,RSS         DIRECTORY TRACK IN CORE?
      JMP ASN26     NO
      CLB           YES, TELL DLOOK 
      STB DIRWD       THERE ISN'T 
      LDB LIBD          AND WRITE 
      JSB DISCZ,I         IT OUT
      JSB SLVAG,I   BLEW IT!  TRY TO SALVAGE
ASN26 JSB RDPRG 
      JMP ASN14 
ASN4  LDB LTEMP+5   IS THE
      ADB .+2         ENTRY WE
      LDA B,I           FOUND 
      SSA,RSS             A FILE? 
      JMP ASN24     NO, FAIL
      LDB LTEMP+5   IS OWNER
      LDA B,I         TRYING TO 
      CPA ASNID         ACCESS FILE?
      JMP ASN45     YES 
      INB           NO, IS FILE 
      LDA B,I         PROTECTED?
      SSA 
      JMP ASN24     YES - FAIL
      ADB .+2 
      LDA B,I       IS MASK 
      SSA,RSS         BIT SET?
      JMP ASN48     NO
      LDB MLINK+1   YES 
      ADB .+?NAME-?LINK 
      LDA B,I       IS THIS FILE RUNNING
      SSA,RSS         UNDER A PROTECTED PROGRAM?
      JMP ASN24     NO - FAIL 
      ADB .+?FLAG-?NAME 
      LDA B,I       GET PROGRAM 
      AND PUALT       UNALTERED BIT 
      SZA,RSS       HAS PROGRAM BEEN JIMMIED? 
      JMP ASN24     ATTEMPTED RIP-OFF, FAIL 
      JMP ASN48 
* 
ASN45 LDB LTEMP+5   SET MASK                     [B]
      ADB .+3                                    [B]
      LDA B,I         BIT IF ONE                 [B]
      IOR AMASK                                  [B]
      STA B,I           REQUESTED                [B]
* 
ASN48 LDB LTEMP+5 
      ADB .+4       GET LOGICAL 
      LDA B,I         RECORD SIZE 
      STA ASBUF,I       AND SAVE IT 
      CMA,INA       IS IT LARGER
      ADA ASSAV       THAN THE ALLOCATED
      SSA               BUFFER? 
      JMP ASN3      YES, FAIL 
      ISZ SCHLQ     NO
      ISZ ASBUF 
      CLA 
      STA ASBUF,I 
      ISZ ASBUF 
      ADB .+4 
      LDA 1,I       PUT 
      STA ASBUF,I     DISC
      INB               ADDRESS 
      ISZ ASBUF           IN
      LDA 1,I           BUFFER
      STA ASBUF,I 
      ADB .+2 
      ISZ ASBUF 
      LDB 1,I 
      LDA ASNID     TEST FOR USER REFERENCE 
      CPA LTEMP       TO PUBLIC FILE
      RSS 
      ADB BIT15     SET BIT 15 OF LENGTH IF IT IS 
      STB ASBUF,I   STORE LENGTH IN BUFFER
      JSB DATE      GET DATE AND SET IN 
      LDB LTEMP+5     PURGE LOCATION
      ADB .+5 
      STA 1,I 
      CLA           TELL DLOOK THAT NO DIRECTORY
      STA DIRWD       TRACK IS IN CORE AND
      LDA LTEMP+4       WRITE IT BACK 
      ADA .+5 
      LDB LIBD
      JSB DISCZ,I 
      JSB SLVAG,I   SCREWED UP - TRY TO SALVAGE 
* 
      ISZ SCHLQ     FILE EXISTS--BUMP RETURN ADDRESS
      LDA M2000     INPUT FUSS TABLE
      STA MWORD 
      LDA FUSS
      LDB LIBDI 
      JSB DISCZ,I 
      JSB SICKP,I   ITS STUCK ON THE DISC 
* 
      LDA MLINK+1   DETERMINE USER #
      ADA ASNSP 
      CLB 
      DIV .+TTY01-TTY00 
      ALF,RAL       MULTIPLY USER# BY 32 AND
      ADA LIBD        ADD LIBD TO POINT TO USER'S 
      STA ASUFS 
      LDB ASORD         SECTION OF FUSS 
      BLS 
      ADA 1         SET POINTER TO FUSS 
      STA ASNFS       ENTRY FOR THE 
      CLA               SPECIFIED ORDINAL NO. 
      CLB 
      DST ASNFS,I   ZERO OUT OLD FILE INFORMATION 
* 
      CLA           SAY ENTRY NOT YET 
      STA ASNIF       FOUND IN FUSS TABLE 
* 
ASN6  LDB LIBD
      LDA ASBUF 
      ADA .-2 
      LDA 0,I       GET FIRST WORD OF DISC ADDRESS
ASN7  CPB ASUFS     SKIP OVER 
      ADB .+32       USERS OWN FUSS 
      CPB L1024     ALL FUSS CHECKED? 
      JMP ASN11     YES, NOT THERE
      CPA 1,I       TEST FOR THERE
      JMP ASN9      IT IS 
      ADB .+2       BUMP FUSS POINTER 
      JMP ASN7      LOOK AT NEXT ENTRY
* 
ASN9  LDA ASBUF 
      ADA .-1       GET 2ND WORD OF ADDRESS 
      LDA 0,I 
      INB           BUMP FUSS TO 2ND WORD 
      CPA 1,I       ARE THEY EQUAL? 
      JMP ASN10     YES 
      INB           MOVE TO NEXT FUSS ENTRY 
      JMP ASN6+1    RETURN TO CHECKING FUSS 
* 
ASN10 EQU * 
      STB ASNIF     SET TO SAY "IN FUSS"
      LDA ASNID     IS THIS 
      AND M2000       AN "A"
      CPA A000          USER? 
      JMP ASN11     YES 
      LDA ASBUF,I   SET DISC LENGTH TO SAY
      IOR BIT15       READ ONLY 
      STA ASBUF,I 
* 
ASN11 LDA ASBUF 
      ADA .-2 
      LDA 0,I       GET HIGH DISC ADDRESS 
      LDB ASBUF,I   GET LENGTH
      SSB,RSS       IF READ ONLY, 
      JMP ASN30 
      IOR BIT15     SET BIT 15 OF HIGH ADDRESS, AND 
      LDB ASNID         SKIP 1 OR BOTH RETURN INCREMENTS, 
      CPB LTEMP           DEPENDING ON REASON FOR 
      JMP ASN31 
      JMP ASN32 
ASN30 EQU * 
      LDB ASNIF     READ-WRITE; WAS IT
      SZB,RSS         IN FUSS?
      ISZ SCHLQ     NO, BUMP TWICE
ASN31 EQU * 
      ISZ SCHLQ 
ASN32 EQU * 
      LDB ASBUF 
      ADB .-1 
      LDB 1,I       GET LOW ADDRESS IN B
      DST ASNFS,I   STORE NEW FUSS INFORMATION
* 
      LDA FUSS      WRITE FUSS BACK TO DISC 
      LDB LIBD
      JSB DISCZ,I 
      JSB SICKP,I   CAN'T GET RID OF IT 
* 
      JSB RDPRG     READ USER'S PROGRAM BACK IN 
      LDB ASBUF 
      LDA 1,I       GET LENGTH WORD 
      STA ASFCB,I     AND STORE IT
      ISZ ASFCB 
      ADB .-4 
      LDB 1,I       GET NEW RECORD SIZE 
      STB ASFCB,I     AND STORE IT
      ISZ ASFCB 
      ELA,CLE,ERA   REMOVE BIT 15 FROM LENGTH 
      ADA .-2       COMPUTE RELATIVE
      SLA,INA,SZA     ADDRESS OF LAST 
      ADA .-1           LOGICAL RECORD
      LDB ASBUF     GET ADDRESS 
      ADB .-2         OF HIGH DISC ADDRESS
      STB ASSCH         AND SAVE IT 
      INB           GET POINTER TO LOW DISC ADDRESS WORD
      CLE 
      ADA 1,I       ADD RELATIVE LAST RECORD ADDRESS
      LDB ASSCH,I   B GETS HIGH DISC ADDRESS WORD 
      SEZ           IF LOW ADDRESS OVERFLOWS, 
      INB             ADD 1 TO HIGH PART
      SWP           STORE BOTH WORDS OF 
      DST ASFCB,I     DISC ADDRESS
      LDA ASFCB 
      ADA .+4 
      STA ASFCB 
      DLD ASSCH,I   STORE BASE DISC ADDRESS 
      DST ASFCB,I     INTO FILE TABLE 
      ISZ ASFCB     ADJUST POINTER
      LDA ASFCB     SET 
      ADA .-3         'NULL RECORD' 
      LDB BIT15         CONDITION 
      STB 0,I 
      LDA ASBUF 
      ADA .-4 
      LDB ASSAV 
      CMB,INB       COMPUTE DIFFERENCE BETWEEN
      ADB 0,I         OLD AND NEW BUFFER SIZES
      ISZ ASFCB 
      LDA ASFCB,I 
      ADA 1         ADJUST BUFFER 
      STA ASFCB,I     ADDRESS 
      ISZ ASFCB 
      STA ASFCB,I   SET 'RECORD FULL' CONDITION 
      ISZ ASFCB 
      CLA           SET 'NO EOF EXIT' 
      STA ASFCB,I     CONDITION 
      ISZ ASFCB 
      LDA ASBFP     MOVE
      LDB 0,I         FILE NAME 
      STB ASFCB,I       TO
      INA                 FILE TABLE
      ISZ ASFCB 
      DLD 0,I 
      DST ASFCB,I 
* 
ASN14 EQU * 
      JSB ABCHK 
      JMP SCHBL     ALL DONE
AMASK BSS 1                                      [B]
HI6   OCT 176000
ASNSP ABS -TTY00-?LINK
ASFCB EQU LTEMP+6   POINTER TO ORDINAL ENTRY IN FILE
*                                   TABLE 
ASORD EQU LTEMP+7   ORDINAL FILE # IN FUSS ENTRY
ASNFS EQU LTEMP+8   POINTER TO ORDINAL ENTRY IN FUSS
*                                   TABLE 
ASNID EQU LTEMP+9   USER ID 
ASUFS BSS 1         POINTER TO USER FUSS ENTRY
ASSCH BSS 1         POINTER TO DISC ADDRESS IN
*                                   TEMPORARY BUFFER
ASSAV BSS 1         RECORD SIZE OF OLD FILE 
ASBUF BSS 1         BUFFER INDEX
ASNIF BSS 1         CLEAR UNLESS FILE IN FUSS 
ASFBF DEF *+1 
      BSS 6         TEMPORARY FILE TABLE INFORMATION
*                                   BUFFER
* 
* LTEMP, LTEMP+1, LTEMP+2, LTEMP+3, LTEMP+4, LTEMP+5, LTEMP+10, 
*   LTEMP+11, AND LTEMP+12 ARE ALSO USED
* 
$ASN  EQU * 
      HED CHAIN 
* THE CHAIN ROUTINE IS USED BY THE BASIC COMPILER TO PROCESS A CHAIN
* STATEMENT DURING PHASE III. THE PURPOSE OF THIS ROUTINE IS TO 
* CHECK FOR THE REQUESTED PROGRAM ON THE USER'S PRIVATE LIBRARY OR
* ON THE PUBLIC LIBRARY (IF THE NAME IS PRECEDED BY A DOLLAR SIGN)
* OR ON THE GROUP LIBRARY (IF THE NAME IS PRECEDED BY A SNOWFLAKE). 
* IF THE PROGRAM IS FOUND IT IS LOADED AND COMPILATION IS BEGUN.
      ORG LIBRA 
      LDA FCNTR     SET COUNTER TO
      CMA             1'S COMPLEMENT OF 
      STA FCNTR         NUMBER OF FILES 
      INA           PUT 2'S COMPLEMENT INTO 
      STA CHNP        SAFE KEEPING FOR LCD
      LDA FCORE     LOAD FIRST BUFFER ADDRESS 
      LDB FILTB     LOAD POINTER TO 
      ADB .+5         FIRST DISC ADDRESS (LOW WORD) 
CHN01 ISZ FCNTR     MORE FILES? 
      RSS           YES 
      JMP CHAN0     NO--FINISHED DUMPING BUFFERS
      STB FBASE     WRITE 
      STA RQ3         OUT 
      JSB WRBUF         RECORD
      LDB FBASE 
      ADB .+FTEL-4
      LDA 1,I 
      ALR,RAR 
      CMA,INA 
      ADB .+7 
      ADA 1,I 
      ADB .-3 
      JMP CHN01 
CHAN0 LDB MLINK+1 
      ADB .+?ID-?LINK 
      STB CHNI      => USER ID
      ADB .-?ID     CAN THERE BE
      LDA B,I         FILES WHOSE 
      AND DFCHK         LCD'S NEED
      SZA,RSS             UPDATING? 
      JMP CHN17     NO
      LDA CHNP      GET NEGATIVE FILE COUNT 
      ADB .+?ID       AND ID POINTER
      JSB LCDP,I    GO UPDATE LCD'S 
      RSS           CORE NOT CHANGED (OVERWRITTEN)
      JSB RDPRG     RESTORE USER AREA 
CHN17 LDA CHNI,I    GET USER'S ID 
      STA LTEMP    STORE IN LTEMP 
      LDA .-3 
      STA CHNP
      LDA TWOSP 
      LDB DLTEM 
CHN00 EQU * 
      INB           INITIALIZE
      STA B,I         NAME TO 
      ISZ CHNP          BLANKS
      JMP CHN00 
      CLA,INA       ALLOW STRING
      STA EOL         CONSTANT
      JSB FORMX     EVALUATE STRING 
      LDA .-2       PREPARE 
      JSB PSTR        STRING
      STA TEMP4     SAVE SOURCE POINTER 
      CPB .-1       NULL STRING?
      JMP CHAN4     YES 
      STB TPRME     SAVE LENGTH 
      LDB TEMP4     EXTRACT 
      CLE,ERB 
      LDA B,I         FIRST 
      SEZ,RSS 
      ALF,ALF           CHARACTER 
      AND B377
      CPA .+44B     '$'?
      JMP CHAN2     YES 
      CPA .+52B     NO, '*'?
      RSS           YES 
      JMP CHAN3     NO
      LDA LTEMP     GET USER'S ID 
      AND B1777     CONVERT 
      CLB            IT 
      DIV .100        TO
      MPY .100         ID 
      LDB A             OF
      LDA M2000          GROUP
      AND LTEMP           LIBRARIAN 
      IOR B                AND
      RSS 
CHAN2 EQU * 
      LDA A000      SET UP FOR PUBLIC LIBRARY 
      STA LTEMP     SAVE ID 
      ISZ TEMP4     BUMP SOURCE POINTER 
      ISZ TPRME     BUMP LENGTH 
CHAN3 EQU * 
      LDA TPRME 
      ADA .+7 
      SSA           LENGTH > 6? 
      CLA           YES, SET TO 6 
      ADA .-7       NO
      STA TPRME 
      STA TNULL 
      LDA DLTEM 
      INA 
      ALS 
      STA TEMP5     DESTINATION POINTER 
      LDA FCUCA     UPPER CASE ONLY 
      JSB TRSTR     TRANSFER STRING 
CHAN4 EQU * 
      CCB           SET FLAG FOR NO LINE NUMBER 
      LDA TEMP1 
      CPA PRGCT     END OF STATEMENT? 
      JMP CHAN5     YES 
      JSB FETCH     NO, GET LINE NUMBER 
      JSB SBFIX     ROUND TO INTEGER
      LDB DVSRS     ILLEGAL LINE NUMBER 
      INB           READJUST
CHAN5 EQU * 
      STB PKCNT     SAVE THE LINE NUMBER
      LDA SPROG 
      STA INWRD 
      JSB DLOKP,I   SEARCH DIRECTORY FOR PROGRAM
      RSS 
      JMP CHAN7     PROGRAM NOT FOUND 
      LDB CHNPD     CHECK ILL-STORED
      ADB .+4         PROGRAM FLAG
      LDA B,I 
      SSA,RSS       UNSUCCESSFULLY STORED?
      JMP CHN14     NO, CONTINUE
      LDA CHNI,I    GET USER'S ID 
      CPA LTEMP     DOES HE OWN THE PROGRAM?
      ISZ SCHLQ     YES, BUMP TO ILL-STORED MESSAGE 
      JMP CHAN7     NO, PRINT NONEXISTENT PROGRAM 
CHN14 ISZ SCHLQ     PAST SECOND ERROR 
      ISZ SCHLQ       AND ERROR 2.5 
      ADB .-2 
      LDA 1,I 
      SSA 
      JMP CHAN7     ENTRY IS A FILE 
      ISZ SCHLQ     PAST THIRD ERROR
* 
* FOUND CORRECT ENTRY. FIRST CHECK TO SEE IF IT FITS
* 
      ADB .-1       => FIRST WORD OF NAME 
      LDA B,I       MOVE PROTECTED BIT
      STA LTEMP+1     TO SAFE PLACE 
      ADB .+2       => THIRD WORD OF NAME 
      LDA 1,I       SAVE SEMI-
      STA LIBSC       COMPILED FLAG 
      INB 
      LDA 1,I       SAVE START-OF-
      ELA,CLE,ERA 
      STA LIBSP       PROGRAM POINTER 
      ADB .+7       GET PROGRAM LENGTH
      LDA 1,I 
      STA CHNLN 
      CMA,INA      COMPUTE FIRST
      ADA LIBSP       UNUSED WORD 
      STA LIBPB 
      CMA,INA      COMPUTE NEGATIVE 
      LDB LIBSC 
      SSB,RSS       SEMI-COMPILED?
      JMP CHN18     NO
      ADA LWAUS 
      SSA,RSS 
      JMP CHN11     OK
      JMP CHAN7     TOO BIG 
CHN18 EQU * 
      ADA LW97        TOTAL LENGTH
      SSA,RSS       COMPARE WITH MAX ALLOWED
      JMP CHN11 
      JMP CHAN7     PROGRAM TOO LARGE 
CHN11 EQU * 
      ISZ SCHLQ     PAST FOURTH ERROR 
      JSB DATE      SET NEW DATE
      LDB CHNPD      INTO 
      ADB .+5          DIRECTORY
      STA 1,I 
      ADB .+3       SET 
      DLD B,I         DISC
      DST CHNDI         ADDRESS 
      LDA CHNP,I   WRITE DIRECTORY
      STA MWORD       BACK TO 
      LDA CHNP         DISC 
      ADA .+5 
      LDB LIBD
      JSB DISCZ,I 
      JSB SICKP,I   QUE PASA? 
      LDB MLINK+1  SET TO NULL PROGRAM
      ADB .+?PROG-?LINK 
      LDA B,I       SAVE CURRENT
      STA CHNC        PROGRAM BOUND 
      LDA INWRD 
      STA 1,I 
      JSB RDPRG    READ IN FIXED AREA 
      LDB CHNLN 
      STB MWORD 
      LDB LIBSP 
      ADB BIT15     READ
      LDA CHNDP       PROGRAM 
      JSB DISCZ,I       FROM DISC 
      RSS           READ ERROR
      JMP CHN13 
      LDB MLINK+1 
      ADB .+?PROG-?LINK 
      LDA CHNC
      STA B,I 
      JMP CHAN7 
CHN13 LDA CHNI,I    GET USER'S ID 
      ISZ CHNI       TO FIRST WORD OF NAME
      LDB LTEMP+1   GET FIRST WORD
      CPA LTEMP     IF PROGRAM OWNER CLEAR
      ELB,CLE,ERB    RUN-ONLY BIT 
      STB CHNI,I   STORE FIRST WORD OF NAME 
      ISZ CHNI     BUMP POINTER TO NEXT WORD
      DLD LTEMP+2  GET LAST 2 WORDS OF NAME 
      DST CHNI,I   STORE IN TABLE 
      ISZ SCHLQ 
      JSB SEMIC 
      JSB ABCHK     ABORT ATTEMPT?
* 
* SET TO RUN
* 
      CLF 0 
      LDB MAIN
      LDA 1,I       DON'T ALLOW 
      IOR UNABT       ABORTS
      IOR CHNFG 
      STA 1,I           DURING COMPILE
      STF 0 
      LDA SYMTB 
      SZA,RSS       UNCOMPILED? 
      LDA PBPTR     YES, USE PBPTR
      LDB PKCNT     LINE NUMBER 
      SSB             SPECIFIED?
      JMP CHAN6     NO
      JSB FNDPS     FIND REFERENCED STATEMNET 
      JMP CHAN9     BAD LINE NUMBER 
      NOP 
      RSS 
CHAN6 EQU * 
      LDB SPROG     DEFAULT LINE NUMBER 
      STB PRGCT     SAVE FIRST STATEMENT
      ISZ SCHLQ 
CHAN8 EQU * 
      LDA .+40B 
      STA BLANK 
      JMP SCHBL 
CHAN9 JSB ABCHK 
      LDA CHNFG 
      CMA 
      LDB MAIN
      CLF 0 
      AND B,I       CLEAR CHAIN FLAG
      STA B,I 
      STF 0 
      JMP CHAN8 
CHAN7 JSB RDPRG     READ BACK USER PROGRAM
      JSB ABCHK     ABORT ATTEMPT?
      JMP SCHBL     NO
CHNDP DEF CHNDI 
TWOSP ASC 1,
PKCNT BSS 1 
INWRD BSS 1 
LCDP  DEF LCD 
CHNP  EQU LTEMP+4 
CHNPD EQU LTEMP+5 
CHNI  EQU LTEMP+6 
CHNC  EQU LTEMP+7 
CHNLN EQU LTEMP+10  PROGRAM LENGTH
CHNDI EQU LTEMP+14  DISC
*                         LTEMP+15    ADDRESS 
* 
*  LTEMP, LTEMP+1, LTEMP+2 AND LTEMP+3 ARE ALSO USED
* 
$CHN  EQU * 
