
      HED BESTOW
* THE BESTOW COMMAND IS USED TO TRANSFER PROGRAMS AND FILES FROM
* ONE USER'S LIBRARY TO ANOTHER USER'S LIBRARY. THE FORMAT OF THE 
* COMMAND IS: 
* 
*     BES - OLDID, NEWID [,NAME]
* 
* IF NAME IS OMITTED, ALL PROGRAMS ARE TRANSFERED EXCEPT FOR THOSE
* WHOSE NAMES ALREADY EXIST IN NEWID'S LIBRARY. 
* 
      ORG LIBRA 
      JSB GETID     GET OLDID 
      RSS 
      JMP LFRER     CR IS ERROR 
      CPA .+54B     COMMA FOLLOWS?
      CLA,RSS       YES 
      JMP LFRER     NO, ERROR 
      STA BESDE     SET DUPLICATE ENTRY COUNTER 
      LDA ID        SAVE
      STA LTEMP 
      STA BESOI       ID
* 
      JSB GETID     GET NEWID 
      NOP 
      CPA .+15B     CR FOLLOWS? 
      JMP BES3      YES 
      CPA .+54B     NO, COMMA?
      CLA,RSS       YES 
      JMP LFRER     NO, ERROR 
      STA BESF
      LDA DLTEM 
      STA BESP
      LDA .-3       6 CHAR
      STA BESC        MAXIMUM 
* 
BES1  EQU * 
      JSB BESR      GET LEFT CHAR 
      ALF,ALF 
      ISZ BESP
      STA BESP,I    SAVE IT 
      JSB BESR      GET RIGHT CHAR
      IOR BESP,I
      STA BESP,I    SAVE IT 
      ISZ BESC      FINISHED 6 CHARS? 
      JMP BES1      NO
      JSB BESR      YES, NEXT MUST
      CPA .+40B       BE A BLANK
      RSS           OK
      JMP LFRER 
      CPB .+15B     CR FOLLOWS? 
      CCA,RSS       YES 
      JMP LFRER     NO
* 
* SEARCH FOR ENTRY
* 
      STA BESMF     SET MODE FLAG 
      JSB DLOKP,I   SEARCH FOR ENTRY
      JMP BES2      FOUND 
      LDA BESEA     "ENTRY NOT FOUND" 
      LDB BESFA 
      JMP BESIL 
BES2  EQU * 
      DLD LTEMP+4   SAVE
      STA BESD4       DIRECTORY 
      STB BESD5         POINTERS
      JMP BES10 
* 
* NO PROGRAM/FILE NAME IS SPECIFIED 
* 
BES3  EQU * 
      CLA           SET MODE
      STA BESMF       FLAG
      STA LTEMP+1   INITIALIZE
      STA LTEMP+2 
      STA LTEMP+3     NAME
* 
BES4  EQU * 
      JSB DLOKP,I   SEARCH FOR ENTRY
      JMP BES9      FOUND 
      LDB LTEMP+5 
      ADB .+12
      STB LTEMP+5 
      LDB LTEMP+4,I NOT FOUND 
      CMB,INB       DO WE POINT 
      ADB LIBD        BEYOND THE
      CPB LTEMP+5       DIRECTORY?
      RSS           YES 
      JMP BES6      NO
      LDB LTEMP+4 
BES5  EQU * 
      ADB .+7       => NEXT DIREC ENTRY 
      CPB BDIRU     LAST ONE? 
      JMP BES7      YES 
      LDA B,I       NO
      SZA,RSS       LENGTH ZERO?
      JMP BES5      YES 
      INB           NO
      LDA B,I       GET FIRST ID ON TRACK 
      CPA LTEMP     SAME AS THIS ONE? 
      RSS           YES 
      JMP BES7      NO
      ADB .-1       SAVE
      STB BESD4       DIREC 
      LDA LIBD          POINTERS
      STA BESD5 
      LDA B,I       READ
      STA MWORD 
      ADB .+5         NEW 
      LDA B 
      LDB LIBDI         DIRECTORY 
      JSB DISCZ,I         TRACK 
      JSB SICKP,I 
      JMP BES10 
* 
BES6  EQU * 
      LDB LTEMP+5,I OLDID THE SAME
      CPB LTEMP       AS THIS ONE?
      JMP BES9      YES 
* 
BES7  EQU * 
      CLA           FIRST TIME
      CPA BESMF       THRU? 
      JMP BES8      YES 
BES15 EQU * 
      CPA BESDE     NO, ANY DUPLICATE ENTRIES?
      JMP LEND      NO
      LDA BESEB     "DUPLICATE ENTRY(IES)"
      LDB BESFB 
      JMP BESIL 
BES8  EQU * 
      LDA BESEC     "NO ENTRIES FOR OLDID"
      LDB BESFC 
BESIL EQU * 
      STA MOVES     MOVE MESSAGE
      LDA T35B1 
      STA MOVED       TO TTY
      STB LTEMP 
      JSB MOVEW         BUFFER
      LDA LTEMP 
      ALS 
      CMA,INA 
      LDB T35B1 
      JMP LEND2 
BES9  EQU * 
      DLD LTEMP+4   SAVE
      STA BESD4       DIREC 
      STB BESD5         POINTERS
BES10 EQU * 
      LDB BESD5 
      ADB .+11
      LDA B,I       GET LENGTH
      STA BESWD     SAVE IT 
      SSA,RSS 
      JMP *+4 
      ALF,ALF       CONVERT 
      IOR HIMSK       TO
      CMA,INA       BLOCKS
      STA BESLN     SAVE # OF BLOCKS
      ADB .-10      MOVE
      LDA B,I 
      AND INF 
      STA LTEMP+1 
      INB             ID/NAME 
      LDA B,I 
      STA LTEMP+2 
      INB               INTO
      LDA B,I 
      STA LTEMP+3 
      LDA ID              LTEMP[0:3]
      STA LTEMP 
      JSB DLOKP,I   SEARCH FOR NEW ENTRY
      JMP BES13     FOUND, DUPLICATE
* 
* CHECK FOR SPACE AVAILABLE IN NEWID LIBRARY
* 
      JSB BESIS     GET TRACK FOR NEWID 
      ADB .+7 
      LDA B,I       COMPUTE 
      ADA BESLN       TOTAL 
      CMA,INA           DISC
      ADB .-1             USED
      CLE 
      ADA B,I 
      SEZ           GREATER THAN ALLOTMENT? 
      JMP BES11     NO
      LDA BESEE     "LIBRARY SPACE FULL"
      LDB BESFE 
      JMP BESIL 
BES11 EQU * 
      INB           UPDATE
      LDA B,I         DISC
      ADA BESLN         USED
      STA B,I 
      JSB BESIW     WRITE OUT ID TRACK
* 
* REDUCE SPACE USED IN OLDID LIBRARY
* 
      LDA BESOI 
      STA ID
      JSB BESIS     GET TRACK FOR OLDID 
      ADB .+7 
      LDA BESLN     REDUCE
      CMA,INA         DISC
      ADA B,I           USED
      STA B,I 
      JSB BESIW     WRITE OUT ID TRACK
* 
* GET INFORMATION ON ENTRY TO BE BESTOWED 
* 
      LDA BESD4     READ
      LDB A,I 
      STB MWORD       DIRECTORY 
      ADA .+5           FOR OLD 
      LDB LIBDI 
      JSB DISCZ,I         ENTRY 
      JSB SICKP,I 
      LDB BESD5 
      STB MOVED 
      ADB .+4 
      LDA B,I       SAVE
      STA BESP        WORD 4
      ADB .+4 
      LDA B,I       SAVE
      STA BESDS 
      INB             DISC
      LDA B,I 
      STA BESDS+1       ADDRESS 
      ADB .+3 
      STB MOVES     ELIMINATE 
      ADB BESD4,I 
      ADB MLIBD       ENTRY 
      JSB MOVEW 
      LDB BESD4 
      LDA B,I       UPDATE
      ADA .+12        TRACK 
      STA B,I           LENGTH
      STA MWORD 
      INB 
      STB MOVED 
      ADB .+4 
      STB BESRD 
      LDA B 
      LDB LIBD
      STB MOVES 
      JSB DISCZ,I   WRITE DIRECTORY TRACK 
      JSB SLVAG,I 
      LDB .-4       RESET 
      JSB MOVEW       DIREC 
      LDA LTEMP     RESET 
      STA ID          ID
      JSB DLOKP,I   SEARCH FOR NEW ENTRY
      NOP 
* 
* IS DIRECTORY TRACK FULL?
* 
      LDB LTEMP+4,I IF TRACK IS FULL, GO
      CPB M8184       DO OVERLAY SECTION
      JMP BES98 
* 
* APPARENTLY NOT, INSERT ENTRY
* 
      CMB           MAKE
      ADB LIBD
      STB MOVES       ROOM
      ADB .+12
      STB MOVED         FOR NEW 
      CMB 
      ADB .+24            DIRECTORY 
      ADB LTEMP+5 
      JSB MOVEB             ENTRY 
* 
      LDA DLTEM     MOVE
      STA MOVES 
      LDA LTEMP+5     ID/NAME 
      ADA .+12
      STA MOVED         INTO
      LDB .-4 
      JSB MOVEW           DIRECTORY 
      LDA BESP      WORD 4
      STA MOVED,I 
      JSB DATE      LAST REFERENCE DATE 
      ISZ MOVED 
      STA MOVED,I 
      ISZ MOVED 
      LDA DATIM     LAST CHANGE DATE
      STA MOVED,I 
      ISZ MOVED 
      ISZ MOVED 
      DLD BESDS     DISC ADDRESS
      DST MOVED,I 
      LDB MOVED 
      ADB .+3 
      LDA BESWD     LENGTH
      STA B,I 
* 
      LDA LTEMP+4,I UPDATE
      ADA .-12        DIRECTORY 
      STA LTEMP+4,I     LENGTH
      STA MWORD 
      LDA LTEMP+4 
      INA 
      STA MOVED 
      ADA .+4 
      STA BESRD 
      LDB LIBD
      STB MOVES 
      JSB DISCZ,I 
      JMP BES12 
      LDB .-4       RESET 
      JSB MOVEW       DIREC 
      JMP BES13+1 
* 
BES12 LDB .-4       RESET 
      JSB MOVEW       DIR 
      JSB SLVAG,I 
* 
BES13 EQU * 
      ISZ BESDE     BUMP DUPLICATE FLAG 
      LDA BESOI     RESET 
      STA LTEMP       OLDID 
      ISZ LTEMP+3   BUMP NAME FOR SEARCH
      ISZ BESMF     MORE THAN ONE ENTRY?
      JMP BES4      YES 
      CLA           NO
      JMP BES15 
* 
BES98 EQU * 
      LDA BM507     SET UP OVERLAY
      STA MWORD 
      LDA BESOV 
      LDB #LIBI 
      JMP BES99 
* 
* BESIS SEARCHES THE ID TABLE 
* 
BESIS NOP 
      JSB FIDTP,I   FIND OUT WHICH TRACK
      LDA IDTLN 
      LDB A,I       LENGTH
      SZB,RSS         ZERO? 
      JMP BESI2     YES 
      STB MWORD     NO, SAVE IT 
      CMB,INB       GET POINTER 
      ADB LIBD        TO LAST 
      STB BESDS         WORD +1 
      LDA IDTAD     => ADT DISC ADDRESS 
      LDB LIBDI 
      JSB DISCZ,I   READ ID TRACK 
      JSB SICKP,I 
      LDB LIBD
BESI1 EQU * 
      CPB BESDS     END OF TABLE? 
      JMP BESI2     YES 
      LDA B,I       NO, GET CURRENT ID
      CMA,INA 
      ADA ID
      SZA,RSS       EQUAL?
      JMP BESIS,I   YES, FOUND THE ONE WE WANT
      SSA           NO, GREATER?
      JMP BESI2     YES, ERROR
      ADB .+8       NO, MOVE TO NEXT ONE
      JMP BESI1 
BESI2 EQU * 
      LDA BESED     "NO SUCH NEWID" 
      LDB BESFD 
      JMP BESIL 
* 
* BESIW WRITES OUT THE ID TABLE 
* 
BESIW NOP 
      LDA IDTAD     => DISC ADDRESS 
      LDB LIBD
      JSB DISCZ,I   WRITE IT
      JSB DEADP,I 
      JMP BESIW,I 
* 
* BESR FETCHES CHARACTERS FOR THE NAME
* 
BESR  NOP 
      LDA BESF      THEST TO RETURN BLANK 
      CPA .+40B 
      JMP BESR,I
BESR1 EQU * 
      JSB T35CH,I   GET A CHAR
      JMP BESR4     CR
      LDB A 
      AND .140      SKIP CONTROL CHARACTERS 
      SZA 
      CPA .140
      JMP BESR1 
BESR5 EQU * 
      LDA BESF
      SZA           FIRST CHAR? 
      JMP BESR2     NO
      CPB .+54B     YES, COMMA? 
      JMP LFRER     YES 
      CPB .+44B     NO, '$'?
      JMP BESR6     YES 
      CPB .+52B     NO, '*'?
      JMP BESR6     YES 
      CPB .+15B     NO, CR? 
      JMP LFRER 
BESR3 EQU * 
      LDA B         NO, RESTORE A 
      ISZ BESF
      JMP BESR,I
BESR2 EQU * 
      CPB .+54B     COMMA?
      JMP BESR6     YES, ERROR
      CPB .+15B     NO, CR? 
      RSS           YES 
      JMP BESR3     NO
      LDA .+40B     RETURN A BLANK
      STA BESF
      JMP BESR,I
BESR4 EQU * 
      LDB A 
      JMP BESR5 
BESR6 EQU * 
      LDA BESEF     "INVALID NAME"
      LDB BESFF 
      JMP BESIL 
BESEA DEF *+1 
      OCT 5105
      ASC 7,NTRY NOT FOUND
BESFA EQU .-*+BESEA+1 
BESEB DEF *+1 
      OCT 5104
      ASC 10,UPLICATE ENTRY(IES)
BESFB EQU .-*+BESEB+1 
BESEC DEF *+1 
      OCT 5116
      ASC 10,O ENTRIES FOR OLDID
BESFC EQU .-*+BESEC+1 
BESED DEF *+1 
      OCT 5116
      ASC 6,O SUCH NEWID
BESFD EQU .-*+BESED+1 
BESEE DEF *+1 
      OCT 5114
      ASC 9,IBRARY SPACE FULL 
BESFE EQU .-*+BESEE+1 
BESEF DEF *+1 
      OCT 5111
      ASC 6,NVALID NAME 
BESFF EQU .-*+BESEF+1 
* 
BESOV DEF COM6+SAVO-COM3+SAVO-COM3               [B]
BM507 DEC -507
BDIRU DEF DIREU 
* 
BESDS EQU LTEMP+6 
BESWD EQU LTEMP+8 
BESC  EQU LTEMP+9 
BESP  EQU LTEMP+10
BESF  EQU LTEMP+11
BESLN EQU LTEMP+12
BESD4 EQU T35CQ 
BESD5 EQU GETID 
BESOI EQU LOUT
BESDE EQU LTYPR 
BESMF EQU LCHAR 
BESRD EQU SCHLQ 
* 
* 
      ORG LIBRA+507 
BES99 EQU * 
      JSB DISCZ,I 
      JSB SICKP,I 
      JMP LIBRA 
      JMP BES13+1 
      HLT 41B 
$BES  EQU * 
      HED PURGE 
* THE PURGE COMMAND MAKES IT POSSIBLE TO REMOVE FROM THE LIBRARY
* PROGRAMS WHICH HAVE NOT BEEN ACCESSED FOR SOME PERIOD OF TIME.
* THE FORMAT FOR THE COMMAND IS AS FOLLOWS: 
* 
*     PURGE-DAY/YEAR
* 
* WHERE DAY IS AN INTEGER FROM 1 TO 366 AND YEAR IS AN INTEGER FROM 
* 0 TO 99. ALL PROGRAMS OR FILES WHICH HAVE NOT BEEN ACCESSED SINCE 
* THE SPECIFIED DATE ARE DELETED FROM THE LIBRARY.
* 
* PURGE WILL REFUSE TO OPERATE IF THE SPECIFIED DATE IS BEYOND
* TODAY'S DATE. 
* 
      SPC 3 
      ORG LIBRA 
     DLD PZ999      PREVENT HELLO PROGRAM 
     DST LTEMP        FROM BEING PURGED.
      DLD PURHE+1 
      DST LTEMP+2 
      JSB DLOKP,I   SEARCH DIRECTORY FOR HELLO ENTRY
      RSS 
      JMP PUR2
      JSB DATE
      LDB LTEMP+5   UPDATE
      ADB .+5         LAST REFERENCED 
      STA B,I           DATE
      LDA LTEMP+4 
      ADA .+5 
      STA PURP
      LDB LIBD
      JSB DISCZ,I   RETURN TRACK TO DISC
      JSB SLVAG,I 
* 
* INTERPRET DATE. 
* 
PUR2  JSB PURNO     GET DAY OF YEAR.
      DEC -367
      CPA .+57B     TEST FOR NONZERO AND SLASH FOL- 
      SZB,RSS        LOWING.
      JMP PUR1      PARAMETER ERROR.
      STB PURDT     SAVE DATE.
      JSB PURNO     NOW GET THE YEAR. 
      DEC -100
      CPA .+15B     CHECK FOR RETURN FOLLOWING. 
      CLA,RSS 
      JMP PUR1
* 
      RRR 7         MERGE YEAR AND DATE.
      IOR PURDT 
      STA PURDT 
      JSB DATE      NOW GET TODAY'S DATE. 
      LDB PURDT     MAKE SURE SPECIFIED DATE IS 
      CMB,CLE,INB    <=TODAY'S DATE 
      ADA 1 
      SEZ,RSS 
      JMP PUR1
* 
* THE NEXT STEP IS TO GUARANTEE THAT WE DON'T KILL ANY FILES CUR- 
* RENTLY IN USE. TO DO THIS WE WILL CHECK THAT THE FUSS TABLE IS
* EMPTY.
* 
      LDA M2000     INPUT FUSS
      STA MWORD       TABLE 
      LDA FUSS
      LDB LIBDI 
      JSB DISCZ,I 
      JSB SICKP,I 
* 
      LDB LIBD
PUR4  CPB L1024     FINISHED ALL FUSS TABLES? 
      JMP PUR3        YES 
      LDA B,I         NO - GET ENTRY
      SZA             IS IT ZERO? 
      JMP PUR7          NO - PRINT ERROR MESSAGE
      INB               YES - TRY ANOTHER 
      JMP PUR3      YES.
      LDA 1,I 
      SZA 
      JMP PUR7
      INB 
      JMP PUR4
* 
* ROUTINE TO INPUT A NUMBER 
* 
PURNO NOP 
      JSB PURDG     GET A DIGIT 
      JMP LFRER     ILLEGAL IF NONE.
PURN1 STB PURN      SAVE PARTIAL RESULT.
      ADB PURNO,I   CHECK FOR OVERFLOW. 
      SSB,RSS 
      JMP PUR1
      JSB PURDG     GET NEXT DIGIT. 
      JMP PURN2     END OF NUMBER.
      LDA PURN      MULTIPLY PREVIOUS RESULT BY 10. 
      RAL,RAL 
      ADA PURN
      RAL 
      ADB 0         ADD IN NEW VALUE
      JMP PURN1     LOOP
PURN2 LDB PURN      RETURN NO.
      ISZ PURNO 
      JMP PURNO,I 
* 
* 
PURDG NOP           GET DECIMAL DIGIT 
      JSB T35CQ     GET CHAR. 
      JMP PURDG,I   NONE THERE. 
      LDB 0         DO DIGIT TEST.
      ADB M72B
      SSB,RSS 
      JMP PURDG,I 
      ADB .+10
      SSB,RSS 
      ISZ PURDG 
      JMP PURDG,I 
* 
* ERROR PRINT.
* 
PUR1  LDB .-18
      JSB PURER 
      OCT 5111
      ASC 8,LLEGAL PARAMETER
PUR7  LDB .-11
      JSB PURER 
      OCT 5102
      ASC 6,USY FILES 
PURER NOP 
      STB PURN
      LDA T35B1 
      STA MOVED 
      LDA PURER 
      STA MOVES 
      BRS 
      JSB MOVEW 
      LDA PURN
      CMA,INA 
      LDB T35B1 
      JMP LEND2 
* 
* 
*  SEARCH DIRECTORY 
* 
PUR3  EQU * 
      CLA 
      STA PURCT 
      LDB L8192 
      STB PURTP 
      LDB PUDIR     FIRST DIRECTORY TRACK 
PUR11 EQU * 
      STB PURDI 
      LDA B,I 
      SZA           LENGTH ZERO?
      JMP PUR13     NO
PUR12 EQU * 
      ADB .+7       YES 
      CPB PURDU     LAST ONE? 
      RSS           YES 
      JMP PUR11     NO
      JSB PURFX     FINISHE FIXUPS
      JMP LEND
PUR13 EQU * 
      STA MWORD 
      CMA,INA 
      ADA LIBD
      STA PURND     END OF TABLE POINTER
      ADB .+5 
      LDA B 
      LDB LIBDI 
      JSB DISCZ,I   READ DIRECTORY TRACK
      JSB DEADP,I 
      LDB LIBD
      STB MOVES 
      STB MOVED 
* 
* GENERATE A TABLE AT LIBUS+8192 IN WHICH EACH ENTRY REPRESENTS A 
* FILE OR PROGRAM TO BE PURGED, AND APPEARS AS: 
*     1) ID 
*     2) LENGTH IN + BLOCKS 
*     3) DISC 
*     4)   ADDRESS
* 
PUR15 EQU * 
      STB PURP      TABLE POINTER 
      ADB .+5 
      LDA PURDT 
      CMA,CLE,INA 
      ADA B,I 
      SEZ           THIS ENTRY TO BE DELETED? 
      JMP PUR16     NO
      ADB .-5       YES 
      LDA B,I       SAVE ID 
      STA PURTP,I 
      ADB .+11
      ISZ PURTP 
      LDA B,I       GET LENGTH
      SSA,RSS 
      JMP *+4 
      ALF,ALF 
      IOR HIMSK 
      CMA,INA 
      STA PURTP,I   SAVE + BLOCKS 
      ISZ PURTP 
      ADB .-3 
      LDA B,I       FIRST DISC WORD 
      STA PURTP,I 
      ISZ PURTP 
      INB 
      LDA B,I       SECOND DISC WORD
      STA PURTP,I 
      ISZ PURTP 
* 
      LDB PURP      MOVE
      CMB,INB         PORTION 
      ADB MOVES         OF
      JSB MOVEW           DIRECTORY 
      LDB PURP
      ADB .+12
      STB MOVES     UPDATE POINTER
      LDA PURDI,I   UPDATE
      ADA .+12      DIRECTORY 
      STA PURDI,I       LENGTH
      LDB PURCT     COUNT 
      INB             OF TABLE
      STB PURCT         ENTRIES 
      CPB P409      FULL? 
      RSS           YES 
      JMP PUR16     NO
      LDA MOVES 
      STA PUKES 
      LDA MOVED 
      STA PUKED 
      LDB LIBD      WRITE 
      LDA PURDI       OUT 
      ADA .+5           INTERIM 
      JSB DISCZ,I         DIRECTORY 
      JSB DEADP,I 
      JSB PURFX     CALL FIXUP ROUTINE
      LDA PUKES 
      STA MOVES 
      LDA PUKED 
      STA MOVED 
      LDA K8192 
      STA MWORD 
      LDA PURDI 
      ADA .+5 
      LDB LIBDI 
      JSB DISCZ,I   READ DIRECTORY BACK 
      JSB DEADP,I 
* 
PUR16 EQU * 
      LDB PURP
      ADB .+12
      CPB PURND     FINISHED TRACK
      RSS           YES 
      JMP PUR15     NO
      CMB,INB         END 
      ADB MOVES         OF
      JSB MOVEW           DIRECTORY 
      LDB PURDI 
      LDA B,I 
      STA MWORD 
      INB 
      STB MOVED 
      ADB .+4 
      LDA B 
      LDB LIBD
      STB MOVES 
      JSB DISCZ,I   WRITE OUT DIRECTORY 
      JSB DEADP,I 
      LDB .-4       RESET 
      JSB MOVEW       DIREC 
      LDB PURDI     GO DO 
      JMP PUR12       NEXT TRACK
* 
*  RETURN SPACE TO IDT, ADT AND DISC ADT
* 
PURFX NOP 
      LDA PURCT 
      CMA,INA 
      STA PURTC 
      CLA 
      STA PURCT 
      JSB RTAD,I    RETURN SPACE TO ADT 
      JSB RTID,I    RETURN SPACE TO IDT 
      LDB L8192 
      STB PURTP 
      JMP PURFX,I 
* 
PURCT EQU LTEMP+1 
PURDI EQU LTEMP+2 
PURTP EQU LTEMP+3 
PURTC EQU LTEMP+5 
PURND EQU LTEMP+6 
PURP  EQU LTEMP+7 
PURDT EQU LTEMP+8 
PURN  EQU LTEMP+9 
PUKES BSS 1 
PUKED BSS 1 
PUDIR DEF DIREC 
PURDU DEF DIREU 
P409  DEC 409 
K8192 DEC -8192 
PZ999 OCT 65747     USER NUMBER Z999
PURHE ASC 3,HELLO 
$PUR  EQU * 
