LABEL866

(George Source)

Macros used: CLOSETOP, COMBRKIN, COMERR, COOR1, DCA, DFJUMPS, DOWN, ENDCOM, FNORM, FREECORE, FREEMT, GEOERR, GPERI, HUNT, JALLOC, JWRONG, LGEOG, LOCK, LOCKC, MENDAREA, MHUNT, NAMETOP, OPENSYS, OUTMESS, OUTNUM, PARAPASS, PARSORT, SEGENTRY, SETALLOC, SETNCORE, SSEARCH, SWITRACE, TESTREP, UNLOAD, UNLOCK

LABEL866.txt
22FL    #LIS  K0LABEL>K0LIBRARY>K0ALLGEO
22^=    #SEG  LABEL65                      [S.FERGUSON  
23DW                   8HLABEL65
23YG    #   
24D6    #     THIS SEGMENT HANDLES THE LABEL COMMAND
24XQ    #   
25CB          SEGENTRY K1LABEL,QK1LABEL 
25X2    #   
26BL    #     CONSTANTS 
26W=    THDDR          4HHDDR   
27*W    TPOOL          20HPOOL TAPE   00000000  
27TG    TWTM           +11                 [+11 WHEN AVAILABLE  
28*6    #   
28SQ    #     S/R TO REWIND & DISCONNECT TAPE   
29#B    #   
29S2    TFREE   
2=?L          SBX   3  FX1  
2=R=          LDN   0  9                   [SET UP REWIND & DISCONNECT MODE 
2?=W          DCA      ,DLA,0,MODE  
2?QG          LOCK     2                   [FOR PERI
2#=6          GPERI    ,2   
2#PQ          COOR1 
2*9B          UNLOCK   2
2*P2          FREEMT
2B8L          ADX   3  FX1  
2BN=          EXIT  3  0
2C7W    #     DON'T READ HEADER ON 1971 DECKS AND LEAVE AT B.O.T.   
2CMG    #   
2D76    #                                  ENTRY POINT 1
2DLQ    QK1LABEL
2F6B ...      PARSORT  XBRK,GROPE   
2FL2 ...      SPARAPASS 
2G5L ...      HUNT     3,CPAR,JSCE  
2GK= ...      BPZ    3   P1 
2H4W ...      ENDCOM
2HJG ...P1    LDEX   5   JSCEA(3)         [ DECK NUMBER 
2J46 ...      LDCH   7   JSCEA(3)         [ DEVICE TYPE 
2JHQ ...      LDX    4   JSCEP(3)         [ DEVICE LIST ADDRESS 
2K3B ...      FREECORE   3  
2KH2 ...      LDX    3   4  
2L2L ...      SBN   7  5
2LG= ...      BZE   7  P5                  [MT  
2RW6    P28 
2S*Q          COMERR   JXALL
2STB    P5    JWRONG   3,WRNG   
2T*2          JALLOC   3,XALLOC 
2TSL          SETALLOC 3
2W#=          STO   3  CPPTR(2)            [MARK ALLOCATED  
2WRW          DFJUMPS  3,LOAD,XENG         [J IF MT LOADED ON DECK  
2X?G          BRN      P27  
2XR6    WRNG  OUTNUM   5,0                 [WRONGED 
2Y=Q          COMERR   ERWRONGED
2YQB    XALLOC  
2^=2          COMERR   JALOC               [ALREADY ALLOCATED   
2^PL    XENG
329=          UNLOAD   ,,,UNL              [UNLOAD DECK 
32NW ...      BRN      P5                 [TRY AGAIN
338G    P27 
33N6          PARAPASS                     [NAME
347Q          MHUNT    3,CPB,CUNI   
34MB          LDX   0  ANUM(3)  
3572          BPZ   0  P8                  [NON-EXISTENT
35LL    P9    CALL  3  TFREE               [FREE DECK   
366=          COMERR   AMISS,JFENTRANT  
36KW    P8    BZE   0  P9   
375G          NAMETOP  3,FILE,FNAME 
37K6          FNORM                        [DECODE  
384Q          TESTREP  OK,P10   
38JB          CALL  3  TFREE               [FREE DECK   
3942          ENDCOM
39HL    P10 
3=3=          MHUNT    3,FILE,FABSNB
3=GW          LDX   0  ATYPE(3) 
3?2G          ANDN  0  #2000
3?G6          BNZ   0  P11  
3?^Q          CALL  3  TFREE               [FREE DECK   
3#FB          COMERR   AMISS,ERNOP  
3#^2    #              DUMP CA WORDS
3*DL    P11 
3*Y=          SMO      HDREC(3) 
3BCW          LDXC  6  A1+1(3)             [LOAD THE TSN SPECIFIED IN COMMAND   
3BXG          BCS      P31                 [JUMP IF XENO TAPE   
3CC6          OPENSYS  XBRKIN,SERIAL,READ   
3CWQ          SSEARCH  P30,6               [IS TSN IN USE,IF NOT J TO P30   
3DBB          CLOSETOP                     [CLOSE SERIAL
3DW2          CALL  3  TFREE               [FREE DECK   
3F*L          COMERR   ERALKNOWN           [ERROR MESSAGE   
3FKD ...XBRK  COMBRKIN  
3FT=    XBRKIN GEOERR  1,XBRKIN 
3G#W    P30   CLOSETOP                     [CLOSE SERIAL
3GSG    P31 
3H#6          SMO      FX1  
3HRQ          LDX   0  TWTM 
3J?B          STO   0  AWORK2(2)
3JR2    #SKI  K6LABEL>199-199   
3K=L          SWITRACE 0,LBPARA 
3KQ=          DOWN     TAPEWAIT,1          [WAIT FOR TAPE TO BE LOADED  
3L9W    #SKI  K6LABEL>99-99 
3LPG          SWITRACE EXEC3(2),LBTWTREP
3M96          TESTREP  OK,P12   
3MNQ          TESTREP  NONS,P20 
3N8B          TESTREP  NOTAV,P28           [1971
3NN2          TESTREPN NOWPR,P22
3P7L          COMERR   HNOWPR              [NO WRITE PERMIT 
3PM=    P22   TESTREPN UNLOADED,P23 
3Q6W          COMERR   HRCAN               [CANCELLED   
3QLG    P23 
3R66          TESTREPN FAILED,P13   
3RKQ    P17   OUTMESS  HLAB2
3S5B          COMERR   HFAIL               [FAILED  
3SK2    P13   TESTREPN SECURE,P20          [MUST BE NON-STANDARD
3T4L          OUTMESS  HLAB1
3TJ=          COMERR   HSEC                [SECURE TAPE 
3W3W    P12   MHUNT    3,FLIB,FMAGH 
3WHG          BRN      P21  
3X36    P20   SETNCORE 20,3,FLIB,FMAGH  
3XGQ    P21 
3Y2B          STOZ     A1(3)
3YG2          LDN   0  A1(3)
3Y^L          LDN   1  A1+1(3)  
3^F=          MOVE  0  19                  [ZEROISE BLOCK   
3^YW          LDX   1  FX1  
42DG          LDX   0  THDDR(1) 
42Y6          STO   0  A1(3)               [HDDR
43CQ          MHUNT    2,FILE,FABSNB
43XB          SMO      HDREC(2) 
44C2          LDXC  0  A1+1(2)  
44WL          BRN      £
45B=          STO   0  A1+1(3)             [TSN 
45TW          SMO      HDREC(2) 
46*G          LDX   0  A1-6(2)             [FIRST WORD OF 'LOCAL NAME'  
46T6          BNZ   0  P14                 [NOT UNSPECIFIED 
47#Q          LDN   0  TPOOL(1) 
47SB          BRN      P15  
48#2    P14   SMO      HDREC(2) 
48RL          LDN   0  A1-6(2)  
49?=    P15   LDN   1  A1+2(3)  
49QW          MOVE  0  5                   [NAME+DETAILS
4==G          LDN   0  #777 
4=Q6          ANDS  0  A1+5(3)  
4?9Q          LDN   0  #7777
4?PB          ANDS  0  A1+6(3)             [TRUNCATE GENERATION 
4#92          SMO      HDREC(2) 
4#NL          LDX   0  A1(2)               [RETENTION PERIOD
4*8=          ADN   0  1
4*MW          BZE   0  P24                 [NOT SPECIFIED   
4B7G          SBN   0  1
4B=5 ...[ IF SECURITY BIT SET THEN OR IN BIT 0  
4B#N ...      BPZ   0  P24  
4BC? ...      ANDN  0  #7777
4BFW ...      ORX   0  GSIGN
4BJF ...      BRN      P24A 
4BM6    P24   ANDN  0  #7777               [TRUNCATE
4C6Q ...P24A  STO   0  A1+7(3)             [STORE   
4CLB          LDX   0  EDATE
4D62          STO   0  A1+8(3)             [DATE WRITTEN
4DKL          LDX   2  FX2  
4F5=          LGEOG    ,0   
4FJW          SLL   0  18   
4G4G          STO   0  A1+9(3)             [SAVE GEOG NO IN CH 0 OF WD 9
4GJ6    #              ERASE AT B.O.T.  
4H3Q          LOCKC    FX2,£
4HHB          LDX   3  CPPTR(2)            [DEVICE LIST POINTER 
4J32          LDN   0  8                   [ERASE MODE  
4JGL          DCA      3,DLA,0,MODE 
4K2=          LDN   0  #3777
4KFW          DCA      3,STO,0,COUNT
4K^G          GPERI    3,2                 [ERASE PERI  
4LF6          COOR1 
4LYQ    #SKI  K6LABEL>199-199   
4MDB          SWITRACE CPRW1(2),LBERREP 
4MY2          LDCH  0  CPRW1(2)            [REPLY   
4NCL          BZE   0  P25                 [OK  
4NX=          UNLOCK   2
4PBW          BRN      P26  
4PWG    #              WRITE NEW HEADER LABEL   
4QB6    P25 
4QTQ          MHUNT    1,FLIB,FMAGH 
4R*B          LOCKC    1,SERCHF 
4RT2          MHUNT    1,FLIB,FMAGH 
4S#L          LDN   0  A1(1)               [BUFFER ADDRESS  
4SS=          DCA      3,STO,0,CTSA 
4T?W          LDN   0  20                  [LENGTH  
4TRG          DCA      3,STO,0,COUNT
4W?6          LDN   0  1                   [WRITE MODE  
4WQQ          DCA      3,DLA,0,MODE 
4X=B          GPERI    3,2  
4XQ2          COOR1 
4Y9L          UNLOCK   2
4YP=          MHUNT    1,FLIB,FMAGH 
4^8W          UNLOCK   1
4^NG    #              CHECK REPLY  
5286    #SKI  K6LABEL>199-199   
52MQ          SWITRACE CPRW1(2),LBWRREP 
537B          LDCH  0  CPRW1(2) 
53M2          BZE   0  P16  
546L    P26 
54L=          UNLOAD   ,,,UNL,AUT,NSD      [UNLOAD TAPE 
555W          BRN      P17                 [REPORT ERROR
55KG    #              REPORT SUCCESS & UNLOAD TAPE 
5656    P16 
56JQ          UNLOAD   ,,,UNL,AUT,NSD   
574B          ENDCOM
57J2    SERCHF  
583L          HUNT     2,FLIB,FMAGH 
58H=          EXIT  1  0
592W          MENDAREA 50,K99LABEL  
59GG    #END
^^^^ ...14670321000300000000
  • Last modified: 17/01/2024 11:55
  • by 127.0.0.1