      HED KILL
* THE KILL ROUTINE IS USED TO DELETE A PROGRAM FROM THE USER
* LIBRARY. THE PROCESS IS AS FOLLOWS: 
*     1) CHECK FORMAT AND DETERMINE PROGRAM NAME. 
*     2) SEARCH DIRECTORY FOR ENTRY.
*     3) OBTAIN LOCATION AND LENGTH.
*     4) COLLAPSE DIRECTORY.
*     5) UPDATE ADT AND IDT.
      SPC 1 1
      ORG LIBRA 
      SPC 1 
      CCA           SET FLAG TO SAY WE HAVE TO CHECK
      STA KILTS      FOR BUSY FILE. 
      LDA MLINK+1   GET USER'S ID.
      ADA .+?ID-?LINK 
      LDA 0,I 
      STA LTEMP     STORE IN LTEMP. 
      STA ID
      LDA DLTEM     SET UP POINTER FOR
      INA           NAME. 
      STA KILP
      LDA .-3       SET UP COUNTER. 
      STA KILC
KIL1  JSB LCHAR     GET LEFT CHAR.
      LDA .+40B     BLANK IF NONE.
      ALF,ALF 
      STA KILP,I
      JSB LCHAR     GET RIGHT CHAR. 
      LDA .+40B 
      IOR KILP,I,u
      STA KILP,I
      ISZ KILP      BUMP POINTER. 
      ISZ KILC      ANY MORE? 
      JMP KIL1      YES.
      LDA LTEMP+1 
      CPA ASCBB 
      JMP KIL2      NO CHARS--ERROR.
      JSB LCHAR     TEST FOR TOO MANY.
      JMP KIL3      O.K.
* *q
KIL2  LDB *+3 
      LDA .-13
      JMP LIBER 
      DEF *+1 1;
      OCT 5111
      ASC 6,LLEGAL NAME 
* 
KIL3  JSB DLOOK     SEARCH DIRECTORY FOR PROGRAM. 
      RSS          FOUND IT                        [X]
* 
      JMP KIL4    NO SUCH PROGRAM                  [X]
* 
* FOUND ENTRY. NOW REMOVE IT
* 
      LDB KILPD     GET LOCATION OF DISC ADDRESS
      STB MOVED 
      ADB .+6 
      DLD 1,I       A=DISC ADDRESS, B=LENGTH. 
      STA KILD      SAVE THEM.
      STB KILN
* 
      ISZ KILTS     TEST FOR OK TO KILL.
      JMP KIL18     O.K.
      LDB KILPD     TEST FOR FILE.
      ADB .+2 
      LDA 1,I 
      SSA,RSS 
      JMP KIL18     NOT A FILE. 
* qq
      LDA M128     INPUT FUSSS TABLE
      STA WORD
      ARS    COMPUTE NUMBER OF ENTRIES
      STA KILC      SAVE IN KILC ALSO.
      LDA FUSS,I
      LDB LIBDI 
      JSB DISCL 
* 
      LDA MLINK+1   COMPUTE USER'S
      ADA KILSP      PORT #.
      CLB 
      DIV .+TTY01-TTY00 
      ALF,RAR      COMPUTE LOCATION OF           X] 
      ADA LIBD       USER'S FUSS. 
      STA KILDF     ZERO OUT USER'S FUSS. 
      LDA .-8                                    X] 
      STB KILDF,I 
      ISZ KILDF NN
      INA,SZA 
      JMP *-3 
      LDA LIBD      SEARCH FUSS TABLE TO SEE IF 
      LDB KILD       FILE IS BEING USED.
KIL20 CPB 0,I 
      JMP KIL19 
      ADA .+2                                    X] 
      ISZ KILC                                   X] 
      JMP KIL20                                  X] 
      LDA FUSS,I    WRITE BACK FUSS TABLE.
      LDB LIBD
      JSB DISCL 
      JMP KIL3      GO GET DIRECTORY AGAIN. 
* 
KIL19 LDA .-121f
      LDB *+2 
      JMP LIBER R
      DEF *+1 
      OCT 5106      LF-F
      ASC 5,ILE IN USE
* 
KIL18 LDB KILPD     SET UP PARAMETERS FOR MOVE. 
      ADB .+8 
      STB MOVES 
      ADB KILP,I
      ADB MLIBD 
      JSB MOVEW 
* 
      LDA KILP,I    REDUCE DIRECTORY LENGTH BY 8. 
      ADA .+8 
      STA KILP,I
      STA WORD      WRITE DIRECTORY BACK OUT. 
      LDA KILP
      ADA .+6 
      LDA 0,I I
      LDB LIBD
      STB MOVES 
      JSB DISCL 
* qq
      LDA KILP      ADJUST WORDS 1-4 OF DIREC.
      INA gg
      STA MOVED D_
      LDB .-4 
      JSB MOVEW 
* 
      JSB FIDT     READ IN ADT TRACK
      LDA KILN      GET PROGRAM LENGTH. 
      ARS,ARS       CONVERT TO
      ARS,ARS        SECTORS. 
      ARS,ARS 
      ARS                                             [X] 
      CMA,INA 
      STA KILN
      CMA,INA 
      ADB .+7       ADJUST DISC 
      ADA 1,I        USAGE. 
      SSA               IS IT NEG?                     (L)
      CLA               YES, SET TO 0                  (L)
      STA 1,I 
      LDA IDTRA,I  WRITE ID TRACK BACK OUT
      LDB LIBD
      JSB DISCL 
      LDA ADLEN   READ IN ADT TABLE 
      STA WORD
      LDA ADLOC 
      LDB LIBDI 
      JSB DISCL 
* 
      LDB LIBD
      LDA KILD     LOAD DISC ADDRESS             [X]
      AND DHMSK    GET SUBCHANNEL                [X]
      STA LTEMP+8  SAVE IT                       [X]
KIL13 LDA 1,I      LOAD ADT ENTRY                [X]
      AND DHMSK    GET SUBCHANNEL                [X]
      CPA LTEMP+8  IS IT THE ONE?                [X]
      JMP KIL12    YES                             [X]
      ADB .+2      NO  TYR THE NEXT ONE          [X]
      JMP KIL13                                  [X]
KIL12 LDA KILD     NOW SEARCH FOR THE RIGHT SPOT [X]
      CMA,CLE,INA  LOOK FOR FIRST ENTRY BIGGER THAN THIS ONE
      ADA 1,I                                    [X]
      SEZ                                         [X] 
      JMP KIL16    WE HAVE FOUND THE SPOT        [X]
      ADB .+2      NOT YET - TRY NEXT ONE        [X]
      LDA 1,I                                   (L) 
      AND DHMSK                                 (L) 
      CPA LTEMP+8    SAME SUBCHANNEL?           (L) 
      JMP KIL12      YES                        (L) 
KIL16 STB KILP     SAVE ADT ADDRESS              [X]
      ADB .-2       TEST FOR PREVIOUS ENTRY ADJACENT
      LDA 1,I        TO NEW ONE.
      INB 
      ADA 1,I 
      CPA KILD
      JMP KIL14     IT IS--GO COMBINE AREAS.
* 
      LDA KILD      TEST FOR NEXT ENTRY ADJACENT TO 
      ADA KILN       NEW ONE. 
      CPA KILP,I
      JMP KIL15     IT IS--GO COMBINE AREAS.
* 
* THE NEW ENTRY IS ADJACENT TO NEITHER THE PRECEDING NOR THE FOLLOW-
* ING ENTRIES. WE HAVE TO CREATE ROOM FOR IT BY SLIDING DOWN THE
* ADT.T

* qq
* 
      LDB WORD      IF NO ROOM TO EXPAND ADT, WE
      CPB M3072    HAVE TO LOSE THE SPACE 
      JMP KIL50 
      CMB           SET UP SOURCE FOR THE MOVE. 
      ADB LIBD
      STB MOVES 
      ADB .+2       SET UP DESTINATION. 
      STB MOVED 
      CMB,INB       COMPUTE LENGTH. 
      INB 
      ADB KILP
      JSB MOVEB     MOVE IT.
      LDA KILD      INSERT NEW
      LDB KILN       ENTRY. 
      DST KILP,I
* qq
      LDA ADLEN     ADJUST ADLEN. 
      ADA .-2 
      STA ADLEN 
      JMP KIL50 
* qq
* COME HERE WHEN THE NEW AREA IS ADJACENT TO THE FOLLOWING ONE, BUT 
* NOT TO THE PRECEDING ONE. 
KIL15 DLD KILP,I    GET FOLLOWING ENTRY.
      ADB KILN      COMBINE LENGTHS.
      LDA KILD      USE NEW DISC ADDRESS. 
      DST KILP,I    REPLACE.
      JMP KIL50 
* 
* COME HERE WHEN THE NEW AREA IS ADJACENT TO THE PRECEDING AREA.
* 
KIL14 LDA 1,I       ADD LENGTH OF OLD AREA TO 
      ADA KILN       LENGTH OF NEW ONE. 
      STA 1,I 
      LDA KILD      NOW TEST TO SEE IF TEH COMBINED 
      ADA KILN       AREA IS ADJACENT TO THE NEXT 
      CPA KILP,I
      JMP KIL17     IT IS--GO COMBINE THEM. 
* qq
KIL50 LDA ADLEN      WRITE ADT TABLE OUT
      STA WORD
      LDA ADLOC 
      LDB LIBD
      JSB DISCL 
      LDA KILTS     DID WE JUST KILL A
      SZA,RSS        FILE?
      JMP LLEND     NO. 
      JSB RDPRG     IF WE DID, WE HAVE TO DICOMPILE 
      JSB DCMPL      THE GUY TO MAKE SURE HE DOESN'T
      LDA MLINK+1     USE IT. 
      ADA .-?LINK   LEAVE USER IN CORE. 
      STA MAIN
      JMP LLEND     TERMINATE.
* 
* NEW AREA WAS ADJACENT TO 2 OTHERS. COMBINE THEM ALL.
* 
KIL17 ISZ KILP      COMBINE 
      LDA 1,I        THE
      ADA KILP,I     LENGTHS. 
      STA 1,I 
      INB           COLLAPSE ADT. 
      STB MOVED     SET UP MOVE DESTINATION.
      ADB .+2 
      STB MOVES SET UP SOURCE.
      ADB MLIBD     COMPUTE # OF WORDS
      ADB WORD       TO MOVE. 
      JSB MOVEW 
* qq
      ISZ ADLEN     REDUCE SIZE OF ADT BY 
      ISZ ADLEN      TWO. 
      JMP KIL50 
* 
KIL4  LDA .-16
      LDB *+2 FF
      JMP LIBER 
      DEF *+1 
      OCT 5116
      ASC 7,O SUCH PROGRAM
KILP   EQU LTEMP+4
KILPD EQU LTEMP+5 
KILC  EQU LTEMP+6 
KILD  EQU LTEMP+9 
KILN  EQU LTEMP+10
KILTS EQU LTEMP+11
KILDF EQU LTEMP+12
KILSP ABS -TTY00-?LINK
$KIL  EQU * 
      HED RENUMBER
* THE RENUMBER ROUTINE IS CALLED BY A USER TO ASSIGN A NEW
* SET OF SEQUENCE NUMBERS TO HIS PROGRAM. RENUMBER MAY
* BE GIVEN 2 PARAMETERS--THE STARTING SEQUENCE NUMBER 
* AND THE INCREMENT. IF EITHER IS NOT GIVEN, IT IS AUTOMATICALLY
* SET TO 10.
      SPC 2 26
      ORG LIBRA 
      LDA MLINK+1 
      ADA .+?PROG-?LINK 
      LDB 0,I 
      CPB PBUFF     NULL PROGRAM? 
      JMP LLEND     YES 
      JSB RDPRG     READ IN USER PROGRAM. 
* 
*  SET UP INITIAL SEQUENCE NUMBER AND INCREMENT 
* 
      LDA .+10      DEFAULT 
      STA RENM
      STA RENN        VALUES
      JSB RENUM     PARAMETER?
      JMP REN1      NO
      STB RENM      YES, RECORD IT
      CPA .+15B     END OF RECORD?
      JMP REN1      YES 
      CPA .+54B     NO--CHECK FOR COMMA 
      JSB RENUM     DEMAND SECOND 
      JMP RENF1     NO
      STB RENN      RECORD IT 
      CPA .+15B     END OF RECORD?
      RSS           YES 
      JMP RENF1     NO
* qq
* TEST FOR WHETHER SEQUENCING WILL OVERFLOW PAST 9999 
REN1  LDB PBPTR    COMPUTE                       X] 
      LDA CFLAG                                  X] 
      AND LMSK       PROGRAM                     X] 
      STA RENC            AND 
      SZA                   END-OF- 
      LDB SYMTB               PROGRAM 
      STB RENEN                 POINTER 
      CLA,INA       INITIALIZE STATEMENT
      STA RENNS      COUNTER TO ONE.
      LDB SPROG 
      LDA RENM      COMPUTE INITIAL 
      ADA MAXSN       SEQUENCE NUMBER - 10000 
REN2  INB           MOVE TO 
      ADB 1,I         NEXT
      ADB .-1           STATEMENT 
      CPB RENEN     DONE? 
      JMP REN3      YES 
      ADA RENN      NO, ADD IN SEQUENCE INCREMENT 
      SSA,RSS       PAST 9999 ? 
      JMP RENF2     YES 
      ISZ RENNS     BUMP STATEMENT COUNTER. 
      JMP REN2      NO
REN3  LDB RENC      PROGRAM 
      SZB            COMPILED?
      JMP REN9      YES 
* *q
      LDA RENNS     GET # OF STATEMENTS IN PROGRAM. 
      DIV .+32      DIVIDE INTO 32 PARTS. 
      CMB           SET B=-1-#OF OVERSIZE GROUPS, 
      SZA,RSS        BUT IF <32 STATEMENTS USE -#.
      INB 
      INA           SET A TO SIZE OF LARGER GROUP.
      STA RENC1     SET COUNTER.
      STB RENC2 
      LDB ERSCA     SET INITIAL POINTER TO ERSEC. 
      STB RENSN 
* 
* NOW BUILD A TABLE IN ERSEC HAVING TH FOLLOWING STRUCTURE: 
*     ERSEC(0:31) ARE SEQUENCE NOS. OF STATEMENTS WHICH DIVIDE
* THE PROGRAM INTO 32 ALMOST EQUAL PARTS. ERSEC(32:63) ARE THE ABSO-
* LUTE ADDRESSES OF THESE STATEMENTS. ERSEC(0) IS THE SEQ.NO. OF THE
* FIRST STATEMENTS. 
* 
      LDA SPROG 
REN15 ADB .+323|
      STA 1,I       SET ABSOLUTE ADDRESS INTO TABLE.
      LDB 0,I       SET SEQUENCE # INTO TABLE.
      STB RENSN,I 
      ISZ RENSN     BUMP POINTERS.
* 
      ISZ RENC2     TEST FOR ANY MORE OVERSIZE
      CLB,RSS        GROUPS.
      CCB           COMPUTE SIZE OF NEXT GROUP. 
      ADB RENC1 
      STB RENC1 
      CMB 
      STB RENC3 
* qq
      LDB RENSN     TEST FOR DONE.
      CPB ERS32 
      JMP REN14 
* 
      ISZ RENC3     COMPUTE 1ST STATEMENT IN
      INA,RSS        NEXT GROUP.
      JMP REN15 
      ADA 0,I I-
      ADA .-1 
      JMP *-5 
* 
* SCAN THROUGH PROGRAM FOR SEQUENCE NUMBER REFERENCES.
* FOR EACH ONE, DETERMINE ABSOLUTE ADDRESS OF THE LABEL 
* AND REPLACE IT WITH THAT ADDRESS. IF LABEL IS NONEXISTENT,
* PLACE THE NEGATIVE LABEL IN TO INDICATE THIS FACT.
* 
REN14 LDA SPROG     INITIALIZE POINTERS 
      STA RENQ       FOR RENSK. 
      ADA .-1 
      STA RENP
* 
REN4  JSB RENSK     GET NEXT STATEMENT REFERENCE. 
      JMP REN9      NONE LEFT.
* 
      LDB ERSCA 
REN7  LDA 1,I       FIRST STATEMENT >=SOUGHT STATE.?
      CMA 
      ADA RENP,I
      SSA,INA 
      JMP REN5      FOUND ONE.
      INB 
      CPB ERS32     TEST FOR DONE.
      RSS 
      JMP REN7JJ
* 
      ADB .+313
      LDA PBPTR     STATEMENT IS IN LAST GROUP. 
      JMP REN6
REN5  ADB .+32      B=>FIRST STATEMENT IN GROUP.
      SZA,RSS       TEST FOR FOUND. 
      JMP REN18 
      CPB ERS32     TEST FOR NOT THERE. 
      JMP REN17 33
      LDA 1,I       SET A=>FIRST WORD BEYOND GROUP. 
      ADB .-1         AT FIRST WORD BEYOND GROUP. 
REN6  LDB 1,I 
      STA RENC1     SAVE END TEST.
      LDA RENP,I    GET SEQUENCE NUMBER.
REN16 INB           BUMP STATEMENT POINTER. 
      ADB 1,I 
      ADB .-1 
      CPB RENC1     TEST FOR DONE.
      JMP REN17 
      CPA 1,I       TEST FOR FOUND. 
      JMP REN8
      JMP REN16 6m
* *q
REN18 LDB 1,I I
      JMP *+3 3H
REN17 LDB RENP,I    SET BIT15 FOR 
      ADB BIT15      UNDEFINED LABELS.
REN8  STB RENP,I
      JMP REN4
* *q
* NOW CHANGE ALL LABELS TO THEIR NEW VALUES.
* 
REN9  LDA SPROG     FIRST PROGRAM STATEMENT 
      LDB RENM      INITIAL LINE NUMBER 
REN10 CPA RENEN     DONE? 
      JMP REN11     YES 
      STB 0,I       NO, RECORD NEW LINE NUMBER
      ADB RENN      INCREMENT TO NEXT LINE NUMBER 
      INA           MOVE TO 
      ADA 0,I         NEXT
      ADA .-1           STATEMENT 
      JMP REN10 
* qq
* SCAN REFERENCES AGAIN. IF ABSOLUTE ADDRESS IS THERE,
* REPLACE BY NEW LABEL. OTHERWISE REPLACE BY OLD LABEL. 
* 
REN11 LDA RENC      IS PROGRAM
      SZA             COMPILED? 
      JMP REN13     YES 
      LDA SPROG 
      STA RENQ
      ADA .-1 
      STA RENP      SEEK EMBEDDED 
REN12 JSB RENSK       STATEMENT REFERENCES
      JMP REN13     NONE LEFT 
      LDA RENP,I    IF REFERENCE IS 
      RAL,CLE,SLA,ERA    NEGATIVE, CLEAR BIT 15.
      RSS                OTHERWISE, REPLACE IT. 
      LDA 0,I             WITH THE NEW
      STA RENP,I            LINE NUMBER 
      JMP REN12 
REN13 LDA MLINK+1   SET FLAG TO SAY 
      ADA .-?LINK     'USER PROGRAM TO CORE'
      STA MAIN
      JMP LLEND 
RENF2 LDA .-25
      LDB REN0
      JMP LIBER 
REN0  DEF *+1 yy
      OCT 5123      LF-S
      ASC 12,EQUENCE NUMBER OVERFLOW
* 
* RENUM SCANS INPUT BUFFER FOR A NUMBER. IF IT FINDS NOTHING
* IT RETURNS WITHOUT SKIPPING.IF IT FINDS A LEGAL LABEL 
* (1-9999) IT RETURNS WITH IT IN B AND THE NEXT CHARACTER IN A, 
* AND SKIPS ON THE WAY BACK. IF IT FINDS AN ERROR IT GOES TO RENF.
* qq
RENUM NOP 
      CLA           INITIALIZE INTEGER
      STA RENL        TO ZERO 
      JSB LCHAR     ANY CHARACTERS? 
      JMP RENUM,I   NO
RENU1 ADA M72B      YES, IS IT
      SSA,RSS         < ASCII 72 ?
      JMP RENU2     NO
      ADA .+10      YES,
      SSA             > ASCII 57 ?
      JMP RENU2     NO
      LDB RENL      YES, PREVIOUS 
      ADB M1000       INTEGER 
      SSB,RSS           < 1000 ?
      JMP RENF1     NO
      LDB RENL      YES 
      RBL,RBL       MULTIPLY
      ADB RENL        BY
      RBL               10
      ADA 1         ADD IN
      STA RENL        NEW DIGIT 
      JSB LCHAR     FETCH NEXT
      JMP *+3         CHARACTER 
      JMP RENU1 
RENU2 ADA .+60B     RESTORE ANY LEGAL CHARACTER 
      LDB RENL
      ISZ RENUM 
      SZB           NON-ZERO INTEGER? 
      JMP RENUM,I   YES S*
RENF1 LDA .-14
      LDB *+2 2F
      JMP LIBER R
      DEF *+1 
      OCT 5102      LF-B
      ASC 6,AD PARAMETER
RENSK NOP 
      ISZ RENP      INCREMENT POINTER 
      LDB RENP      STATEMENT 
      CPB RENQ        FINISHED? 
      JMP RENS2     YES 
RENS1 ISZ RENSK     NO, RETURN WITH RENP
      JMP RENSK,I     SET TO NEXT REFERENCE 
      STB RENQ      UPDATE TO NEXT STATEMENT
RENS2 CPB PBPTR     PROGRAM EXHAUSTED?
      JMP RENSK,I   YES 
      ISZ RENQ
      LDB RENQ
      ISZ RENQ      EXTRACT 
      LDA RENQ,I      STATEMENT 
      AND OPMSK         TYPE
      ADB 1,I       SET (B) TO
      ADB .-1         NEXT STATEMENT
      CPA RESOP     <RESTORE STATEMENT> ? 
      JMP RENS5     YES 
      CPA GOTOP     NO, <GOTO STATEMENT> ?
      JMP RENS3     YES 
      CPA GOSOP     NO, <GOSUB STATEMENT> ? 
      JMP RENS3     YES 
      CPA IFOP      NO, <IF STATEMENT> ?
      RSS           YES 
      JMP RENS2-1   NO
      LDA THNOP     LOAD 'THEN' 
RENS3 IOR INTFL     CREATE REFERENCE HEADER 
      STB RENQ      SET POINTER TO NEXT STATEMENT 
      ADB .-1       SET POINTER TO
RENS4 STB RENP        PROSPECTIVE REFERENCE 
      ADB .-1       PRECEDED BY 
      CPA 1,I         REFERENCE HEADER? 
      JMP RENS1     YES 
      LDA OFOP      NO, LOAD HEADER FOR 
      CPA 1,I 
      JMP RENS1 <<<<
      JMP RENS4       REFERENCE LIST
RENS5 CPA RENQ,I    ANY REFERENCE?
      JMP RENS2-1   NO
      JMP RENS3     YES 
RENL  EQU LTEMP 
RENM  EQU LTEMP+1 1[
RENN  EQU LTEMP+2 
RENC  EQU LTEMP+3 
RENP  EQU LTEMP+4 
RENQ  EQU LTEMP+5 
RENEN EQU LTEMP+8 
RENNS EQU LTEMP+9 
RENC1 EQU LTEMP+10
RENC2 EQU LTEMP+11
RENC3 EQU LTEMP+12
RENSN EQU LTEMP+14
RESOP OCT 66000 
GOTOP OCT 52000 
GOSOP OCT 56000 qq
IFOP  OCT 53000 
THNOP OCT 75000 
$REN  EQU * 
      HED NAME
* THE NAME ROUTINE ALLOWS A USER TO ASSIGN HIS PROGRAM A NAME.
      SPC 1 
      ORG LIBRA 
      SPC 1 
      LDA MLINK+1   SET POINTER TO NAME.
      ADA .+?NAME-?LINK 
      STA LTEMP 
      STA LTEMP+3   SAVE NAME POINTER IN LTEMP+3. 
      LDA 0,I       SAVE RUN-ONLY BIT IN LTEMP+4. 
      AND BIT15 
      STA LTEMP+4 
      LDA .-3       SET COUNTER.
      STA LTEMP+1 
      CLA           SET FLAG TO SAY 
      STA LTEMP+2   FIRST CHARACTER 
NAME1 JSB NAMER     GET A CHAR. 
      ALF,ALF 
      STA LTEMP,I 
      JSB NAMER     GET 2ND CHAR. 
      IOR LTEMP,I 
      STA LTEMP,I 
      ISZ LTEMP     BUMP NAME POINTER.
      ISZ LTEMP+1   TEST FOR DONE.
      JMP NAME1 
      LDA LTEMP+3,I GET FIRST WORD OF NAME
      IOR LTEMP+4   MERGE IN RUN-ONLY BIT.
      STA LTEMP+3,I 
      JSB NAMER     TEST FOR ONLY 6 CHARS.
      CPA .+40B 
      JMP LLEND 
* 
      LDA NAM27 
      LDB *+2 
      JMP LIBER 
      DEF *+1 
      OCT 5117      LF-O
      ASC 13,NLY 6 CHARACTERS ACCEPTED
NAM27 DEC -27 
* 
NAMER NOP           GETS NEXT NAME CHARACTER. 
      JSB LCHAR 
      LDA .+40B     USE BLANK IF END OF LINE. 
      STA 1         HOLD IN B.
      AND .140      TEST FOR CONTROL CHAR.
      SZA A;
      CPA .140
      JMP NAMER+1   SKIP CONTROL CHARS. 
      LDA 1         GET IN A AGAIN. 
     CPA .+54B     COMMA? 
      JMP NAME2     YES 
      CPA .+42B     QUOTE?
      JMP NAME2     YES 
      LDB LTEMP+2   GET 1ST CHAR FLAG.
      ISZ LTEMP+2 2
      CPA .+44B     IF $ AND
      SZB            FIRST CHAR., IT'S ILLEGAL. 
      JMP NAMER,I 
* 
      LDA NAM29     PRINT ERROR.
      LDB *+2 
      JMP LIBER 
      DEF *+1 
      OCT 5044      LF-$
      ASC 14, ILLEGAL AS FIRST CHARACTER
* 
NAME2 LDA LTEMP+4   CLEAR 
      STA LTEMP+3,I   NAME
      JMP ILFER 
NAM29 DEC -29 9 
$NAM  EQU * 
