{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: REDON867)}}
====== REDON867 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:BXU|BXU]], [[george:macro:CCSTOP|CCSTOP]], [[george:macro:CHAIN|CHAIN]], [[george:macro:COMERR|COMERR]], [[george:macro:DFJUMPS|DFJUMPS]], [[george:macro:DOWN|DOWN]], [[george:macro:ENDCOM|ENDCOM]], [[george:macro:ENRINGD|ENRINGD]], [[george:macro:FMOPACT|FMOPACT]], [[george:macro:FPUT|FPUT]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GEOPACK|GEOPACK]], [[george:macro:GETACT|GETACT]], [[george:macro:HUNT|HUNT]], [[george:macro:HUNT2B|HUNT2B]], [[george:macro:HUNT2J|HUNT2J]], [[george:macro:HUNTACT|HUNTACT]], [[george:macro:HUNTW|HUNTW]], [[george:macro:JALLOC|JALLOC]], [[george:macro:JWRONG|JWRONG]], [[george:macro:LINKSET|LINKSET]], [[george:macro:LPROP|LPROP]], [[george:macro:MARKAXES|MARKAXES]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:OUTPACK|OUTPACK]], [[george:macro:OUTPARAM|OUTPARAM]], [[george:macro:PAIR|PAIR]], [[george:macro:PARANUMB|PARANUMB]], [[george:macro:PARSORT|PARSORT]], [[george:macro:PCTFACT|PCTFACT]], [[george:macro:SAWCE|SAWCE]], [[george:macro:SAWCEJX|SAWCEJX]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETALLOC|SETALLOC]], [[george:macro:SETUPCORE|SETUPCORE]], [[george:macro:SPARANOT|SPARANOT]], [[george:macro:SPARANOX|SPARANOX]], [[george:macro:SPARUNAC|SPARUNAC]], [[george:macro:UNLOAD|UNLOAD]], [[george:macro:UP|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