{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: WSPERIS867)}}
====== WSPERIS867 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:ALTLENG|ALTLENG]], [[george:macro:APPEND|APPEND]], [[george:macro:ASSMESS|ASSMESS]], [[george:macro:FINDEXOF|FINDEXOF]], [[george:macro:FINDTP|FINDTP]], [[george:macro:FPCAJO|FPCAJO]], [[george:macro:FSHENTRY|FSHENTRY]], [[george:macro:JBC|JBC]], [[george:macro:JOBLOCK|JOBLOCK]], [[george:macro:LGEOG|LGEOG]], [[george:macro:LOBJPERIS|LOBJPERIS]], [[george:macro:MFREE|MFREE]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MTPTR|MTPTR]], [[george:macro:NAME|NAME]], [[george:macro:OFF|OFF]], [[george:macro:OUTNUM|OUTNUM]], [[george:macro:OUTPACK|OUTPACK]], [[george:macro:OUTPACKX|OUTPACKX]], [[george:macro:PCATEST|PCATEST]], [[george:macro:RESTART|RESTART]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SHLSQ|SHLSQ]], [[george:macro:TESTRPN2|TESTRPN2]], [[george:macro:TOPFCBV|TOPFCBV]], [[george:macro:TRACE|TRACE]], [[george:macro:UP|UP]], [[george:macro:UPPLUS|UPPLUS]]
22FL #LIS K0WSPERIS>K0WHATSTATE>K0COMMAND>K0ALLGEO
22^= ... SEG WSPERIS,867,SECTION CENT
23YG #
244C ...[
248# ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982
24#9 ...[
24D6 SEGENTRY K1WSPERIS,SENTRY1
24QG SEGENTRY K2WSPERIS,SENTRY2
24T6 FSHENTRY K3WSPERIS,,ST1,ST1
24WD FSHENTRY K4WSPERIS,SENTRY4,,SENTRY4
24XQ # THIS SEGMENT IMPLEMENTS THE LAST PART OF THE WS COMMAND
25CB # IT DEALS WITH THE PERIPHERALS ATTACHED TO A JOB
25X2 # IT GATHERS INFORMATION FROM :THE PER LIST (ONLINE)
26BL # THE PRB
27*W #
27TG #DEF ZADATA=A1
28*6 #DEF ZHEAD=ZADATA+1
28SQ #DEF XDUJOB=A1+8
28W# #DEF WJOBNO = A1
28X# #DEF WPERPTR = A1+28
28XW ZAWSPERFH +EWSPERIS
28^D ZAWSPEROH +AWSPEROH
2932 ZAWSPERISO +AWSPERISO
294J ZAWSPERISF +AWSPERISF
2966 ZAWSPERISG +AWSPERISG
297N ZAWSSAVED +HNOWSAVE
299= ZAWSPERGO +BWSPERIS
29=S ZAWSNOCOR +AWSPERIS
29?# ZFNFD +FNFD ["NO FURTHER DETAILS AVAILABLE"
29?S [
29#B TWENTFOURHR +60*60*24/K9*1000 [1 DAY OF SC COUNTS
29#Q TDIRLANG 4HC1
29*2 [
29*7 WSW SBX 5 FX1
29*Y ASSMESS 4
29BP MHUNTW 3,GMON,AOUT
29CG NAME 3,FILE,FAPB
29D? LDX 0 A1(3)
29F4 ADN 0 11
29FT SRL 0 2
29GL STO 0 A1(3) [RESET WORD COUNT
29HC LDX 0 AWORK4(2) [DEPTH OF 'WS' FILE
29J8 BZE 0 WSW3
29J^ APPEND 1,WSW9
29KQ BRN WSW8
29LH WSW3 APPEND 0,WSW9
29M# WSW8 MFREE FILE,FAPB
29N5 TESTRPN2 OK,WSW10
29NW ADN 5 1
29PM WSW9 ADN 5 1
29QD WSW10 ADX 5 FX1
29R9 EXIT 5 0
29S2 # SUBROUTINE TO O/P PERIPHERAL TYPE AND UNIT NO
2=?L #
2=R= PERTY SBX 5 FX1
2?=W LDX 2 0
2?QG OUTPACK 2,4,PERINAME
2#=6 ADX 5 FX1
2#PQ EXIT 5 0
2F6B N3 +3
2FL2 N4 +4
2G5L # SR TO SET X456 TO NXT RECORD IN CQ11
2GK= # ACC TO WD AFTER CALL
2H4W MOVE MHUNTW 1,ADATA,CSTORE
2HJG ADX 1 AWORK1(2) [X1->TOP OF RECOED
2J46 ADX 1 0(3) [ADD DISPLACEMRNT
2JHQ LDN 2 4
2K3B MOVE 1 3
2KH2 EXIT 3 1
2L2L #
2L*3 # SR TO OUTPUT A PARAMETER WITH
2LMD # DATA OF 1ST WORD AFTER CALL
2L^T # DATA LENGTH OF 2ND WD AFTER CALL
2M#= # PDC OF 3RD WD AFTER CALL
2MLM OUTP LDX 1 3
2M^6 SBX 3 FX1
2NDQ OUTPACKX 0(1),1(1),2(1) [O/P PARAM
2PD2 ADX 3 FX1
2PXL EXIT 3 1
2QC= #
2QDY SCQPRINT
2QFG MHUNTW 2,CQPRINT,CQ11
2QG4 EXIT 1 0
2QGL SADATA
2QH8 MHUNTW 2,ADATA,CSTORE
2QHQ EXIT 1 0
2QJ# [
2QJW SENTRY1
2QKD LDX 0 ACOMMUNE1(2)
2QL2 STO 0 AWORK4(2) [DEPTH OF WS FILE
2QLJ BRN ST1
2QM6 SENTRY2
2QMN SETNCORE 20,3,ADATA,CSTORE
2QN= BRN ST1
2QNS RESTART
2QPB LDX 7 ALOGLEN(3)
2QPY SLL 7 1
2QQG ALTLENG 3,7,SADATA [DOUBLE LENGTH OF ADATA/CSTORE
2QR4 ST1 MHUNTW 3,CQPRINT,CQ11
2QRL LDXC 4 WJOBNO(3)
2QS8 LDN 5 0 [NON-ZERO IF HLS XCODE
3YG2 JOBLOCK 4,2
3Y^L BNG 2 THING [J IF BLOCK LOST
3^F= LDEX 0 JMISC(2)
3^YW BZE 0 XPRINOCORE [J IF NO LONGER A CORE IMAGE
43CQ LDX 6 2 [KEEP -> JOB BLOCK
43XB # THIS HAS BEEN NECESSARY INCASE THE JOB HAS CHANGED ITS STATUS
44C2 # SINCE CO-ORDINATING HAS TAKEN PLACE.
44WL #
45B= # THE PERIPHERAL LIST IS NOW EXAMINED.
45TW # POINTS TO NOTE.
46*G # THE 1ST WORD OF THE LIST CONTAINS THE SIZE OF THE RED TAPE
46T6 # THE ZEROTH WORD OF THE RECORD CONTAINS, IN BIT 21, WHETHER OFFOR
47#Q # ON LINE. SET IF ON-LINE
47SB # 4TH WORD IN LS HALF THE JOB-NUMBER
48#2 # IN THE MOST SIG. CH. OF ZEROTH WORD IS THE TYPE
48RL # 1ST. WORD IN LS. CHAR. THE GEOG. NO.
49?= #
49QW # THIS GEN IS STORED AS FOLLOWS
4==G # AWORD MS CH = TYPE
4=Q6 # 2WORD LS CH = GEOG NO.
4?9Q #
4?PB MHUNT 3,ADATA,CSTORE
4#92 ST2 LDX 7 ALOGLEN(3)
4#NL SBN 7 4 [X7 WILL CONTAIN
4*8= LDN 5 0 [CORE LEFT AND X5:CT OF ONLINE PERS
4*MW STOZ A1+1(3) [INITIALISE CO NTS
4B7G LDN 1 A1+1(3)
4BM6 FINDPERE 2,APJOB,4,REENT [FIND ENTRY
4C6Q ADN 1 3 [UPDATE PTR ALONG CQ11 BLOCK
4CLB BNG 2 PHIN [J WHEN ALL DONE
4D62 SBN 7 3
4DKL BNG 7 RESTART [TRY AGAIN
4F5= LGEOG 2,0 [GET GEOG NO
4FJW STO 0 1(1)
4G4G STOZ 0(1) [JUST IN CASE
4G## STOZ 2(1)
4GJ6 BUX 5 REENT [+1 FOR FOUND
4K2= PHIN STO 5 A1(3) [STORE CT OF O/L PERS
4KFW FPCAJO 2,6 [X2 -> PCA
4K^G #SKI K6WSPERIS<199-199
4LF6 TRACE A1(3),WSOLPER
4LRH PCATEST 2,TP,TP
4M5Y FINDTP 2,2
4MDB TP STO 1 A1+2(3) [X1 -> 1ST POSN FOR OFFLINE INFO
4MY2 STO 2 A1+3(3) [X2 -> APET
4NCL XLOOP LDX 2 FPTR(2)
4NX= LDX 0 ATYPE(2)
4PBW TXL 0 CACT
4PWG BCC OUTPUT [J IF NO APERI/APERIRES
4QB6 SRL 0 12
4QTQ SBN 0 APERI+APERIRES
4R*B BNZ 0 XLOOP
4RT2 XLOOP1 [PRB FOUND
4S#L LDX 6 A1(2)
4TRG BNG 6 XDONE [J IF AT END OF PRB
4W?6 LDXC 1 A1+1(2)
4WQQ BCS OFFLINE [J IF MARKED OFFLINE
4X=B LGEOG 1,6 [ELSE GET OPS NUM IN X6
546L PONLY
54L= LDN 1 A1+4(3) [X1-> 1ST ONLINE ENTRY
555W LDX 5 A1(3) [CT OF ONLINE ENTRINS
55KG ROUND TXU 6 1(1)
5656 BCC PHOUND
56JQ ADN 1 3
574B BCT 5 ROUND
57J2 BRN UPD
583L PHOUND
58H= LDX 0 A1(2) [GET PER TYPE/NUMBER WORD
592W STO 0 0(1) [KEEP COPY OF 1ST WORD
595F LDXC 6 A1+1(2)
5984 BCC PER
59=M LDX 6 4 [PTR TO DEVICE LIST
59*= PER LOBJPERIS 6,0
59CT STO 0 2(1)
59GG UPD ADN 2 2
5=26 BRN XLOOP1
5=FQ OFFLINE
5=^B SBN 7 10
5?F2 BNG 7 RESTART [RESTART IF INSUFF1CIENT CORE
5?YL LDX 1 A1+2(3) [X1-> 1ST FREE WORD
5#D= LDX 4 2 [SAVE PTR -> PRB ENTRY
5#XW LDX 2 A1+3(3) [X2 -> APET/LAST OLPA
5*CG LDX 2 ACTRING(2)
5*X6 SBN 2 ACTRING [X2 -> AOLPT
5BBQ STO 2 A1+3(3) [KEEP COPY
5BWB LDX 0 ATMARK(2)
5CB2 SBN 0 2
5CTL BZE 0 PSDMT [J IF PSEUDO OFFLINE MAGTAPE
5D*= SBN 0 6
5DSW BZE 0 PSDMT [J IF PS-ONLINE DRUM
5F#G STO 6 0(1)
5FJ# LDX 6 ACOUNT(2)
5FS6 STO 6 9(1)
5G3Y LDN 6 10
5G?Q ADS 6 A1+2(3) [UPDATE X1 COPY
5GRB LDN 6 1
5H?2 ADS 6 A1+1(3) [& COUNT OF OFFLINE PERIPHERALS
5HQL ADN 0 7
5J== BZE 0 XOFILE [EXOFILE
5JPW SBN 0 3
5K9G BZE 0 TRANS [J IF ONLINE CI
5KP6 SBN 0 2
5L8Q BZE 0 PCOMM [J IF IPC
5L?* #UNS AV7900S
5L*Y (
5LDH SBN 0 3
5LH6 BZE 0 V7900 [J IF VIRTUAL 7900
5LKP )
5LNB LDX 0 FILERING(2)
5M82 SBN 0 FILERING(2) [NULL RING IF TRANSIENT STATE
5MML BNZ 0 SOME
5N7= TRANS STOZ 1(1) [SET TRANSIENT STATE MARKER
5NLW LDX 2 4 [RESET PTR-> PRB ENTRY
5P6G BRN UPD
5PL6 SOME TOPFCBV 2,2
5Q5Q #SKI K6WSPERIS<199-199
5QKB TRACE 2,WSFILE
5R52 LDN 5 FUSER1(2)
5RJL LDN 6 1(1)
5S4= MOVE 5 6 [COPY OF FILE NAME
5S87 LDN 5 FGEN(2)
5S#4 LDN 6 7(1)
5SC^ MOVE 5 2
5SDG JBC SOME9,2,BFDIR [J IF NOT DIR
5SDT LDN 2 1 [GEN. NO.
5SF8 STO 2 7(1)
5SFJ SMO FX1
5SG5 LDX 2 TDIRLANG
5SGL STO 2 8(1) [LANG CODE
5SH7 SOME9
5SHW LDX 2 4 [RESET X2 -> PRB
5T3G BRN UPD
5TH6 XOFILE
5W2Q LDN 6 1(1) [SET X6
5WGB STOZ 1(1) [IN CASE NOT FOUND
5X22 LDX 5 EXNUM(2)
5XFL LDX 2 4 [RESET X2 -> PRB
5X^= #SKI EXUDAS<1$1
5YDW (
5YYG LDN 1 BCCB
5^D6 SEEK LDX 1 FPTR(1)
5^XQ TXU 1 CXCC
62CB BCC UPD [J IF NOT FOUND
62X2 LDX 0 ATYPE(1)
63BL SRL 0 12
63W= SBN 0 AONBS+EXOF
64*W BNZ 0 SEEK
64TG TXU 5 EXFILE(1)
65*6 BCS SEEK
65SQ )
66#B #SKI EXUDAS
66S2 (
67?L FINDEXOF 1,5,UPD
67R= )
68=W #SKI K6WSPERIS<199-199
68QG TRACE 1,WSXOFILE
69=6 LDN 5 FIP(1) [MOVE IN NAME
69PQ MOVE 5 3
6=9B SMO 6
6=P2 STOZ 3 [EXOFILE DARKER
6?8L BRN UPD
6?N= PSDMT [PSEUDO OFFLINE MAGTAPE
6#7W MTPTR 2,1 [X1->DEV LIST
6#MG LGEOG 1,6 [X6:=GEOG NUM
6*76 LDX 2 4 [RESTORE X2->PRB
6*BY LDX 4 1
6*LQ BRN PONLY [J TO ONLINE SEARCH
6B6B #SKI IPCV1
6BL2 (
6C5L # IPC - TREAT AS EXOFILES
6CK= PCOMM STOZ 1(1) [SET TRANSIENT
6D4W LDX 0 ALINDIR(2)
6DJG ERN 0 #1700
6F46 BZE 0 QFILE [J IF ENQUIRY FILE
6FHQ LDN 5 ALINAME(2)
6G3B LDN 6 1(1)
6GH2 MOVE 5 3 [NAME IN CQ BLOCK
6GJP #UNS AV7900S
6GLD (
6GN7 BRN QFILE
6GPW # VIRTUAL 7900 - TREAT AS EXOFILES
6GRK V7900 LDN 5 ACOMMUNE7(2)
6GT# LDN 6 1(1)
6GX3 MOVE 5 3 [LINK NAME (IF ANY) TO CSTORE BLOCK
6GYQ )
6H2L QFILE
6HG= STOZ 4(1) [SET AS 'EXOFILE'
6H^W LDX 2 4
6JFG BRN UPD
6J^6 )
6KDQ OUTPUT
6KYB XDONE LDX 6 A1(3) [CT OF ONLINE PERS
6LD2 LDX 7 A1+1(3) [CT OF OFFLINE PERS
6LLM MHUNTW 3,CQPRINT,CQ11
6LNW LDXC 0 WJOBNO(3)
6LR5 BCS XCODEND [J IF HLS XCODE
6LXL BNZ 6 OPHEAD
6MC= BZE 7 PHEW
6MWW OPHEAD
6NBG LDN 1 A1+4
6NW6 SMO FX2
6P*Q STO 1 AWORK1 [KEEP REL PTR
6PKJ LDX 1 FX1
6PTB LDX 4 ZAWSPERFH(1)
6Q58 CALL 5 WSW
6Q*2 BRN XER
6QJS BRN XBRK
6QSL BZE 6 NOOL [J IF NO OL PERS
6R73 LDX 4 ZAWSPEROH(1)
6RFD CALL 5 WSW
6RRT BRN XER
6S6= BRN XBRK
6SDM MHUNTW 3,ADATA,CSTORE
6SR6 LDN 1 A1+4(3)
6T=Q OPONL LDX 4 1(1) [OPS NUMBER
6TQB LDX 0 0(1) [TYPE/UNIT NUMBER
6TW? LDX 5 2(1)
6W28 LDX 2 FX2
6W65 STO 5 AWORK2(2) [NO. OF TRANSFERS
6W=2 SBX 1 3 [RELATIVISE
6WPL ADN 1 3
6X9= STO 1 AWORK1(2)
6Y8G CALL 5 PERTY [CONVERT AND O/P
6YN6 OUTNUM 4,0
6Y^3 OUTNUM AWORK2(2),7,1
6^9Y LDX 4 ZAWSPERISO(1)
6^GT CALL 5 WSW
6^RQ BRN XER
724M BRN XBRK
72*J MHUNT 3,ADATA,CSTORE
72LL LDX 1 AWORK1(2)
736= ADX 1 3 [X1-> NEXT ENTRY
73KW BCT 6 OPONL
73TN LDX 1 FX1
745G NOOL BZE 7 PHEW [J FI NO OFFLINE PERS
74CX LDX 4 ZAWSPERISF(1)
74Q# CALL 5 WSW
754P BRN XER
75C6 BRN XBRK
75PH MHUNT 3,ADATA,CSTORE
7642 LDX 1 AWORK1(2) [X1 -> REL POSN OF ENTRY
76CP OPOFF STO 1 AWORK1(2) [KEEP -> RECORD
76RD LDN 0 1
7777 STO 0 AWORK3(2) [UNSET USER SET ID.
77GW ADX 1 3
782G LDX 0 0(1)
787N LDX 5 9(1)
78#W STO 5 AWORK2(2) [NO. OF TRANSFERS
78G6 CALL 5 PERTY [CONVERT AND OUTPUT
78^Q CALL 3 MOVE
79FB +1 [TOP 3 WDS IS USERNAME ?
79^2 BZE 4 TRAN [J IF TRANSITIVE
7=DL LDX 2 3(1) [LOAD 'LOACL ' NAME
7=Y= BZE 2 XOF [J ID EXOFILE MARKER SET
7?CW CALL 3 OUTP
7?K4 +4
7?Q= +3
7?XG +JPDUSERNAME [USERNAME OYT
7?YX CALL 3 MOVE [GET GEN NO. & LANG. CODE
7#2# +7
7#3P CALL 3 OUTP [OUTPUT GEN. NO.
7#56 +4
7#6H +1
7#7Y +JPDGENNUM
7#9* CALL 3 OUTP [OUTPUT LANG. CODE
7#=Q +5
7##7 +1
7#*J +JPDLANGUAGE
7#C6 CALL 3 MOVE
7#WQ +4 [LOCALNAME INTO X456
7*BB BRN OFF
7*W2 TRAN LDCT 4 #370
7B*L ERX 4 ACES
7BT= LDX 5 ACES
7C#W LDX 6 5 [X456 ='? '
7CSG XOF SMO FX2
7D#6 STOZ AWORK3 [SET USER SET ID.
7DRQ OFF CALL 3 OUTP
7DYY +4
7F66 +3
7F?B +JPDJOBNAME [OUTPUT X456 AS ' OR NAME
7FF3 OUTNUM AWORK2(2),7,1
7FLN LDX 0 AWORK3(2)
7FS* BNZ 0 OFF8 [J IF USERNAME INCLUDED
7G22 LDX 4 ZAWSPERISO(1)
7G7M BRN OFF9
7G*# OFF8 LDX 4 ZAWSPERISG(1)
7GG^ OFF9 CALL 5 WSW
7GNL BRN XER
7GW? BRN XBRK
7H3Y MHUNT 3,ADATA,CSTORE
7H9W LDX 1 AWORK1(2) [RESET X1
7HPG ADN 1 10 [X1-> NEXT OFFLINE ENTRY
7J96 BCT 7 OPOFF
7JNQ PHEW
7K8B UP UPPLUS 2
7KC3 THING BNZ 5 XCODNOC [J IF HLS XCODE
7KF= SHLSQ 4,2,XPRILOST
7L7L LDX 4 ZAWSSAVED(1)
7LM= CALL 5 WSW
7M6W BRN XER
7MLG BRN XBRK
7P5B BRN UP
7PK2 XPRILOST
7PWB LDX 4 ZAWSPERGO(1)
7Q7Q CALL 5 WSW
7QF6 BRN XER
7QQG BRN XBRK
7R3W BRN UP
7RHG XPRINOCORE
7RPQ BNZ 5 XCODNOC [J IF HLS XCODE
7RSW LDX 4 ZAWSNOCOR(1)
7S6= CALL 5 WSW
7SCL BRN XER
7SP2 BRN XBRK
7T2B BRN UP
7TG2 XER UP
7T^L XBRK UPPLUS 1
7X?= XCODEND
7XP6 MHUNTW 2,ADATA,CSTORE
7Y72 LDX 5 A1+2(2)
7YJW SBN 5 A1+5(2)
7^2Q BNG 5 XCODNOC [J IF NO PER. INFO.
7^DL ADN 5 3
7^WG MHUNTW 3,CQPRINT,CQ11
82#B LDX 4 ALOGLEN(3)
82Q= STO 4 WPERPTR(3)
8386 ADX 4 5 [REQ. LENGTH FOR CQ11
83L2 ALTLENG 3,4,SCQPRINT [LENGTHEN CQPRINT/CQ11
843W MHUNTW 3,ADATA,CSTORE
84FQ ADN 3 A1+2
84XL MHUNTW 2,CQPRINT,CQ11
85*G ADN 4 A1(2)
85RB SBX 4 5 [X4-> 1ST FREE WORD OF CQ11
869= SMO 5
86M6 MOVE 3 0
8752 SBN 3 2
87GW MOVE 3 2 [STORE PERIPHERAL COUNTS
87YQ XCODNOC
88BL MFREEW ADATA,CSTORE
88SG ACROSS HLSREAD,30
89NL #END
^^^^ ...55107475000100000000