{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: MACROS GEM)}}
====== MACROS GEM ======
(George Source)
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?]�
4S#L ... +M1
4SS= ...#END
4T?W ...#MEN WSPARAM
4TRG ...#TRA K50WSPARAM
4W?6 ...#DEF M2=34?+0?]�
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