GETONA867

(George Source)

Macros used: ALTLEN, CAPCA, CHECKEXT, CLOSETOP, COMERR, DFLOAD, DOWN, ENDCOM, ERROR, FSHCODE, FSHSKIP, GEOERR, GETWORD, HLSXONCH, ILLEGAL, JFREZFCB, LGEOG, MENDAREA, MFREE, MHUNT, MONOUT, MTHWSPD, OPEN, OUTMOVE, OUTPACK, OUTPAR, PICKREP, PROGBRKIN, PUTPERENT, PUTREP, RUNPROG, SEGENTRY, SETNCORE, SETUPMODE, SKIP, STEPBACK, TESTERR, TESTREP, TESTREPNOT, TOPFCB, TRACE, WORDFIN

GETONA867.txt
22FL ...#LIS  K0GETONA>K0LIBRARY>K0ALLGEO   
22^=    #SEG           GETONA65             [N.R.BOULT  
2357 ...[   
2394 ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982
23#^ ...[   
23DW                   8HGETONA 
23YG    #     THIS SEGMENT CONTROLS IMPLEMENTATION OF   
24D6    #      UNANTICIPATED OPEN MODE PERI 
24XQ    [       MODE #400   
25CB          SEGENTRY K1GETONA,QK1GETONA   
25X2    QK1GETONA   
26BL    [ENTRY POINT FOR MODE 400 UNANTICIPATED MT PERI 
26W= ...#SKIP K6GETONA  
27*W ...      TRACE    2,GETONA2
27TG          ANDX  4  REMPROP(1)   
28*6    #     SET UP FILE/FABSNB BLOCK AND FILL FROM OBJECT PROGRAM 
28SQ          SETNCORE 11,3,FILE,FABSNB 
29#B          LDN   6  9
29S2          CHECKEXT EVENT2(2),6,NOCA,,W,Q1,HLOCK1
2=?L    Q2  
2=R=          LDN   7  A1+2(3)  
2?=W          OUTMOVE  2,EVENT2(2),7,6  
2?QG          LDX   7  EVENT2(2)           [CONTROL AREA ADDRESS
2#=6          STO   4  AWORK1(2)
2#PQ          STO   7  AWORK3(2)
2*9B          MHUNT    3,FILE,FABSNB       [TEST VALIDITY OF NEW NAME   
2*P2          LDCH  0  A1+4(3)  
2B8L          SBN   0  #41  
2BN=          BNG   0  QILP                [ERROR < A   
2C7W          SBN   0  #32  
2CMG          BPZ   0  QILP                [ERROR > Z   
2D76          LDN   1  11                  [COUNT OF 11 
2DLQ    QVT1  BCHX  3  £
2F6B          LDCH  0  A1+4(3)  
2FL2          SBN   0  #41  
2G5L          BPZ   0  QVT2                [J >= A  
2GK=          ADN   0  23   
2H4W          BNG   0  QVT                 [OK IF DIGIT 
2HJG          SBN   0  6
2J46          BZE   0  QVT                 [OK IF SPACE 
2JHQ          SBN   0  #15  
2K3B          BZE   0  QVT                 [OK IF HYPHEN
2KH2          BRN      QILP 
2L2L    QVT2  SBN   0  #32  
2LG=          BPZ   0  QILP                [ERROR > Z   
2L^W    QVT   BCT   1  QVT1                [IF CHECK UNFINISHED,BACK FOR NEXT   
2MFG          BCHX  3  £
2M^6          LDX   0  A1+4(3)  
2NDQ          SMO      FX1  
2NYB          TXL   0  REELMAX  
2PD2          BCC      QILP                [REEL NR OUT OF RANGE
2PXL          LDN   0  #7777
2QC=          ANDS  0  A1+5(3)             [TRUNCATE GENERATION 
2QWW          LDX   3  EVENT3(2)
2RBG          SRL   3  6                   [PROPERTY CODE   
2RW6          ANDN  3  #743 
2S*Q          LDN   6  0
2STB          BZE   3  QPR9                [BRANCH IF NO PROPERTY SPECIFIED 
2T*2          MTHWSPD  3,6  
2TSL    QPR9
2W#=    #     TRANSFER TO COMMAND ACTIVITY AND PREPARE TO GET TAPE  
2WRW    QVT3
2X?G          CAPCA    FILE,FABSNB  
2XR6          HLSXONCH QBRKIN,AWORK1(2),QHLSIL [ASK HLS IF ANUVER TAPE ALLOWED  
2Y=Q          MHUNT    3,FILE,FABSNB
2YQB          LDX   0  A1+9(3)  
2^=2          STO   0  A1+10(3)            [RETENTION PERIOD
2^PL          STOZ     A1+9(3)  
329=          LDN   0  CPREFIX(2)   
32NW          LDN   1  A1+1(3)  
338G          MOVE  0  3                   [USER NAME   
33N6          LDN   0  10   
347Q          STO   0  HDREC(3)            [RECORD HEADER   
34MB    #     CHECK OWNERSHIP OF TAPE   
3572          LDX   0  ATYPE(3) 
35LL          ANDN  0  #200 
366=          BNZ   0  PO4                 [BRANCH IF NAMED WORKTAPE
36KW          LDX   0  HDREC(3) 
375G          SBN   0  10   
37K6          BNG   0  PE1  
384Q          ADN   0  4
38JB          STO   0  HDREC(3)            [INSERT REDUCED LENGTH   
3942          LDX   0  ACES 
39HL          SMO      HDREC(3) 
3=3=          STO   0  A1+5(3)  
3=GW          NGN   0  #101                [REMOVE  LANG CODE BIT   
3?2G          ANDS  0  ATYPE(3) 
3?G6    PO1 
3?^Q          FSHCODE  B,XFSHBOPEN  
3#FB    (   
3#^2          OPEN     PG4,GENERAL,QUERY   [OPEN DIRECTORY  
3*DL    XFSHBOPEN   
3*Y=    )   
3BCW          FSHSKIP  B,XFSHNBOPEN 
3BXG    (   
3CC6          OPEN     PG4,READ,QUERY   
3CWQ    XFSHNBOPEN  
3DBB    )   
3DW2          TESTREP  OK,P03   
3F*L          TESTERR  NAME,TERR
3FT=          TESTREP  NOFILE,PE4   
3G#W          TESTREP  VRYWRONG,PE4 
3GSG          TESTREP  NOUSER,PE4   
3H#6          GEOERR   1,REPLY  
3HRQ    P03 
3J?B          MHUNT    2,FILE,FABSNB       [THE FABSNB NEEDS TO BE SET  
3JR2          LDN   0  6                   [TO CONTAIN :USER.LOCALNAME  ONLY
3K=L          ADS   0  A1(2)               [THIS IS FOR LATER USE WHEN  
3KQ=          LDX   0  A1(2)               [UPDATING BUDGETS
3L9W          SBN   0  10   
3LPG          BZE   0  P02  
3M96          LDX   3  2
3MNQ          TOPFCB   1
3N8B          ADN   1  FME1 
3NN2          ADN   2  A1+1 
3P7L          MOVE  1  3
3PM=          SMO      A1(3)
3Q6W          LDN   1  A1-6(3)  
3QLG          LDN   2  A1+4(3)  
3R66          LDX   5  ALOGLEN(3)   
3RKQ          SBX   5  A1(3)
3S5B          ADN   5  6
3SK2          SMO      5
3T4L          MOVE  1  0                   [MOVE LOCAL NAME UP FABSNB   
3TJ=          ADN   5  4
3W3W          LDN   1  10   
3WHG          STO   1  A1(3)
3X36          ALTLEN   3,5,FILE,FABSNB  
3XGQ    P02 
3Y2B          TOPFCB   3                   [X3 POINTS TO DIRECTORY'S FILE-FCB   
3YG2          JFREZFCB 3,PERR3,NOADJ       [TEST FOR FROZEN DIRS & OWNACC+INFACC
3Y^L          OWNERCHECK NOADJ             [CHECK OWNERSHIP;WITH PRIVS IF NECSRY
3^F=          PICKREP  3
3^YW          CLOSETOP                     [CLOSE DIRECTORY 
42DG          PUTREP   3
42Y6          TESTREP  OK,P03D             [OWNERSHIP OK?   
43CQ          LDX   0  5
43XB          ANDX  0  MASKMON(1)   
44C2          TXU   0  OWNMON(1)           [OWN MONITORING REQUIRED?
44WL          BCC      Q4                  [J TO SET B0 OF REPLY WORD ETC   
45B=          MONOUT   ILACCFB             [MF COMMENT - UNAUTHORISED ACCESS
45TW ...      BRN      Q7                  [J FOR ILLEGAL MESSAGE   
46*G    P03D
46T6          MHUNT    3,FILE,FABSNB
47#Q    PO4 
47SB          LDN   0  1
48#2          ORS   0  ATYPE(3)            [NON-FILESTORE ENTRANT REQUIRED  
48RL    #     GO TO GET TAPE
49?=          LDX   1  FX1  
49QW          LDX   0  5
4==G          ANDX  0  MASKMON(1)   
4=Q6          TXU   0  OWNMON(1)
4?9Q          BCS      QN1                 [NOT OWN MONITORING  
4?PB          SETUPMODE ,0,TAPEUP   
4#92          BRN      QN2  
4#NL    QN1   LDN   0  0
4*8=    QN2   STO   0  AWORK2(2)           [MODE
4*MW          STO   6  ACOMMUNE1(2)        [SPECIAL PROPERTY DESCRIPTION
4B7G          DOWN     GET,4
4BM6          BRN      QBRKIN              [J IF BREAKIN
4C6Q          TESTREP  OK,Q3
4CLB          LDX   0  5
4D62          ANDX  0  MASKMON(1)   
4DKL          TXU   0  OWNMON(1)
4F5=          BCC      Q4                  [J IF OWN MONITORING 
4FJW          TESTREP  NOTAV,QN2A   
4G4G          TESTREPN NODECKS,PQ   
4GJ6    QN2A
4H3Q          NGN   4  1
4HHB          BRN      Q5   
4J32    Q4    LDN   4  0
4JGL    Q5    LDX   5  TFAIL(1)            [FAIL REPLY  
4K2=          BRN      Q6   
4KFW    Q1    MHUNT    3,FILE,FABSNB
4K^G          BRN      Q2   
4LF6    NOCA  MFREE    FILE,FABSNB  
4LYQ          ILLEGAL  NOCA 
4MDB    Q3    LDX   4  AWORK1(2)
4MY2          LDX   5  CPPTR(2) 
4NCL          PUTPERENT 4,5 
4NX=          OUTPAR   TIMENOW  
4PBW          LGEOG    5,3  
4PWG    QSJ1
4QB6          OUTPACK  3,1,GEOPER,QSJ1  
4QTQ    QSJ2
4R*B          OUTPACK  4,1,PERINAME,QSJ2
4RT2          DFLOAD   5,TSN,3  
4S#L    QSJ3
4SS=          OUTPACK  3,1,TSN,QSJ3 
4T?W    QSJ4
4TRG          MHUNT    3,FILE,FABSNB
4W?6          ADX   3  HDREC(3) 
4WQQ          OUTPACK  A1-6(3),3,LOCNAME,QSJ4   
4X=B    QSJ5
4XQ2          MHUNT    3,FILE,FABSNB
4Y9L          ADX   3  HDREC(3) 
4YP=          OUTPACK  A1-2(3),1,GENNUM,QSJ5
4^8W    QSJ6
4^NG          MHUNT    3,FILE,FABSNB
5286          ADX   3  HDREC(3) 
52MQ          OUTPACK  A1-3(3),1,REELNUM,QSJ6   
537B          OUTPAR   SKIP 
53M2          MONOUT   JPER 
546L          DFLOAD   5,TSN,5           [LOAD TSN FOR REPLY TO PROG.   
54L=          LDN   4  0
555W    Q6    LDX   7  AWORK3(2)
55KG          ADN   7  1
5656          GETWORD  7,3,WRITE           [SET REPLY   
56JQ          TESTREPNOT OK,PG2 
574B          STO   5  0(3) 
57J2          WORDFIN   
583L          BNZ   4  Q7   
58H=          RUNPROG                      [RESTART PROGRAM 
592W    Q7  
59GG          LDX   4  AWORK1(2)
5=26          ANDN  4  #777                [PROGRAM UNIT UNUBER 
5=FQ ...      LDCT  0  5
5=^B ...      ORX   4  0
5?F2 ...      OUTPACK  4,1,PERINAME 
5L8Q    QPERF   
5LNB          ILLEGAL  PERFAIL1 
5M82    QILP  ILLEGAL  ILLINS   
5MML    #     ERROR REPORTING   
5N7=    QHLSIL  
5NLW          MONOUT   ERHLSMODE
5P6G          LDX   0  5
5PL6          ANDX  0  MASKMON(1)   
5Q5Q          TXU   0  OWNMON(1)
5QKB          BCC      Q4                  [J IF OWN MONITORING 
5R52          BRN      QN2A 
5RJL    PERR3   
5S4=          CLOSETOP  
5SHW          LDX   0  5
5T3G          ANDX  0  MASKMON(1)   
5TH6          TXU   0  OWNMON(1)           [IF OWN MONITORING REQD -
5W2Q          BCC      Q4                  [J TO SET B0 OF REPLY WORD ETC   
5WGB          MONOUT   FROZDIRFB           [ELSE GIVE MF COMMENT - DIR FROZEN   
5WHR ...      BRN      Q7                  [AND GIVE MT FAIL MESSAGE
5WK8 ...PQ  
5WLK ...      TESTREPN ODRAWN,PQ1   
5WN2 ...      ERROR    BUDGODR,BUDGSPA  
5WPC ...TERR  ENDCOM
5WQS ...PQ1 
5WS9 ...      TESTREPN INCREASE,PQ2 
5WTL ...      ERROR    BUDGINC,BUDGSPA  
5WX3 ...      BRN      TERR 
5WYD ...PQ2 
5W^T ...      TESTREP  ALREADY,TERR 
5X3= ...      TESTERR  NAME,TERR
5X4M ...      TESTREP  WRGEN,TERR   
5X64 ...      TESTREP  VRYWRONG,TERR
5X7F ...      TESTREP  TEMP,TERR
5X8W ...      TESTREP  NODECKS,PE5  
5X=? ...      GEOERR   1,GETREP 
5X?N ...PE1   COMERR   AMTDESC,JLOCN       [SERIAL NUMBER GIVEN 
5X*5 ...PE4 
5XBG ...      COMERR   ERNAME   
5XCX ...PE5   COMERR   ERNODECKS
5XFL    #     BREAKIN EXITS 
5X^=    QBRKIN  
5YDW          STEPBACK  
5YYG          MFREE    FILE,FABSNB  
5^D6           PROGBRKIN
5^XQ    #     CONSTANTS 
62CB    QTEN           100  
62X2    QMT            #55640000
64TG    OWNMON         #34000   
65*6    MASKMON        #76000   
65SQ    TFAIL          #40000000
68=W    REMPROP        #77700077
68GN ...REELMAX             +512
68QG    #     GEORGE ERRORS 
69PQ    PG2   GEOERR   BRIEFPM,SHORTBLK 
6=P2    PG4   GEOERR   BRIEFPM,BREAKIN  
6?8L          MENDAREA  1023-0?,K99GETON
6?N=    #END
^^^^ ...447373500001
  • Last modified: 17/01/2024 11:55
  • by 127.0.0.1