(George Source)
Macros used: ACROSS, BXU, CCSTOP, CHAIN, COMERR, DFJUMPS, DOWN, ENDCOM, ENRINGD, FMOPACT, FPUT, GEOERR, GEOPACK, GETACT, HUNT, HUNT2B, HUNT2J, HUNTACT, HUNTW, JALLOC, JWRONG, LINKSET, LPROP, MARKAXES, MENDAREA, MHUNT, MHUNTW, OUTPACK, OUTPARAM, PAIR, PARANUMB, PARSORT, PCTFACT, SAWCE, SAWCEJX, SEGENTRY, SETALLOC, SETUPCORE, SPARANOT, SPARANOX, SPARUNAC, UNLOAD, UP
22FL #LIS K0REDON>K0ALLGEO>K0GREATGEO>K0COMMAND 22S3 ...#SEG REDON [LEN WAGSTAFF 22^9 ...# (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982. 236D ...# 23DW 8HREDON 23YG SEGENTRY K1REDON,X1REDON 24D6 SEGENTRY K2REDON,X2REDON 24XQ SEGENTRY K3REDON,X3REDON 257J ...# 25CB X1REDON 25GG ... STOZ 4 25KL ... PARANUMB 3,4 25NQ ... SBN 3 2 25RW ... BNG 3 PARMI [ERROR IF <2 PARAS 265= ... PARSORT P4,GROPE 26BL HUNTW 1,CPAR,JSCE 26W= BNG 1 P4 27*W SAWCEJX JSCEB(1),X8,XIPB,X7020 27TG XIPB CALL 6 PU 28*6 HUNTW 1,CPAR,JSCE 28DK ... LDEX 0 JSCEB(1) [IF CI, GET... 28J4 ... BNZ 0 NOTCI [PROG.PROP.NO. .. 28MH ... LDX 0 JSCEP(1) [PLUS B0=1 FOR... 28R2 ... ANDX 0 BITS22LS [FMOPACT 28WF ... ORX 0 GSIGN 28^Y ... BRN XBOTH 295C ...NOTCI LDX 0 JSCEP(1) [ELSE DEVICE LIST PTR 298W ...XBOTH FMOPACT 2,0,IPB [IPBIN ADDR IN X2 29#B SMO FX2 29S2 STO 2 AWORK4 2=?L HUNT2J 2,AMXOR,ADEVS,,P4 2=R= LDX 6 JSCEA(1) [IDENTIFIER NO 2?=W ANDN 6 #7777 2?QG SBX 6 A1+FOURTHWD(2) 2#=6 SLL 6 2 2#PQ ADX 2 6 2*9B LDX 7 A1+FOURTHWD(2) 2*P2 ANDN 7 #477 2B8L SBN 7 4 2BN= BZE 7 X3 2C7W SBN 7 2 2CMG BNZ 7 X15 [NOT CR OR TR 2D76 X3 LDCT 7 #24 2DLQ ANDX 7 A1+FOURTHWD(2) 2F6B ORX 7 A1+BPTR(2) 2FL2 BNZ 7 MALLOC [ALREADY ALLOCATED 2G5L LDCT 7 2 2GK= ANDX 7 A1+FOURTHWD(2) 2H4W BNZ 7 NORW [WRONGED 2H82 ... LDN 7 #41 2H?6 ... SLL 7 7 2HB= ... ANDX 7 A1+FOURTHWD(2) 2HFB ... BNZ 7 RTEST 2HJG LDCT 7 #24 2J46 ORS 7 A1+FOURTHWD(2) [ALLOCATE 2JHQ DOWN IPBINB,3 2K3B BRN QU 2KH2 BRN MALLOC 2L2L QU 2LG= MHUNTW 1,CPAR,JSCE 2L^W CCSTOP JSCEA(1),AWORK4(2) 2MFG BRN QV 2M^6 PCTLINK 2NDQ PAIR PCTSTART,1 2NYB X7020 CALL 6 PU 2PD2 HUNTW 1,CPAR,JSCE 2PK8 ... LDX 0 JSCEA(1) 2PQB ... BZE 0 X15 [J IF NOT 7020 2PXL FMOPACT 2,JSCEP(1) 2QC= SMO FX2 2QWW STO 2 AWORK4 2S*Q LDX 7 JSCEA(1) 2STB ANDN 7 #77 [INTERFACE NO 2T*2 LDX 6 JSCEB(1) [LINE NO 2TSL SRL 6 9 2W#= ANDN 6 #77 2WRW LDX 5 JSCEA(1) 2X?G SRL 5 6 2XR6 ANDN 5 #7777 [PCT TERMINAL IDE. 2Y=Q SLL 6 2 2YQB ... SMO FX2 [KEEP REL PTR TO ALINES... 2^=2 ... STO 6 AWORK2 [..ENTRY FOR LATER USE 2^PL ... CALL 6 SERCHINF 34MB STOZ 0 3572 RF2 SMO 0 35LL LDX 6 APCTSTAT(1) 366= ... BNG 6 P4 [J IF INOP 375G SMO 0 37K6 LDX 4 IDUNIQUE(1) 384Q SRL 4 12 [PCT TERMINAL IDE THE SAME? 38JB TXU 5 4 3942 BCC RF1 39HL ADN 0 APCTRLEN [APCTRLEN X N 3=3= BRN RF2 3=GW RF1 LDX 3 1 3?2G ADX 3 0 3?G6 SMO FX2 3#^2 STO 0 AWORK3 [POINTER TO THE ENTRY IN INFORM 3*DL LDX 2 3 3*Y= ADN 3 12 3BCW X5 SBN 3 2 3BXG LDX 6 APCTDEV+1(3) 3CC6 LDCH 5 6 3CWQ SRL 6 12 3DBB ANDN 6 #77 3DW2 SBX 6 7 3F*L BNZ 6 X5 [MATCH INTERFACE NO. 3FT= SBN 5 2 3G#W BZE 5 X6 3GSG SBN 5 2 3H#6 BNZ 5 X15 [NOT CR OR TR 3HRQ X6 LDX 6 APCTDEV(3) 3J?B SRL 6 6 3JR2 ANDN 6 #7700 [INTERFACE BIT POSITION 3K=L LDX 7 APCTD(2) 3KQ= ANDX 7 6 3L9W BZE 7 MALLOC [ALREADY ALLOCATED 3LPG LDX 7 APCTD(2) 3M96 SRL 7 12 3MNQ ANDX 7 6 3N8B BZE 7 NORW [WRONGED 3NN2 ERS 6 APCTD(2) [ALLOCATE 3P7L LDX 7 IDUNIQUE(2) [SET UP DETAILS FOR PCTSTART 3PM= LDX 5 APCTDEV(3) [IN X4,X5 AND JSOURCE1 3Q6W DSA 0 5 3QLG LDX 4 APCTDEV+1(3) 3R66 GETACT CPAT 3RKQ LDX 3 BPTR(2) 3S5B STO 7 JSOURCE1(3) 3SK2 STO 4 ACC4(3) 3T4L STO 5 ACC5(3) 3TJ= LINKSET 3,PCTLINK(1) 3TS4 ... LDX 2 AWORK4(2) [PTR TO AMOP 3W3W ... CALL 6 SERCHINF [FIND A7020'INFORM 3W?N ... LDX 2 1 [PTR TO INFORM 3WHG PCTFACT 2 3X36 ENRINGD JOBRING(3),JOBRING(2) 3XGQ BRN QV 3Y2B # 3YG2 # 3Y^L # 3^F= X8 SAWCE CENTRAL,X9 3^YW CALL 7 PARAS 42DG COMERR INOCLUS [REMOTE COMMAND SOURCE 42Y6 X9 HUNTW 1,CPAR,JSCE 43CQ LDCH 6 JSCEA(1) [DEVICE TYPE 43XB BZE 6 OK [IS IT TR? 44C2 SBN 6 3 44WL BZE 6 OK1 [IS IT CR? 45B= SBN 6 2 [IS IT MT? 45TW BZE 6 MT 46*G SBN 6 1 [IS IT UDAS DEVICE? 46T6 BZE 6 XUD [IF NOT-ERROR 47#Q SBN 6 1 47SB BZE 6 XUD [J IF UDAS,TYPES 6,7,13,26 48#2 SBN 6 6 48RL BZE 6 XUD 49?= SBN 6 13 49QW BZE 6 XUD 4==G X15 CALL 7 PARAS 4=Q6 COMERR JXALL [WRONG TYPE 4?4H ...MT ADN 6 5 [RESET TYPE 4?BY ... BRN OK 4?PB OK1 ADN 6 3 [RESET TYPE 4?T? ... CALL 7 T96COLCR [TEST FOR A 96 COLUMN CARD READER 4?^8 ... [TEST IS MADE HERE TO MINIMIZE MAIN 4#55 ... [PATH EXPANSION. 4#92 OK 4#NL LDX 4 JSCEK(1) 4*8= BPZ 4 ZAPF 4*MW CALL 6 PU 4B7G MT1 HUNTW 1,CPAR,JSCE 4BM6 LDX 3 JSCEP(1) [DEVICE LIST POINTER 4C6Q LDX 2 FX2 4CLB JWRONG 3,NORW [J IF WRONGED 4D62 JALLOC 3,MALLOC [OR ALLOCATED 4DKL STO 3 CPPTR(2) 4F5= SETALLOC 3 [OTHERWISE ALLOCATE 4FJW HUNTW 1,CPAR,JSCE 4G4G LDCH 6 JSCEA(1) 4GJ6 SBN 6 5 [TEST IF MT 4H3Q BNZ 6 K2REDON 4HHB DFJUMPS 3,LOAD,MT2 [J. IF OPERABLE 4J32 ACROSS REDONMT,1 [WITH GEOG. NO IN X5 AND PERIPHERAL 4JGL [RECORD MARKED ALLOCATED AND INOP. 4K2= MT2 4KFW UNLOAD ,,,UNL 4K^G ADN 6 5 4LF6 BRN MT1 4LYQ NORW 4MDB CALL 7 PARAS 4MY2 COMERR ERRWRONGED 4MYB ...# 4MYQ ...# 4M^6 ...# SUBROUTINE TO TEST FOR A 96 COLUMN CARD READER (CS 5556) 4M^G ...# IF TRUE, ONLY PERMIT THE DOCUMENT COMMAND THROUGH 4M^W ...# ON ENTRY: X1 -> CPAR/JSCE ; ON EXIT: X1 -> CPAR/JSCE,X2 -> CPB/CUNI 4N2= ...STRDM 4H0DM 4N2L ...STRDOCUMENT 8HDOCUMENT 4N32 ...# 4N3B ...T96COLCR 4N3Q ... LPROP JSCEP(1),0 [B15 OF CR PROPERTY CODE INDICATES A 4N46 ... ANDN 0 4 [96 COLUMN CARD READER . 4N4G ... BZE 0 T96COLCRXIT [NOT 96 COL CR 4N4W ... SPARUNAC [GET COMMAND PARAMETER 4N5= ... MHUNT 2,CPB,CUNI 4N5L ... LDX 0 ANUM(2) 4N62 ... BZE 0 PARMI [PARAMETER NULL 4N6B ... LDX 0 APARA(2) 4N6Q ... SRL 0 6 4N76 ... SBX 0 STRDM(1) 4N7G ... BZE 0 T96COLCRXIT [COMMAND = "DM " : OK 4N7W ... LDX 0 APARA(2) 4N8= ... BXU 0 STRDOCUMENT(1),T96COLCRERR [COMMAND NE "DOCU" : COMERR 4N8L ... LDCH 0 APARA+1(2) 4N92 ... SBN 0 #20 4N9B ... BZE 0 T96COLCRXIT [COMMAND = "DOCU " : OK 4N9Q ... LDX 0 APARA+1(2) 4N=6 ... BXU 0 STRDOCUMENT+1(1),T96COLCRERR [COMMAND NE "DOCUMENT" 4N=G ... LDCH 0 APARA+2(2) 4N=W ... SBN 0 #20 4N?= ... BNZ 0 T96COLCRERR [COMMAND NE "DOCUMENT " 4N?L ...T96COLCRXIT 4N#2 ... MHUNTW 1,CPAR,JSCE 4N#B ... EXIT 7 0 4N#Q ...T96COLCRERR 4N*6 ... MHUNTW 1,CPAR,JSCE [OUTPUT UNIT NO. PARAMETER : U'N' 4N*G ... LDX 7 JSCEA(1) 4N*W ... GEOPACK 7,7,7 4NB= ... OUTPACK 7,1,GEOPER 4NBL ... COMERR JNOTDM 4NCL # 4NX= # 4NY9 ...# SUBROUTINE TO GIVE PTR IN X1 TO A7020/INFORM,GIVEN 4N^8 ...# PTR TO AMOP ACTIVITY IN X2, AND PTR TO RELRVANT AMXOR/ALINES 4P27 ...# ENTRY (RELATIVE TO START OF ALINES BLOCK) IN AWORK2 4P36 ...SERCHINF 4P45 ... SBX 6 FX1 4P54 ... HUNT2J 2,AMXOR,ALINES,,P4 4P63 ... SMO FX2 4P72 ... ADX 2 AWORK2 [PT TO CORRECT ENTRY 4P7^ ... LDX 1 A1+BPTR(2) [PTR TO LCB RING ELT 4P8Y ... BZE 1 P4 [J IF MOPPED OFF 4P9X ... SBN 1 A1+FPTR [START OF LCB 4P=W ... HUNT2B 1,A7020,INFORM 4P?T ... ADX 6 FX1 4P#S ... EXIT 6 0 4P*R ...# 4PBW PU SBX 6 FX1 4PWG HUNT 2,CLB 4QB6 LDX 7 ANUMCHA(2) 4QTQ LDX 5 7 4R*B ADN 5 CPDATA-A1*4+3 4RT2 SRL 5 2 [NO OF WORDS 4S#L SETUPCORE 5,3,ADATA,CREADL 4SS= STO 7 A1(3) [STORE NO OF CHARS 4T?W HUNT 2,CLB 4TRG ADN 2 CLBFIR 4W?6 ADN 3 CPDATA 4W#T ... BNZ 7 PU1 4WBJ ... COMERR JPARMIS,JCOMA 4WD? ...PU1 SBN 7 512 [MOVE COMMAND TO... 4WG2 ... BNG 7 PU2 [..READLINE BLOCK 4WHP ... MVCH 2 0 [MAY BE >511 CHARS 4WKD ... BRN PU1 4WM7 ...PU2 ADN 7 512 4WNW ... BZE 7 PU3 4WQQ SMO 7 4X=B MVCH 2 0 [MOVE COMMAND TO READLINE BLOCK 4XQ2 ...PU3 HUNTW 2,ADATA,CREADL 4Y9L LDX 0 SPACE(1) [LOAD SPACE CHAR. 4YP= PV LDCH 5 CPDATA(2) 4^8W DCH 0 CPDATA(2) 4^NG BCHX 2 £ 537B PV1 TXU 5 PCOMMA(1) 53M2 BCS PV [J IF NOT COMMA 546L LDX 7 GSIGN [MARK AS REDON 54L= ADX 6 FX1 555W EXIT 6 0 55KG # 5656 # 56JQ # 574B QV 57J2 LDX 7 GSIGN 583L LDX 3 FX2 58H= HUNTACT CPAT,3 592W BRN PZ 59GG X3REDON 5=26 LDN 7 0 5=FQ BRN PW 5=^B # THIS IS THE ENTRY FOR THE MACRO ISSUJOB 5?F2 X2REDON 5?YL ORN 7 1 5#D= PW GETACT CPAT 5#XW LDX 3 BPTR(2) 5*CG BNG 7 P3 [J IF REDON 5*X6 LDX 5 CLONG1(2) 5BBQ ANDX 5 MASKQ(1) 5BWB STO 5 CLONG1(3) 5CB2 BNZ 7 PW1 5CTL #SKI INMOP<1$1 5D*= ( 5DSW LDN 5 #77 5F#G DCH 5 JSOURCE1(3) 5FS6 ) 5G?Q LDCT 5 #200 5GHJ ... ORN 5 #20 [SET SYSTEM STARTED&OPERATOR CONTEXTS 5GRB BRN PW2 5H?2 PW1 LDX 5 GSIGN 5HQL PW2 STO 5 CONTEXT(3) 5J== PX 5JPW PY LINKSET 3,PLINK(1) 5K9G PZ HUNTW 2,ADATA,CREADL 5KP6 CHAIN 2,3 [CHAIN READLINE IN NEW ACT. 5L8Q LDX 2 3 5LNB FPUT [PUT ON LIST 5M82 BPZ 7 P10 5MML MARKAXES 5N7= P4 5NLW ENDCOM 5P6G P10 5PL6 UP 5Q5Q P3 HUNTW 1,CPAR,JSCE 5QKB LDX 6 JSCEA(1) 5R52 STO 6 JSOURCE1(3) [STORE DEV.TYPE AND GEO.NO. 5RJL LDX 1 FX1 5S4= LDX 5 CPPTR(2) 5SHW STO 5 CPPTR(3) 5T3G BRN PX 5TH6 # 5W2Q XUD ACROSS SETDISC,1 [IF UDAS DEVICE 5WGB [ONLY CPAR/GNUMCON BLOCK NECESSARY 5X22 # 5XFL ZGEO GEOERR 1,RDPARAM [PARAMETER CLUDGE 5X^= # 5YDW # THIS SECTION HANDLES COMMAND ERROR REPORTS 5YYG # SUBROUTINE WHICH DEFINES THE UNIT NO FOR THE ERROR MESSAGE 5^D6 RERR HUNTW 1,CPAR,JSCE 5^XQ LDX 6 JSCEB(1) 62CB BPZ 6 RLOC 62X2 BRN RREM 63BL RLOC LDX 6 JSCEA(1) 63W= RREM ANDN 6 #777 64*W LDN 5 0 64TG SPARANOX 5,6 65*6 EXIT 7 0 65SQ # 66#B # FORMAT ERROR IN FIRST PARAMETER 66S2 ZAPF COMERR APFERR 67?L # NUMBER FORMAT ERROR IN FIRST PARAMETER 67R= ZCH COMERR CHNUMERR 68=W # COMMAND ERROR FOR UNKNOWN PERIPHERAL 68QG NODEV CALL 7 PARAS 69=6 COMERR JNOPER 69FY ...PARMI COMERR JPARMIS [ < 2 PARAMETERS 69PQ # COMMAND ERROR FOR PERIPHERAL ALREADY ALLOCATED 6=9B MALLOC 6=P2 CALL 7 PARAS 6?8L COMERR JALOC 6?=T ...RTEST 6?*4 ... MHUNTW 2,CPAR,JSCE 6?C? ... LDX 5 JSCEQ(2) 6?FG ... ANDN 5 #7777 6?HP ... OUTPARAM 5,JSCER,CPAR,JSCE 6?KY ... COMERR JERTGEO 6?N= PCOMMA #34 6#7W PARAS STOZ 6 6#MG SBX 7 FX1 6*76 SPARANOT 1,6 6*LQ ADX 7 FX1 6B6B EXIT 7 0 6BL2 SPACE #20 6C5L SIXF #777 6CK= MASKQ #20000000 6D4W PLINK 6DJG ... PAIR COMPROA,1 6F46 MENDAREA 20,K7REDON 6FHQ #END ^^^^ ...07314702000200000000