MACROS GEM [ICL George 3]

This page is read only. You can view the source, but not change it. Ask your administrator if you think this is wrong.
{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: MACROS GEM)}}
====== MACROS GEM ======
(George Source)


<code - MACROS GEM.txt>22FL    #   
22^=    #              RUTH HEAP
23DW    #   
23NN ...[??? FLENME SECT CENT FGN 1 DOC 
23YG    #     THIS MACRO IS A BIT OF CODE!  
24D6    #     ITS PURPOSE IS TO GET A FILENAME FROM A BLOCK OR ANY WHERE ELSE.  
24XQ    #     %A IS THE RELATIVE ADDRESS OF USER-NAME.  
25CB    #     %B IS        DO            OF LOCAL-FILE-NAME.
25X2    #     %C DESCRIBED AT END OF MACRO. 
26BL    #   
26W=    #     X2 CONTAINS A GEORGE ADDRESS: %A & %B ARE RELATIVE TO THIS.   
27*W    #     X7 CONTAINS THE GEORGE ADDRESS OF THE O/P BUFFER. 
27TG    #   
28*6    #     ALL ACCS ARE USE EXCEPT X3.   
28SQ    #     X7 WILL POINT TO THE NEXT AVAILABLE CHAR IN THE O/P BUFFER.   
29#B    #     THE FIRST WORD OF THE RECORD WILL BE THE NUMBER OF CHARACTERS.
29S2    #     THE FORMAT  IS
2=?L    #     :USER.LOCAL   
2=R=    #MAC           FLENME   
2?=W    #   
2?QG          LDX   1  7                   [GEO. ADDRESS OF O/P.
2#=6          STOZ     0(1)                [ZEROISE CH. COUNT.  
2#PQ          ADN   7  1                   [STEP PAST THE COUNT WORD.   
2*9B    #   
2*P2          CALL  5  MFLENME1            [ROUTINE UPDATES COUNT AND INSERTS   
2B8L ...[                                   FILE-NAME INTO BLOCK.   
2BN=          LDN   4  #12                 [COLON   
2C7W          SBN   2  %A                  [SET X2 TO POINT TO LOCAL-   
2CMG          ADN   2  %B                  [FILE-NAME.  
2D76          CALL  5  MFLENME1 
2DLQ          LDN   4  #36                 [FULL STOP.  
2F6B          BRN      MFLENME6 
2FL2    #   
2G5L ...[     TRANSFER ROUTINE. 
2GK=    #   
2H4W    MFLENME1
2HJG          LDN   4  12                  [TOTAL NUMBER OF CHARACTERS. 
2J46          LDN   6  0
2JHQ    MFLENME2
2K3B          LDCH  0  %A(2)               [LOAD CHARACTER. 
2KH2          SBN   0  #20                 [SPACE   
2L2L          BNZ   0  MFLENME3 
2LG=          ADN   6  1                   [NO OF TRAILING SPACE.   
2L^W          BRN      MFLENME4 
2MFG    MFLENME3
2M^6          LDN   6  0                   [ZEROISE NO OF TRAILING SPACES.  
2NDQ    MFLENME4
2NYB          BCHX  2  £                   [STEP CHAR. POSN.
2PD2          BCT   4  MFLENME2 
2PXL    #   
2QC=          SBN   2  3                   [SET BACK X2 
2QWW          LDX   4  %A(2)
2RBG          BZE   4  MFLENME5            [NOT LOCAL-FILE-NAME 
2RW6          NGX   4  6
2S*Q          ADN   4  13                  [NO OF CHARAVTERS.   
2STB          LDX   0  1                   [STORE X1
2T*2          ADS   4  0(1)                [ADD NO OF CHARACTERS.   
2TSL          LDX   1  5                   [ADDRESS OF PARAMETER.   
2W#=          OBEY     0(1)                [GET COLON OR FULL STOP. 
2WRW          LDX   1  7                   [PUT ADDRESS INTO MODIFIER   
2X?G          DCH   4  0(1)                [DEPOSITE
2XR6          BCHX  7  £                   [STEP PAST   
2Y=Q          NGX   1  6
2YQB          ADN   1  12                  [NUMBER OF CHARACTERS
2^=2          LDN   6  %A(2)               [ADDRESS OF STRING.  
2^PL          MVCH  6  0(1) 
329=          LDX   1  0                   [RESTORE X1  
32NW    MFLENME5
338G          EXIT  5  1
33N6    #   
347Q    #   
34MB    MFLENME6
3572    #   
35LL    #STRING        2,%C 
366=    #SKI
36KW    (   
375G          SBN   2  %B   
37K6          ADN   2  %A   
384Q    )   
38JB ...[              THIS WILL RESTORE X2 TO ITS ORIGINAL VALUE IF %C=2.  
3942    #   
39HL    #NOR
39RD ...[??? FLENME1 SECT CENT FGN 1 DOC
3=3=    #   
3=GW    #  THIS  ACRO CONVERTS THE USER AND LOCAL NAMES SPECIFIED INTO THE  
3?2G    #     FORMAT :- 
3?G6    #           :USER.LOCAL NAME
3?^Q    #   
3#FB    #MAC  FLENME1   
3#^2          LDN   %C 2
3*DL          LDN   6  %A(%B)   
3*Y=          LDX   %B 7
3BCW          LDN   0  #12  
3BXG    M1FLENME1   
3CC6          DCH   0  0(%B)
3CWQ          BCHX  7  £
3DBB          MVCH  6  12   
3DW2          SLC   7  2
3F*L    M2FLENME1   
3FT=          SBN   7  1
3G#W          LDX   %B 7
3GSG          SRC   %B 2
3H#6          LDCH  0  0(%B)
3HRQ          SBN   0  #20  
3J?B          BZE   0  M2FLENME1
3JR2          BCHX  %B £
3K=L          LDN   0  #36  
3KQ=          LDX   7  %B   
3L9W          BCT   %C M1FLENME1
3LPG    #NOR
3L^# ...[??? XCBINDEX SECT CENT FGN 1 DOC   
3M96    #   
3MNQ    #MAC           XCBINDEX 
3N8B          CALL  %A MXCBINDEX1          [%A IS THE LINK ADRESS   
3NN2    #OPT           MXCBINDEX2=1 
3P7L    #SKI           MXCBINDEX2   
3PM=    (   
3Q6W          BRN      MY                  [BRN PAST END OF SUBROUTINE  
3QLG    #DEF           MXCBINDEX1=0?       [TRANSFER ADRESS.
3R66    #STR           7,%C                [SKI IF %C = 7.  
3RKQ          LDX   7  %C   
3S5B          SMO      FX1  
3SK2          MPY   7  MNO                 [MULTIPLY BY STRAUSS NO. 
3T4L          MODE     1
3TJ=          LDX   6  ACES 
3W3W          DCH   6  0(%B)               [STORE SPACE IN FIRST CH.
3WHG          BCHX  %B £              [STEP MOD.ACC.
3X36          LDN   6  6                   [COUNT.  
3XGQ    MD    CBD   7  0(%B)
3Y2B          BCHX  %B £
3YG2          BCT   6  MD                  [LOOP 6 TIMES.   
3Y^L          MODE     0
3^F=          CBD   7  0(%B)
3^YW          BCHX  %B £
42DG          EXIT  %A 0
42Y6    MNO            +7036875            [THE MAGIC NUMBER.   
43CQ    MY  
43XB    )   
44C2    #FREE          MXCBINDEX2          [FREE IDENTIFIER.
44WL    #DEF           MXCBINDEX2=0        [SET IT. 
45B=    #   
45TW ...[              THE MACRO CONVERTS BIN TO DEC.   
46*G ...[              %C CONTAINS THE BIN NO.  
46T6 ...[              %B IS A MODIFIER CONT. THE GEORGE ADRESS 
47#Q ...[              TO WHICH THE ANS IS PUT. 
47SB ...[              %A IS THE LINK WORD  
48#2    #   
48RL    #NOR
49?=    #   
49QW ...[??? WSNARROW SECT CENT FGN 2 DOC   
4==G ...[ WSNARROW MACRO TO SHORTEN WS OUTPUT   
4=Q6 ...#MAC  WSNARROW  
4?9Q ...[ MACRO TO SWITCH ON OR OFF RESTRICTION OF WS OUTPUT
4?PB ...#STR  %A,ALL
4#92 ...#SKI                               [INC IF ALL  
4#NL ...(   
4*8= ...     WSNARROW  OFF  
4*MW ...#MEN WSPARAM
4B7G ...#TRA K50WSPARAM+1   
4BM6 ...#FID  2 2 1 
4C6Q ...#END
4CLB ...#MEN  QPRINT
4D62 ...#TRA K50QPRINT+1
4DKL ...#FID  2 2 1 
4F5= ...#END
4FJW ...#EXI
4G4G ...)   
4GJ6 ...#STR  %A,OPERATOR   
4H3Q ...#SKI                               [INC IF OPERATOR 
4HHB ...(   
4J32 ...     WSNARROW  OFF  
4JGL ...#MEN WSPARAM
4K2= ...#TRA K50WSPARAM+1   
4KFW ...#FID  1 1 1 
4K^G ...#END
4LF6 ...#MEN  QPRINT
4LYQ ...#TRA K50QPRINT+1
4MDB ...#FID  1 1 1 
4MY2 ...#END
4NCL ...#EXI
4NX= ...)   
4PBW ...#STR  %A,OFF
4PWG ...#SKI                               [INC IF OFF  
4QB6 ...(   
4QTQ ...#MEN  QPRINT
4R*B ...#TRA  K50QPRINT 
4RT2 ...#DEF M1=34?+0?]&#47777777   
4S#L ...     +M1
4SS= ...#END
4T?W ...#MEN WSPARAM
4TRG ...#TRA K50WSPARAM 
4W?6 ...#DEF  M2=34?+0?]&#47777777  
4WQQ ...     +M2
4X=B ...#FRE M1 
4XQ2 ...#FRE M2 
4Y9L ...#END
4YP= ...#EXI
4^8W ...)   
4^NG ...! PARAMETER MUST BE OFF,OPERATOR OR ALL 
5286 ...#NOR
52MQ ...[   
537B ...[   
53M2 ...[??? PRESETRP SECT CENT 
546L ...[RESTORE-TIME MACRO TO SET INITIAL REPORTING LEVEL  
54L= ...[THERE ARE THREE SUPPLEMENTARY MACROS WHICH ARE USED
555W ...[BY PRESETRP; THESE ARE SETRPMSK, SETRPMEN AND SETRPERR 
55KG ...[   
5656 ...[??? SETRPMSK SECT CENT 
56JQ ...[SETS UP A REPORTING MASK   
574B ...[   
57J2 ...#MAC SETRPMSK   
583L ...#STR %A 
58H= ...(   
592W ...#DEF 20?=20?^(1@L(23-CB%A))     [SET BIT CORRESP TO %A  
59GG ...    SETRPMSK %B,%C,%D,%E,%F,%G,%H,%I,%J,%K,%L,%M,%N,%O,%P   
5=26 ...)   
5=FQ ...#NOR
5=^B ...[   
5?F2 ...[??? SETRPMEN SECT CENT 
5?YL ...[MENDS CALCULATED MASK INTO SEGMENTS
5#D= ...[   
5#XW ...#MAC SETRPMEN   
5*CG ...#MEN BLOGNAL
5*X6 ...#TRA K25BLOGNAL 
5BBQ ...      +AMXMSKPR 
5BWB ...#END
5CB2 ...#MEN CIMOP  
5CTL ...#TRA K25CIMOP   
5D*= ...      +AMXMSKPR 
5DSW ...#END
5F#G ...#MEN CONNECTA   
5FS6 ...#TRA K25CONNECTA
5G?Q ...      +AMXMSKPR 
5GRB ...#END
5H?2 ...#MEN DSCNCT 
5HQL ...#TRA K25DSCNCT  
5J== ...      +AMXMSKPR 
5JPW ...#END
5K9G ...#MEN IPBSCAN
5KP6 ...#TRA K25IPBSCAN 
5L8Q ...      +AMXMSKPR 
5LNB ...#END
5M82 ...#MEN LOGOUT 
5MML ...#TRA K25LOGOUT  
5N7= ...      +AMXMSKPR 
5NLW ...#END
5P6G ...#MEN SCAN   
5PL6 ...#TRA K25SCAN
5Q5Q ...      +AMXMSKPR 
5QKB ...#END
5R52 ...#NOR
5RJL ...[   
5S4= ...[??? SETRPERR SECT CENT 
5SHW ...[THIS MACRO REPORTS ERRORS IN PRESETRP  
5T3G ...[   
5TH6 ...#MAC SETRPERR   
5W2Q ...#CON PRESETRP - PARAMETER ERROR 
5WGB ...! PRESETRP - PARAMETER ERROR
5X22 ...#NOR
5XFL ...[   
5X^= ...[   
5YDW ...#MAC PRESETRP   
5YYG ...#STR %A 
5^D6 ...#SKI
5^XQ ...#EXI                    [IF NO PARAMS, DO NOTHING   
62CB ...#DEF 20?=0  
62X2 ...#DEF 21?=#00075777      [ALL PERMITTED CATEGORIES   
63BL ...#DEF 22?=#21200000      [READY,BREAKIN,FORCETYP 
63W= ...#STR %A,NONE
64*W ...#SKI
64TG ...(   
65*6 ...[%A = NONE  
65SQ ...#STR %B 
66#B ...(   
66S2 ...    SETRPERR            [ERROR IF ANY OTHER PARAMS  
67?L ...#EXI
67R= ...)   
68=W ...#ALT AMXMSKPR=22?       [MIN ALLOWED
68QG ...    SETRPMEN
69=6 ...#EXI
69PQ ...)   
6=9B ...#STR %A,ALL 
6=P2 ...#SKI
6?8L ...(   
6?N= ...[%A = ALL   
6#7W ...#STR %B 
6#MG ...(   
6*76 ...    SETRPERR            [ERROR IF ANY OTHER PARAMS  
6*LQ ...#EXI
6B6B ...)   
6BL2 ...#ALT AMXMSKPR=21?^22?   [MAX ALLOWED
6C5L ...    SETRPMEN
6CK= ...#EXI
6D4W ...)   
6DJG ...#STR %A,FULL
6F46 ...#SKI
6FHQ ...(   
6G3B ...[%A = FULL  
6GH2 ...#STR %B 
6H2L ...(   
6HG= ...    SETRPERR            [ERROR IF ANY OTHER PARAMS  
6H^W ...#EXI
6JFG ...)   
6J^6 ...#ALT AMXMSKPR=+FULLBITS&21?^22? 
6KDQ ...    SETRPMEN
6KYB ...#EXI
6LD2 ...)   
6LXL ...#STR AB,%A  
6MC= ...#SKI
6MWW ...(   
6NBG ...[%A = AB
6NW6 ...#STR %B 
6P*Q ...#SKI
6PTB ...(   
6Q*2 ...    SETRPERR            [ERROR IF NO OTHER PARAMS   
6QSL ...#EXI
6R#= ...)   
6RRW ...[SET 20?=MASK OF EXCEPTED CATEGORIES
6S?G ...    SETRPMSK %B,%C,%D,%E,%F,%G,%H,%I,%J,%K,%L,%M,%N,%O,%P,%Q
6SR6 ...#ALT AMXMSKPR=+ALLBITS$20?&21?^22?  
6T=Q ...    SETRPMEN
6TQB ...#EXI
6W=2 ...)   
6WPL ...#STR ALLBUT,%A  
6X9= ...#SKI
6XNW ...(   
6Y8G ...[%A = ALLBUT
6YN6 ...#STR %B 
6^7Q ...#SKI
6^MB ...(   
7272 ...    SETRPERR            [ERROR IF NO OTHER PARAMS   
72LL ...#EXI
736= ...)   
73KW ...[SET 20?=MASK OF EXCEPTED CATEGORIES
745G ...    SETRPMSK %B,%C,%D,%E,%F,%G,%H,%I,%J,%K,%L,%M,%N,%O,%P,%Q
74K6 ...#ALT AMXMSKPR=+ALLBITS$20?&21?^22?  
754Q ...    SETRPMEN
75JB ...#EXI
7642 ...)   
76HL ...#STR FB,%A  
773= ...#SKI
77GW ...(   
782G ...[%A = FB
78G6 ...#STR %B 
78^Q ...#SKI
79FB ...(   
79^2 ...    SETRPERR            [ERROR IF NO OTHER PARAMS   
7=DL ...#EXI
7=Y= ...)   
7?CW ...[SET MASK OF EXCEPTED CATEGORIES
7?XG ...    SETRPMSK %B,%C,%D,%E,%F,%G,%H,%I,%J,%K,%L,%M,%N,%O,%P,%Q
7#C6 ...#ALT AMXMSKPR=+FULLBITS$20?&21?^22? 
7#WQ ...    SETRPMEN
7*BB ...#EXI
7*W2 ...)   
7B*L ...#STR FULLBUT,%A 
7BT= ...#SKI
7C#W ...(   
7CSG ...[%A = FULLBUT   
7D#6 ...#STR %B 
7DRQ ...#SKI
7F?B ...(   
7FR2 ...    SETRPERR            [ERROR IF NO OTHER PARAMS   
7G=L ...#EXI
7GQ= ...)   
7H9W ...[SET MASK OF EXCEPTED CATEGORIES
7HPG ...    SETRPMSK %B,%C,%D,%E,%F,%G,%H,%I,%J,%K,%L,%M,%N,%O,%P,%Q
7J96 ...#ALT AMXMSKPR=+FULLBITS$20?&21?^22? 
7JNQ ...    SETRPMEN
7K8B ...#EXI
7KN2 ...)   
7L7L ...[REMAINING CASE IS ONE OR MORE MON FILE CATEGORIES  
7LM= ...    SETRPMSK %A,%B,%C,%D,%E,%F,%G,%H,%I,%J,%K,%L,%M,%N,%O,%P,   
7M6W ...#ALT AMXMSKPR=20?&21?^22?   
7MLG ...    SETRPMEN
7N66 ...#EXI
7NKQ ...#NOR
^^^^ ...13175441000900000000
</code>