MACROS GEM
(George Source)
- 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?]� 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