{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: PERCON867)}} ====== PERCON867 ====== (George Source) **Macros used:** [[george:macro:ALTLEND|ALTLEND]], [[george:macro:AND|AND]], [[george:macro:BXE|BXE]], [[george:macro:BXGE|BXGE]], [[george:macro:BXL|BXL]], [[george:macro:BXU|BXU]], [[george:macro:CHNUMCO1|CHNUMCO1]], [[george:macro:CHNUMCOD|CHNUMCOD]], [[george:macro:ERRORX|ERRORX]], [[george:macro:FI|FI]], [[george:macro:HUNT|HUNT]], [[george:macro:IF|IF]], [[george:macro:JANAL|JANAL]], [[george:macro:JBC|JBC]], [[george:macro:LOCK|LOCK]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREE|MFREE]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MONOUT|MONOUT]], [[george:macro:NAME|NAME]], [[george:macro:OUTNUM|OUTNUM]], [[george:macro:PARABEG|PARABEG]], [[george:macro:PARAFREE|PARAFREE]], [[george:macro:PARALYSE|PARALYSE]], [[george:macro:PARANOTX|PARANOTX]], [[george:macro:PARANUMB|PARANUMB]], [[george:macro:PARAPASS|PARAPASS]], [[george:macro:QLOGIC|QLOGIC]], [[george:macro:QTABENT|QTABENT]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETREP|SETREP]], [[george:macro:TESTREP|TESTREP]], [[george:macro:TESTREP2|TESTREP2]], [[george:macro:THEN|THEN]], [[george:macro:TRACE|TRACE]], [[george:macro:UNLOCK|UNLOCK]], [[george:macro:UP|UP]] 2278 ... SEG PERCON,867,SECTION CENT,,G505 22#B ...[ 22FJ ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982 22LQ ...[ THIS EXCLUDES CODE UNDER #SKI G505 22RY ...[ 22^= #OPT K0PERCON=0 23DW #LIS K0PERCON>K0ALLGEO>K0GREATGEO>K0UTILITY 23YG #DEF TRACE=K6PERCON 24D6 [ 24XQ [ THIS SEGMENT SERVICES THE PERCON,PERCONA AND QUALCON MACROS 25CB [ 25JJ ...#OPT G505 = 0 25PQ ...#SKI G505&1 25WY ...# WITH UGUG EDIT M505 (3-SHIFT WORKING FOR MOP ONLINE PROGRAMS) 2646 ...[ 269# ...[ 26BL [ 26W= [ ENTRY POINTS 27*W SEGENTRY K1PERCON,ZEP1 [ENTRY FROM PERCON MACRO 27TG SEGENTRY K2PERCON,ZEP2 [ENTRY FROM QUALCON MACRO 28*6 SEGENTRY K3PERCON,ZEP3 [ENTRY FROM PERCONA MACRO 28SQ [ 29#B THIRTEEN +13 29J8 TWELVE +12 29S2 TEN +10 2=?L THREE +3 2=HD TWO56 +256 2=R= SIXFOUR +64 2?=W TYPBAD #4000 2?QG X4 +4 2#=6 X161 +161 2#PQ # 2*9B # ERROR MESSAGES 2*P2 QERM +ILLQUAL [%C CONTAINS ILLEGAL QUALIFIER 2B8L UERM +ERRPERC [%C IS NOT A CORRECT PERIPHERAL NAME 2BDD TERM +JMAXPAR [>24 PARAMS WITHIN BRACKETS 2BN= XERM +ERUNPAIR [%C CONTAINS AN UNPAIRED DELIMETER 2C7W ZERM +INCOMQU [%C CONTAINS INCOMPATIBLE QUALIFIERS 2CMG # 2D76 # IDENTIFIERS IN THE QTABENT MACRO ENTRIES 2DLQ #DEF WFLAG=0 2F6B #DEF WQUAL=WFLAG+1 2FL2 #DEF WPER2=WQUAL+2 2G5L #DEF WPER3=WPER2+1 2GK= #DEF WPER4=WPER3+1 2H4W #DEF WENTR=WPER4+1 [SIZE OF ENTRY 2HJG [LIST OF ACCEPTABLE PERIPHERAL MNEMONICS AND CORRESPONDING NUMERICAL 2J46 [CODES 2JHQ [ 2K3B TYPES #00006462 [TYPE 0 TR TAPE READER 2KH2 #01006460 [TYPE 1 TP TAPE PUNCH 2L2L #02005460 [TYPE 2 LP LINE PRINTER 2LG= #03004362 [TYPE 3 CR CARD READER 2L^W #04004360 [TYPE 4 CP CARD PUNCH 2MFG #05005564 [TYPE 5 MT MAGNETIC TAPE 2M^6 #06004544 [TYPE 6 ED EXCHANGEABLE DISC STORE 2NDQ #06004441 [TYPE 6 ALSO DA UNDER UDAS 2NYB #07005543 [TYPE 7 MC MAG CARD FILE 2PD2 #10004444 [TYPE 8 DD DATA DISC STORE 2PXL #11004462 [TYPE 9 DR MAGNETIC DRUM 2QC= #12005164 [TYPE 10 IT UNIPLEXOR 2QWW #12006570 [TYPE 10 UNIPLEXOR 2RBG #12006556 [TYPE 10 UNIPLEXOR 2RW6 #13005570 [TYPE 11 MX MULTIPLEXOR 2S*Q #14004364 [TYPE12 CT CASSETTE TAPE 2STB #06004644 [TYPE 6 (PRE-UDAS13) FD FIXED DISC 2T*2 #SKIP APER14 2TSL #HAL #1601,+APER14 2W#= #SKIP APER15 2WRW #HAL #1701,+APER15 2X?G #SKIP APER16 2XR6 #HAL #2001,+APER16 2Y=Q #SKIP APER17 2YQB #HAL #2101,+APER17 2^=2 #SKIP APER18 2^PL #HAL #2201,+APER18 329= #SKIP APER19 32NW #HAL #2301,+APER19 338G #SKIP APER20 33N6 #HAL #2401,+APER20 347Q #SKIP APER21 34MB #HAL #2501,+APER21 3572 #SKIP APER22 35LL #HAL #2601,+APER22 366= #SKIP APER23 36KW #HAL #2701,+APER23 375G #SKIP APER24 37K6 #HAL #3001,+APER24 384Q #SKIP APER25 38JB #HAL #3101,+APER25 3942 #SKIP APER26 39HL #HAL #3201,+APER26 3=3= #SKIP APER27 3=GW #HAL #3301,+APER27 3?2G #SKIP APER28 3?G6 #HAL #3401,+APER28 3?^Q #SKIP APER29 3#FB #HAL #3501,+APER29 3#^2 #SKIP APER30 3*DL #HAL #3601,+APER30 3*Y= #SKIP APER31 3BCW #HAL #3701,+APER31 3BXG #SKIP APER32 3CC6 #HAL #4001,+APER32 3CWQ #SKIP APER33 3DBB #HAL #4101,+APER33 3DW2 #SKIP APER34 3F*L #HAL #4201,+APER34 3FT= #SKIP APER35 3G#W #HAL #4301,+APER35 3GSG #SKIP APER36 3H#6 #HAL #4401,+APER36 3HRQ #SKIP APER37 3J?B #HAL #4501,+APER37 3JR2 #SKIP APER38 3K=L #HAL #4601,+APER38 3KQ= #SKIP APER39 3L9W #HAL #4701,+APER39 3LPG #SKIP APER40 3M96 #HAL #5001,+APER40 3MNQ #SKIP APER41 3N8B #HAL #5101,+APER41 3NN2 #SKIP APER42 3P7L #HAL #5201,+APER42 3PM= #SKIP APER43 3Q6W #HAL #5301,+APER43 3QLG #SKIP APER44 3R66 #HAL #5401,+APER44 3RKQ #SKIP APER45 3S5B #HAL #5501,+APER45 3SK2 #SKIP APER46 3T4L #HAL #5601,+APER46 3TJ= #SKIP APER47 3W3W #HAL #5701,+APER47 3WHG #SKIP APER48 3X36 #HAL #6001,+APER48 3XGQ #SKIP APER49 3Y2B #HAL #6101,+APER49 3YG2 #SKIP APER50 3Y^L #HAL #6201,+APER50 3^F= #SKIP APER51 3^YW #HAL #6301,+APER51 42DG #SKIP APER52 42Y6 #HAL #6401,+APER52 43CQ #SKIP APER53 43XB #HAL #6501,+APER53 44C2 #SKIP APER54 44WL #HAL #6601,+APER54 45B= #SKIP APER55 45TW #HAL #6701,+APER55 46*G #SKIP APER56 46T6 #HAL #7001,+APER56 47#Q #SKIP APER57 47SB #HAL #7101,+APER57 48#2 #SKIP APER58 48RL #HAL #7201,+APER58 49?= #SKIP APER59 49QW #HAL #7301,+APER59 4==G #SKIP APER60 4=Q6 #HAL #7401,+APER60 4?9Q #SKIP APER61 4?PB #HAL #7501,+APER61 4#92 #SKIP APER62 4#NL #HAL #7601,+APER62 4*8= #SKIP APER63 4*MW #HAL #7701,+APER63 4B7G #REP 5 4BM6 +0 [END OF TABLE MARKER 4C6Q [ 4CLB [LIST OF QUALIFIER TABLES . EACH TYPE HAS A HALF WORD ENTRY IN THE 4D62 [FOLLOWING FORMAT : #4000 IF TYPE IS ILLEGAL (EG *HD TYPE 25) 4DKL [ ELSE ADDRESS OF HEAD OF QUALIFIER TABLE 4F5= [ 0 IF TYPE CAN HAVE NO QUALIFIERS 4FJW [ 4G4G TYPLIST 4GJ6 #HAL +TYP0,+TYP1 [TR TP 4H3Q #HAL +TYP2,+TYP3 [LP CR 4HHB #HAL +TYP4,+TYP5 [CP MT 4J32 #HAL +TYP6,+0 [DA 7 4JGL #HAL +0,+TYP9 [8 DR 4K2= #HAL +0,+0 [10 MX 4KFW #HAL +0,#4000 [12 13 (*13 -> *06 BEFORE HERE 4K^G #HAL +0,+0 [14 15 4LF6 #HAL +0,+0 [16 17 4LYQ #HAL +0,+0 [18 19 4MDB #HAL +0,+0 [20 21 4MY2 #HAL +0,+0 [22 23 4NCL #HAL TYP24,#4000 [CC HD 4NX= #HAL #4000,+0 [26 (EDS30) 27 4PBW #HAL +TYP28,+0 [PB 29 4PWG #HAL +0,+0 [30 31 4QB6 #HAL +0,+0 [32 33 4QTQ #HAL +0,+0 [34 35 4R*B #HAL +0,+0 [36 37 4RT2 #HAL +0,+0 [38 39 4S#L #HAL +0,+0 [40 41 4SS= #HAL +0,+0 [42 43 4T?W #HAL +0,+0 [44 45 4TRG #HAL +0,+0 [46 47 4W?6 #HAL +0,+0 [48 49 4WQQ #HAL +TYP50,+TYP51 [FR FW 4X2J #SKI JSKI19<1$1 4X=B #HAL +0,+0 [52 53 4XCJ #SKI JSKI19 4XJQ #HAL +TYP52,+0 [52 53 4XQ2 #HAL +0,+0 [54 55 4Y9L #HAL +0,+0 [56 57 4YP= #HAL +0,+0 [58 59 4^8W #HAL +TYP60,+0 [CI 61 4^NG #HAL +0,+0 [62 63 5286 [ 52MQ [THERE NOW FOLLOWS THE QUALIFIER TABLES ACCESSED THROUGH TYPLIST.EACH 537B [HAS HEADER,ENTRY LIST,TAIL. 53M2 [HEADER IS POINTER TO APPROPRIATE LOGIC TABLE 546L [EACH ENTRY IS EITHER A QTABENT MACRO ENTRY (QV) OR,IF B0 OF WORD 0 54L= [ IS SET,B12-23 POINT TO NEXT ENTRY 555W [TAIL IS A ZERO WORD 55KG [ 5656 [EACH QUALIFIER HAS A LEVEL NUMBER (LN). NO 2 QUALS WITH SAME LN CAN 56JQ [OCCUR TOGETHER. P IS'TRUE'IF QUALIFIER IS PRESENT,ELSE'FALSE';THE 574B [CONJUNCTION OF THE PARAMETERS OF THE APPROPRIATE QLOGIC MACRO IS'TRUE' 57J2 [IF THE CORRESPONDING QUALIFIER COMBINATION IS ILLEGAL 583L [ 58H= TYP2 +TYP2L 592W QTABENT 4,AUTO,1,0,0,0,XTAUTO 59=N QTABENT 8,EXTENDED,1,#00040000,0,0 59*K ...#SKI G505&1 59DG ... +TYP3+1.2 59HC ...#SKI G505&1$1 59LC +TYP1+1.2 [-> OTHER SLOW PERIPHERALS 5=26 [ 5=9Y TYP0 +TYP0L 5=FQ QTABENT 6,NLNULL,1,#00020000,0,0 5=J* ...#SKI G505&1 5=LY ... QTABENT 6,CURSOR,1,0,0,#20060000 5=PJ +TYP1+1.2 5=^B TYP1 5?3# ...#SKI G505&1 5?5= ...( 5?78 ... +TYP0L 5?96 ... QTABENT 6,NORMAL,1,0,0,#00040000 5??4 ... QTABENT 7,ALLCHAR,1,0,0,#00060000 5?*2 ... +TYP3+1.2 5?BY ...) 5?F2 TYP3 5?YL TYP4 5#4H TYP50 5#8D TYP51 5##* TYP52 5#D= +TYP0L 5#XW QTABENT 8,IDENTIFY,0,0,0,0.2 5*CG +TYPCOMMON+1.2 [-> COMMON QUALIFIERS 5*X6 [ 5BBQ TYP5 +TYP5L 5BWB QTABENT 4,MODE,1,0,#74,0,XTMODE 5CB2 T5AND28 5CTL QTABENT 4,READ,0,0,1,0 5D*= QTABENT 5,WRITE,0,1,1,0 5DSW +TYPCOMMON+1.2 [-> COMMON QUALIFIERS 5F#G TYP6 5FS6 TYP13 5G?Q +TYP6L 5GRB QTABENT 4,READ,0,#200,0,0 5H?2 QTABENT 5,WRITE,0,#300,0,0 5HQL QTABENT 7,OVERLAY,0,#100,0,0 5J== QTABENT 6,OFFSET,0,#400,0,0 5JPW QTABENT 7,SCRATCH,0,#600,0,0 5K9G +TYPCOMMON+1.2 [-> COMMON QUALIFIERS 5KP6 TYP28 5L8Q +TYP28L 5LNB QTABENT 3,IMC,1,0,2,0 5M82 QTABENT 3,WMC,1,2,2,0 5MML QTABENT 5,DELAY,2,0,0,0,XTDELAY 5N7= +T5AND28.2 [-> READ & WRITE - SAME AS *MT 5NLW [ NOW THE COMMON QUALIFIERS. THE NUMBER OF COMMON QUALIFIER LEVELS IS 5P6G [ THE VALUE OF GCOMQU , DEFINED IN COMPS PERCON 5PL6 TYPCOMMON 5Q5Q TYP9 5QKB TYP11 5R52 TYP24 5SHW TYP60 5T3G +TYPCOMMONL 5TH6 #SKI ARETLO 5W2Q QTABENT 4,KEEP,-1,0,0,0.1 5WGB +0 [END OF TABLES - (IE ROOT OF TREE) 5X22 [ 5XFL [ NOW THE LOGIC TABLES - IN FACT THEY ARE ALL DEGENERATE , SO WE MAP 5X^= [ THEM ALL INTO A SINGLE QLOGIC ENTRY 5YDW TYP0L 5YYG TYP2L 5^D6 TYP5L 5^XQ TYP6L 62CB TYP28L 62X2 TYPCOMMONL 63BL QLOGIC -GCOMQU,2 63W= [ 64*W [ NOW THE ACTUAL CODE 64TG [ AWORK1,2 ARE USED AS FOLLOWS 65*6 [ AWORK1 B0-5 CP LEVEL OF MULTI BLOCK HOLDING QUALIFIERS 65SQ [ B12 SET IF NO UNIT NUMBER SPECIFIED 66#B [ B13 SET IF ENTERED FROM PERCON 66S2 [ B14 SET IF ENTERED FROM QUALCON 67?L [ B15 SET IF UNI CNTG PERL NAME+ QUALS SET UP 67R= [ B16 SET IF CPAR/GPERCON BLOCK SET UP 68=W [ AWORK2 B0-11 ADDRESS OF QLOGIC ENTRY FOR THIS TYPE 68QG [ B12-23 ADDRESS OF CURRENT QTABENT ENTRY 69=6 [ 69PQ ZEP1 [ENTRY FROM PERCON MACRO 6=9B LDN 0 #2000 6=P2 STO 0 AWORK1(2) [CLEAR FLAGS - B13=1 FOR PERCON ENTRY 6?8L LDX 4 ACOMMUNE7(2) 6?N= BZE 4 UXIST [J IF UNI BLOCK PASSED TO MACRO 6#7W PARANOTX 4 [ ELSE SET UP ONE FOR ERROR MESSAGES 6#MG LDN 0 #400 6*76 ORS 0 AWORK1(2) [ AND SET FLAG TO REMEMBER IT 6*LQ UXIST HUNT 3,CPB,CUNI 6B6B BNG 3 (GEOERR) [GEORGE ERROR IF NOT FOUND 6BL2 NGX 0 ANUM(3) 6C5L BPZ 0 UERR [ERROR IF ITS NULL OR ABSENT 6CK= LDX 4 ATYPE(3) 6D4W ANDN 4 #7777 [GET PARAMETER NUMBER 6DJG SET LDN 5 0 [SET ANALYSIS LEVEL 6F46 PARALYSE ,5,4 [SPLIT INTO AND 6F9# #UNS ANSTOOMANY 6FBG #SKI 6FHQ TESTREP UNPAIR,XERR [J IF ANALYSIS ERROR 6FNY #UNS ANSTOOMANY 6FW6 TESTREP2 UNPAIR,XERR,TOOMANY,TERR [J IF ANALYSIS ERROR 6G3B PARANUMB 4 6GH2 BXGE 4 THREE(1),UERR 6H2L BZE 4 UERR [J IF NOT 1 OR 2 PARAMETERS PRODUCED 6HG= PARAPASS [GET 6H^W BRN START 6JFG [ 6J^6 ZEP3 [ENTRY FROM PERCONA MACRO 6KDQ STOZ AWORK1(2) [CLEAR FLAGS - B13=0 FOR PERCONA ENTR 6KYB START MHUNT 3,CPB,CUNI [LOCATE PARAMETER 6LD2 LDX 6 ANUM(3) 6LXL BNG 6 UERR1 [J IF NON-EXISTENT 6MC= BZE 6 UERR1 [ OR NULL 6MWW ANDN 6 #7777 6NBG ADN 3 APARA 6NW6 LDCH 0 0(3) 6P*Q SBN 0 #32 6PTB BNZ 0 UERR2 [J IF FIRST CHARACTER NOT * 6Q*2 CALL 0 ZCHAR [ADVANCE TO NEXT CHARACTER 6QSL BRN UERR2 [ AND J IF THERE IS NONE 6R#= CALL 7 ZNUM [TRY TO CONVERT NEXT TWO 'NUMBERS' 6RRW BZE 7 NUM [J IF TWO NUMBERS CONVERTED OK 6S?G SBN 7 1 6SR6 BZE 7 UERR2 [J IF JUST ONE NUMBER CONVERTED-ERROR 6T=Q CALL 7 ZMNEM [ ELSE TRY TO MATCH UP MNEMONIC 6TQB BRN UERR2 [J IF MNEMONIC NOT RECOGNISED 6W=2 NUM BXGE 5 SIXFOUR(1),UERR2 [J IF CONVERTED TYPE NOT < 64 6WPL BXU 5 THIRTEEN(1),NFD [REPLACE TYPE 13 BY TYPE 6 6X9= LDN 5 6 6XNW NFD SRC 5 9 6Y8G STO 5 AWORK2(2) [TYPE TO B0-8 6Y9# SEGENTRY K90PERCON [ENTRY FOR MANYDA RESTORE MACRO 6Y=6 BRN XK91 6Y=Y SLC 5 9 6Y?Q SBN 5 6 6Y#J BNZ 5 XK91 [J IF NOT DA 6Y*B BZE 6 NOUNNO [J IF NO UNIT NO 6YB8 LDN 7 3 [CHAR CT FOR UNIT NO 6YC2 LDN 4 0 6YCS LDN 5 0 6YDL ZUNUM CDB 4 0(3) 6YFD BCS ZUNUM1 6YG= CALL 0 ZCHAR [GET PTR TO NEXT CHAR 6YH4 BRN ZUNUM1 [J IF END 6YHW BCT 7 ZUNUM 6YJN ZUNUM1 6YKG BXGE 5 TWO56(1),UERR2 [J IF TOO BIG 6YL# BRN UNITN 6YLP XK91 6YM6 SEGENTRY K91PERCON 6YN6 CALL 7 ZNUM [TRY TO CONVERT NEXT NUMBER(S) 6^7Q BXGE 5 SIXFOUR(1),UERR2 [J IF CONVERTED UNIT NO NOT < 64 6^MB SBN 7 2 7272 BNZ 7 UNITN [J IF UNIT NO WAS ACTUALLY SPECIFIED 72BS NOUNNO 72LL LDN 0 #4000 736= ORS 0 AWORK1(2) [ ELSE SET 'NO UNIT NO' SWITCH 73KW UNITN ORS 5 AWORK2(2) [AWORK2:B0-8 TYPE B9-23 UNIT NO 745G LDX 0 AWORK1(2) 74K6 ANDN 0 #2000 754Q BNZ 0 NOTA [J IF NOT PERCONA 75JB [ 7642 [ALTHOUGH IT IS ERRONEOUS FOR QUALIFIERS TO OCCUR WITH PERCONA WE CHECK 76HL [THAT THE TYPE IS NOT SUCH THAT A QUALIFIER IS MANDATORY (CURRENTLY 773= [THERE ARE NO SUCH TYPES) 77GW [ 782G BZE 6 NIQ [J IF NO MORE CHARACTERS LEFT 78G6 LDCH 0 0(3) [ ELSE ERROR . 'ILLEGAL QUALIFIER' 78^Q SBN 0 #30 [ IF FIRST CHAR '(' ELSE 'INCORRECT 79FB BZE 0 QERR [ PERIPHERAL NAME 79^2 BRN UERR 7=DL NIQ LDX 5 AWORK2(2) [X5=PERIPHERAL TYPE NUMBER 7=Y= SLC 5 9 7?CW ANDN 5 #77 7?XG CALL 7 QTAB 7#C6 BRN UERR [ERROR IF ILLEGAL TYPE 7#WQ BZE 3 NOQU [J IF CANNOT HAVE QUALIFIERS 7*BB SMO FX1 7*W2 LDX 6 0(3) [ ELSE GET QUALIFIER LOGIC ADDRESS 7B*L LDN 3 0 [INDICATE NO QUALIFIERS 7BT= CALL 7 ZLOGIC [CHECK THIS IS OK WITH LOGIC 7C#W BRN ZERR1 7CSG NOQU LDX 0 AWORK1(2) 7D#6 ANDN 0 #4000 7DRQ SLL 0 12 7F?B STO 0 ACOMMUNE2(2) [SET B0 IF'NO UNIT NUMBER' SWITCH SET 7FR2 LDX 0 AWORK2(2) 7G=L STO 0 ACOMMUNE1(2) [SET RESULT 7GQ= SETREP OK 7H9W #SKI TRACE>999-999 7HPG ( 7J96 OUTNUM ACOMMUNE1(2),OCTAL 7JNQ OUTNUM ACOMMUNE2(2),OCTAL 7K8B MONOUT IPLISTING 7KN2 ) 7L7L UP [RETURN 7LM= NOTA 7LSD [ 7L^L [ NOT PERCONA 7M6W BNZ 6 UERR2 [INVALID NAME IF ANY EXTRA CHARS 7MLG HUNT 3,CPB,CUNI [RENAME PARAMETER BLOCK 7N66 NAME 3,CPAR,GPERCON 7NKQ ALTLEND 3,4 7P5B LDN 0 #200 7PK2 ORS 0 AWORK1(2) [REMEMBER CPAR/GPERCON BLOCK SET UP 7Q4L HUNT 3,CPAR,GPERCON 7QJ= LDX 5 AWORK2(2) 7R3W STO 5 GPER1(3) [SET PERIPHERAL NAME 7RHG SRL 5 15 [TYPE -> B15-23 7S36 STOZ GPER2(3) [INITIALISE QUALIFIER WORDS 7SGQ STOZ GPER3(3) 7T2B STOZ GPER4(3) 7TG2 LDN 6 1 7T^L LDN 7 2 7WF= PARALYSE #34,6,7 7WLD #UNS ANSTOOMANY 7WRL #SKI 7WYW TESTREP UNPAIR,XERR [J IF ERROR IN SPLITTING 7X64 #UNS ANSTOOMANY 7X?= TESTREP2 UNPAIR,XERR,TOOMANY,TERR [J IF ERROR IN SPLITTING 7XDG DCH 7 AWORK1(2) [STORE ANALYSIS LEVEL 7XY6 BRN PBEF 7YCQ ZEP2 [ENTRY FROM QUALCON MACRO 7YXB LDX 5 ACOMMUNE7(2) 7^C2 LDX 0 ACOMMUNE8(2) 7^WL SLL 0 18 82B= ORN 0 #1200 82TW STO 0 AWORK1(2) [DUMP ANALYSIS LEVEL & CLEAR FLAGS, 83*G [ SETTING B14 FOR QUALCON ENTRY 83T6 [ & B16 FOR GPERCON BLOCK SET UP 84#Q SETNCORE 4,3,CPAR,GPERCON 84SB STOZ GPER1(3) [INITIALISE QUALIFIER WORDS 85#2 STOZ GPER2(3) 85RL STOZ GPER3(3) 86?= STOZ GPER4(3) 86QW PBEF LDCH 7 AWORK1(2) 87=G PARANUMB 6,7 87Q6 BNG 6 (GEOERR) [GEORGE ERROR IF NO MULTI BLOCK 889Q BZE 6 NOQUA [J IF NO QUALIFIERS 88PB CALL 7 QTAB [CHECK TYPE LEGALITY,FIND QUAL TABLE 8992 BRN ZERR 89NL BZE 3 QERR [ERROR IF TYPE HAS NO QUALIFIERS 8=8= SMO FX1 8=MW LDX 0 0(3) [GET RELATIVE ADDRESS OF LOGIC ENTRY 8?7G SLL 0 12 8?M6 STO 0 AWORK2(2) [ & REMEMBER IT 8#6Q ADN 3 1(1) [STEP X3 TO POINT TO FIRST QUAL ENTRY 8#LB NXQU LDXC 4 WFLAG(3) [GET NEXT ENTRY 8*62 BCC NOTR [J IF ITS NOT A REPLACER 8*KL LDX 3 4 [ ELSE J TO REPLACED ADDRESS 8B5= ADX 3 FX1 8BJW BRN NXQU 8BSN [ 8C4G NOTR BZE 4 QERR [ERROR IF END OF TABLE 8CJ6 #SKI TRACE>599-599 8D3Q TRACE WQUAL(3),TESTQUAL 8DHB LDX 5 4 8F32 ANDN 5 #17 [NUMBER OF CHARACTERS IN STRING 8FGL LDCH 7 AWORK1(2) [GET ANALYSIS LEVEL 8G2= LDX 0 3 8GFW SBX 0 FX1 8G^G DSA 0 AWORK2(2) [REMEMBER RELATIVISED ENTRY ADDRESS 8HF6 PARABEG 1,5,WQUAL(3),7 8HYQ HUNT 3,CPB,CUNI 8JDB LDX 5 ANUM(3) 8JY2 BPZ 5 XMFND [J IF MATCH FOUND 8KCL LDX 3 AWORK2(2) [ELSE RESET X3 ->CURRENT ENTRY & J 8KX= ANDN 3 #7777 8LBW ADX 3 FX1 8LWG BRN XSTEP 8M6# [ 8MB6 XMFND LDX 0 4 8MTQ SRL 0 12 8N*B ANDN 0 #1777 8NT2 BZE 0 NOFAG [J IF NO FAG END ANALYSIS 8P#L ADX 0 FX1 8PS= CALL 7 (0) [CALL FAG END ANALYSIS SUBROUTINE 8Q?W BRN QUOK 8QRG NOFAG BNZ 5 QERR1 [ERROR IF FAG END BUT NO ANALYSIS S/R 8R?6 QUOK LDX 3 AWORK2(2) 8RQQ ANDN 3 #7777 8S=B ADX 3 FX1 [FETCH & DATUMISE ENTRY POINTER 8SQ2 MHUNT 2,CPAR,GPERCON 8T9L LDX 0 WPER4(3) 8TP= ANDX 0 GPER4(2) 8W8W ANDN 0 #7777 8WNG BNZ 0 ZERR1 [J IF CURRENT QUAL LEV ALREADY FOUND 8X86 LDX 0 WPER2(3) ['OR' IN THE CODE WORDS 8XMQ ORS 0 GPER2(2) 8Y7B LDX 0 WPER3(3) 8YM2 ORS 0 GPER3(2) 8^6L LDX 0 WPER4(3) 8^L= ORS 0 GPER4(2) 8^M5 ...[ 8^MY ...[ 8^NR ...#SKI G505&1 8^PL ...( 8^QF ...[ MEND EXCHANGE SCHEME CODE 8^R# ... LDXC 0 0 8^S7 ... ANDX 0 HALFTOP 8^T2 ... IF 0,NZ 8^TT ... LDCT 0 #076 8^WN ... ANDX 0 GPER1(2) 8^XH ... AND 0,ZE [ *TR OR *TP 8^YB ... THEN [ SHIFT QUALS ON *TR/*TP 8^^9 ... JBC QERR1,FX2,CXTMOP [ - MUST BE MOP ONLINE 9224 ... FI 922X ...) 923Q ...[ 924K ...[ 925W LDX 2 FX2 92KG SBN 6 1 [DECREMENT COUNT OF QUALIFIERS TO CHK 9356 XSTEP MFREE CPB,CUNI 93JQ ADN 3 WENTR 944B BNZ 6 NXQU [J IF MORE QUALIFIERS TO CHECK 94J2 LDX 6 AWORK2(2) 953L SRL 6 12 [GET LOGIC TABLE ADDRESS 95H= XEND2 MHUNT 3,CPAR,GPERCON 962W LDX 3 GPER4(3) 96GG ANDN 3 #7777 [POINTS TO TRUTH TABLE ENTRY REQUIRED 9726 CALL 7 ZLOGIC [CHECK COMPATIBILITY OF QUALIFIERS 97FQ BRN ZERR 97^B XEND1 SETREP OK 98F2 XFIN LDX 0 AWORK1(2) 98YL ANDN 0 #2000 99D= BZE 0 NOTPC [J IF ENTRY NOT BY PERCON MACRO 99XW PARAFREE [ ELSE FREE MULTI BLOCKS 9=CG LDX 0 AWORK1(2) 9=X6 ANDN 0 #400 9?BQ BZE 0 NOTPC [J IF WE DIDNT SET UP CUNI AT START 9?WB MFREE CPB,CUNI [ ELSE FREE IT 9#B2 NOTPC 9#TL #SKI TRACE>999-999 9**= ( 9*SW MHUNT 3,CPAR,GPERCON 9B#G BNG 3 ZZ2 9BS6 LOCK 3 9C?Q LDN 7 4 9CRB ZZ1 OUTNUM GPER1(3),OCTAL 9D?2 ADN 3 1 9DQL BCT 7 ZZ1 9F== MONOUT IPLISTING 9FPW SBN 3 4 9G9G UNLOCK 3 9GP6 ZZ2 9H8Q ) 9HNB UP 9J82 [ 9JML [ENTER HERE IF NO QUALIFIERS GIVEN,WITH TYPE NUMBER IN X5 9K7= [ 9KLW NOQUA CALL 7 QTAB 9L6G BRN UERR 9LL6 LDX 2 FX2 9M5Q BZE 3 XEND1 [J IF TYPE CANNOT HAVE QUALIFIERS 9MKB SMO FX1 9N52 LDX 6 0(3) [ OTHERWISE CHECK FOR MANDATORY QUAL 9NJL BRN XEND2 9P4= [ 9PHW [ WE NOW HAVE THE VARIOUS ERROR EXITS. 9Q3G [ LABELS WITH SUFFIX 1:QUALCON=>NO MESS;ELSE FREE FIRST UNI (UNLESS 9QH6 [ PERCONA) BEFORE ISSUING ERROR MESSAGE 9R2Q [ 9RGB XERR1 LDN 3 XERM 9S22 BRN XCOMA 9SFL UERR1 LDN 3 UERM 9S^= BRN XCOMA 9TDW QERR1 LDN 3 QERM 9TYG BRN XCOMA 9WD6 ZERR1 LDN 3 ZERM 9WXQ XCOMA LDX 0 AWORK1(2) 9XCB ANDN 0 #2000 9XX2 BZE 0 XCOMB [J IF ENTERED IN PERCONA 9YBL MFREE CPB,CUNI [ ELSE FREE FIRST CUNI BLOCK 9YW= BRN ZEND1 9^*W [ 9^TG [ LABELS WITH SUFFIX 2 : QUALCON=> NO MESS; ELSE FREE FIRST UNI =2*6 [ (UNLESS PERCONA) AFTER ISSUING ERROR MESSAGE =2SQ [ =3#B UERR2 LDN 3 UERM =3S2 LDN 7 1 =4?L BRN ZEND =4R= [ =5=W [ LABELS WITHOUT SUFFIX 1 :QUALCON=> NO MESSAGE;ELSE ISSUE =5QG [ APPROPRIATE ERROR MESSAGE =6=6 [ =6PQ XERR LDN 3 XERM =79B BRN XCOMB =7P2 UERR LDN 3 UERM =88L BRN XCOMB =8N= QERR LDN 3 QERM =97W BRN XCOMB =9*4 TERR LDN 3 TERM =9G= BRN XCOMB =9MG ZERR LDN 3 ZERM ==76 XCOMB LDX 0 AWORK1(2) ==LQ ANDN 0 #1000 =?6B BNZ 0 ZEND2 [J IF ENTERED FROM QUALCON =?L2 ZEND1 LDN 7 0 =#5L ZEND SMO FX1 =#K= LDX 4 0(3) =#T4 ... JANAL ZEND2 =*4W ERRORX 4 =*JG ZEND2 BZE 7 QUAERR =B46 MFREE CPB,CUNI [IF SUBSCRIPT 2 ENTRY , FREE UNI BLK =BHQ QUAERR =C3B LDX 0 AWORK1(2) =CH2 ANDN 0 #200 =D2L BZE 0 QUA1 =DG= MFREE CPAR,GPERCON [FREE CPAR/GPERCON IF IT EXISTS =D^W QUA1 SETREP PARERR =FFG BRN XFIN =F^6 [ =GDQ [ THERE NOW FOLLOW VARIOUS SUBROUTINES =GYB [ =HD2 [ =HXL [ FINDS NEXT NON-SPACE CHARACTER.ENTER X3-> STRING, X6=COUNT REMAINING =JC= [ EXIT :FAILURE - NO NON SPACE CHAR FOUND EXIT TO CALL - X6=0 =JWW [ :SUCCESS - X3,X6 REFER TO THAT CHAR , EXIT TO CALL+1 =KBG [ LINK X0 , X0 DESTROYED , V PRESERVED =KW6 [ =L*Q ZCHAR =LTB STO 0 GEN0 =M*2 BZE 6 ZCHA2 =MSL ZCHA1 BCHX 3 £ =N#= BCT 6 ZCHA3 =NRW ZCHA2 LDX 0 GEN0 =P?G EXIT 0 0 =PR6 ZCHA3 LDCH 0 0(3) =Q=Q SBN 0 #20 =QQB BZE 0 ZCHA1 =R=2 LDX 0 GEN0 =RPL EXIT 0 1 =S9= [ =SNW [TRIES TO CONVERT A NUMBER OF UP TO 2 CHARS =T8G [ENTER:X3-> STRING,X6=COUNT,LINK X7 =TN6 [EXIT :X5=RESULT,X7=2-(NO OF CHARS CONVERTED),X3,X6 -> CHAR AFTER LAST =W7Q [ CONVERTED ,X0,X4 DESTROYED =WMB [ =X72 ZNUM STO 7 GEN1 [STORE LINK =XLL LDN 7 2 =Y6= LDN 4 0 =YKW LDN 5 0 =^5G BZE 6 ZNUM1 [J IF END OF STRING =^K6 ZNUM3 CDB 4 0(3) [CONVERT CHARACTER ?24Q BCS ZNUM1 ?2JB SBN 7 1 [DECREMENT CNT OF CHARS CONVERTED OK ?342 CALL 0 ZCHAR [STEP TO NEXT CHAR ?3HL BRN ZNUM1 [J IF END OF STRING ?43= BNZ 7 ZNUM3 [J IF < 2 CHARS CONVERTED ?4GW ZNUM1 BRN (GEN1) ?52G [ ?5G6 [TRIES TO RECOGNISE A TWO CHARACTER MNEMONIC ?5^Q [ENTER X3-> STRING,X6=COUNT,LINK X7 ?6FB [EXIT-FAIL (<2 CHARS OR NEXT 2 CHARS UNRECOGNISED) X0,4,7 DESTRD,X1=FX1 ?6^2 [ EXIT TO CALL ?7DL [ SUCCESS X3,X6 REFER TO NEXT CHAR,X5=TYPE NO ,X0,4,7 DESTRD,X1=FX1 ?7Y= [ EXIT TO CALL+1 ?8CW [ ?8XG ZMNEM ?9C6 LDCT 1 #400 ?9WQ LDN 4 0 ?=BB ZMN3 BZE 6 ZMN1 [J IF NO CHARS LEFT ?=W2 LDCH 0 0(3) ??*L DCH 0 4(1) [COPY NEXT CHARACTER TO X4 ??T= CALL 0 ZCHAR [ADVANCE X3 ?##W NULL [IGNORE IF NO MORE CHARS ?#SG BCHX 1 £ [ADVANCE X1 ?*#6 BVCI ZMN3 [J IF JUST ONE CHARACTER FOUND SO FAR ?*RQ LDN 1 TYPES-1 ?B?B ADX 1 FX1 ?BR2 ZMN4 ADN 1 1 ?C=L LDX 0 0(1) [GET NEXT ENTRY IN MNEMONIC TABLE ?CQ= BZE 0 ZMN1 [J IF END OF TABLE - MATCH NOT FOUND ?D9W ANDN 0 #7777 ?DPG BXU 0 4,ZMN4 [J BACK IF THIS ENTRY DOESNT MATCH ?F96 LDCH 5 0(1) [MATCH FOUND - GET TYPE NUMBER ?FNQ LDX 1 FX1 ?G8B EXIT 7 1 [SUCCESS EXIT ?GN2 ZMN1 LDX 1 FX1 ?H7L EXIT 7 0 [FAILURE EXIT ?HM= [ ?J6W [CHECKS LEGALITY OF A GIVEN TYPE ,AND GIVES QUALIFIER TABLE ENTRY ?JLG [ENTER : X5=TYPE , LINK X7 ?K66 [EXIT : IF TYPE ILLEGAL EXIT TO CALL, X0,X3 DESTROYED ?KKQ [ : OTHERWISE EXIT TO CALL+1,X3-> QUAL TABLE (0 IF NONE),X0 DESTRD ?L5B [ ?LK2 QTAB ?M4L SRC 5 1 ?MJ= SMO 5 ?N3W LDX 3 TYPLIST(1) [GET WORD CONTAINING HALF WORD ENTRY ?NHG BNG 5 QTAB1 ?P36 SRL 3 12 [GET CORRECT HALF OF WORD ?PGQ QTAB1 SLC 5 1 ?Q2B ANDN 3 #7777 [ERASE THE REST ?QG2 BXE 3 TYPBAD(1),(7) [EXIT TO CALL IF ILLEGAL ?Q^L EXIT 7 1 ?RF= [ ?RYW [THIS SUBROUTINE CHECKS FOR QUALIFIER LOGIC ERROR ?SDG [ENTER : X6-> LOGIC TABLE (REL TO FX1) X3=LOGIC NUMBER (TRUTH VECTOR) ?SY6 [EXIT : IF LOGIC ERROR EXIT TO CALL X0,3,4 DESTROYED ?TCQ [ OTHERWISE EXIT TO CALL+1 X0,3,4 DESTROYED ?TXB [ ?WC2 ZLOGIC ?WWL SRL 34 4 ?XB= ADX 3 FX1 ?XTW SMO 6 ?Y*G LDX 0 0(3) [GET RIGHT WORD IN LOGIC TABLE ?YT6 SLL 34 4 ?^#Q ANDN 3 #17 ?^SB SLL 0 0(3) [GET RIGHT BIT #2#2 BNG 0 (7) [BIT SET => ILLEGAL QUAL COMBINATION #2RL EXIT 7 1 #3?= [ #3QW [ THE FOLLOWING SUBROUTINES ANALYSE FAG ENDS OF QUALIFIERS.THEY SHARE #4=G [ THE FOLLOWING SPEC. #4Q6 [ ENTRY:X3-> CUNI BLOCK CONTAINING FAG END ,X1=FX1 ,X2=FX2 #59Q [ EXIT :SUBROUTINE MAY DESTROY (1) ACCS BAR X6 (2)ACOMMUNE WORDS #5PB [ (3) AWORK3,4 BUT NOTHING ELSE,& MUST NOT FREE CUNI BLOCK (UNLESS #692 [ TAKING ERROR EXIT).LINK IS X7 #6NL [ #78= XTMODE [ *MT MODE QUALIFIER #7MW NGX 0 ANUM(3) #87G BPZ 0 QERR1 [ERROR IF NO FAG END GIVEN #8M6 SBX 7 FX1 #96Q CHNUMCO1 [CONVERT NUMBER FOLLOWING MODE #9LB TESTREP OK,XTMO1 [J IF NOT ERROR #=62 MFREE CPB,CUNI [ ELSE CLEAR UP & TERMINATE - ERROR #=KL BRN QUAERR [ MESSAGE ALREADY OUTPUT #?5= XTMO1 LDX 4 ACOMMUNE1(2) #?JW SRC 4 2 ##4G BXGE 4 TWELVE(1),QERR1 [J IF NOT 0,4,8,12,...36,40,44 ##J6 SLC 4 2 #*3Q HUNT 3,CPAR,GPERCON #*HB ORS 4 GPER2(3) #B32 ADX 7 FX1 #BGL EXIT 7 0 #C2= [ #CFW XTDELAY [ *PB DELAY QUALIFIER #C^G NGX 0 ANUM(3) #DF6 BPZ 0 QERR1 [ERROR IF NO FAG END GIVEN #DYQ SBX 7 FX1 #FDB CHNUMCO1 [CONVERT NUMBER FOLLOWING DELAY #FY2 TESTREP OK,XTDE1 [J IF NOT ERROR #GCL MFREE CPB,CUNI [ ELSE CLEAR UP & TERMINATE - ERROR #GX= BRN QUAERR [ MESSAGE ALREADY OUTPUT #HBW XTDE1 LDX 4 ACOMMUNE1(2) #HWG BXGE 4 BIT11,QERR1 [J IF NOT IN RANGE 0 TO 4095 #JB6 HUNT 3,CPAR,GPERCON #JTQ SLL 4 12 #K*B ORS 4 GPER2(3) #KT2 ADX 7 FX1 #L#L EXIT 7 0 #LS= [ #M?W XTAUTO [*LP AUTO QUALIFIER #MRG LDN 4 120 #N?6 LDX 5 ANUM(3) #NQQ ANDN 5 #7777 #P=B BZE 5 XTAU1 [J IF NO FAG END #PLG CHNUMCOD 1,3 #Q2L TESTREP2 CHNUMERR,QERR1 #QBQ LDX 4 ACOMMUNE1(2) #QQW BXL 4 X4(1),QERR1 #R72 BXGE 4 X161(1),QERR1 #RH6 ANDN 4 3 #RX= BNZ 4 QERR1 #S?B LDX 4 ACOMMUNE1(2) #SMQ XTAU1 MHUNT 3,CPAR,GPERCON #T7B ORS 4 GPER2(3) #TM2 EXIT 7 0 #W6L [ #WL= MENDAREA 25 #X5W #END ^^^^ ...64460017000300000000