{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: WHATPER867)}}
====== WHATPER867 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:BSOFF|BSOFF]], [[george:macro:BXE|BXE]], [[george:macro:BXU|BXU]], [[george:macro:CLOSE|CLOSE]], [[george:macro:COMBRKIN|COMBRKIN]], [[george:macro:COMERRX|COMERRX]], [[george:macro:COOR3|COOR3]], [[george:macro:DFJUMPN|DFJUMPN]], [[george:macro:DFJUMPS|DFJUMPS]], [[george:macro:DFLOAD|DFLOAD]], [[george:macro:ENDCOM|ENDCOM]], [[george:macro:ERRORX|ERRORX]], [[george:macro:FINDCORE|FINDCORE]], [[george:macro:FON|FON]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GETCOREN|GETCOREN]], [[george:macro:HUNTW|HUNTW]], [[george:macro:JDED|JDED]], [[george:macro:JENVNOT|JENVNOT]], [[george:macro:JFREE|JFREE]], [[george:macro:JOBLOCK|JOBLOCK]], [[george:macro:JONL|JONL]], [[george:macro:JSHARED|JSHARED]], [[george:macro:JSWIN|JSWIN]], [[george:macro:JTWIN|JTWIN]], [[george:macro:LADDP|LADDP]], [[george:macro:LJOBNO|LJOBNO]], [[george:macro:LTYPE|LTYPE]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREE|MFREE]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MONOUTX|MONOUTX]], [[george:macro:NAME|NAME]], [[george:macro:NUMLINK|NUMLINK]], [[george:macro:OFF|OFF]], [[george:macro:ON|ON]], [[george:macro:OPEN|OPEN]], [[george:macro:OPENSYS|OPENSYS]], [[george:macro:OPSCON|OPSCON]], [[george:macro:OUTNUM|OUTNUM]], [[george:macro:OUTPARN|OUTPARN]], [[george:macro:PARANOTX|PARANOTX]], [[george:macro:PARANUMB|PARANUMB]], [[george:macro:PARSORTB|PARSORTB]], [[george:macro:PTYPE|PTYPE]], [[george:macro:SAWCEJX|SAWCEJX]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:UP|UP]], [[george:macro:VFREEW|VFREEW]]
22FL #LIS K0WHATPER>K0ALLGEO>K0GREATGEO>K0COMMAND
22LS ... SEG WHATPER,,,,G203 [N.R.BOULT
22S2 ...[
22^8 ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982
236B ...[ THIS EXCLUDES CODE UNDER #SKI G203
23?J ...[
23DQ ...#OPT G203 = 0
23KY ...#SKI G203&1
23R6 ...# WITH UGUG EDIT M203 (ALLOW WHATPER FOR REMOTE DEVICES)
23YG SEGENTRY K1WHATPER,QK1WHATPER
24D6 #
25X2 #
266S ... SEGENTRY K7WHATPER,QK7WHATPER [ REENTER FOR NEXT PARAM
26BL # THIS SEGMENT IMPLEMENTS THE 1ST PART OF THE WHATPER OPERATORS COMMAND
26W= # IT ANALYSES AND CHECKS THE PARAMETER . IT HAS TWO PATHS: ONE FOR A
27*W # GEOG NO PARAM AND ONE FOR DEVICE TYPE: A BLOCK OF CORE IS SET UP IN
27TG # BOTH CASES (THE LENGTH BEING CALCULATED BY SCANNING THE DEVICE LIST
28*6 # IN THE LATTER CASE) AND ANY FILES NEEDED FOR INFORMATION. THEN ANY
28SQ # INFORMATION FROM THE DEVICE LIST, AND APIA AND JOB BLOCK IF RELEVANT,
29#B # IS MOVED INTO THE BLOCK AND CONTROL PASSED TO WHATPERA. FOR THE SECOND
29S2 # CASE, IF THERE IS NOT ENOUGH ROOM IN THE BLOCK, GEOERR SHORTWPB
2=?L # INFORMATION FOR OPENING SYSTEM.PROPERTY
2Y=Q ZFABS +10
2YQB 12HSYSTEM
2^=2 12HPROPERTY
2^PL +0
329= +1
32NW 4HB1
35BS XFANON +FANONCT
35LL PB +28
366= SLOW +9
36KW QUICK +25
375G MTNO +5
37K6 THREE +3
384Q TWO +2
38JB SD 4H*DR
3942 XFD 4H*FD
39HL UDALL 4H*DA
3=3= +13
3=GW +26
3?2G # S/R TO CHECK IF DEVICE IS LIKELY TO HAVE ANY PROPERTIES
3?G6 # AND TO SET AWORK4=1 IF SO, ELSE =0. S/R USES X0&X4
3?^Q PROPCHEC
3#FB SBN 0 1
3#^2 BZE 0 SETP [TP?
3*DL SBN 0 1
3*Y= BZE 0 SETP [LP?
3BCW SBN 0 2
3BXG BZE 0 SETP [CP?
3CC6 SBN 0 5
3CWQ BZE 0 SETP [DRUM?
3DBB SBN 0 16
3DW2 BZE 0 SETP [HD?
3F*L SBN 0 3
3FT= BZE 0 SETP [IPB28?
3G#W SMO FX2
3GSG STOZ AWORK4
3H#6 EXIT 4 0
3HRQ SETP LDN 0 1
3J?B SMO FX2
3JR2 STO 0 AWORK4
3K=L EXIT 4 0
3KQ= QK1WHATPER
3L9W STOZ AWORK1(2)
3L=B ...#SKI G203&1
3L=W ...(
3L?B ... PARANUMB 7
3L?W ... BZE 7 XJPARMIS
3L#B ... PARSORTB XBRK,ALL,NOCLUS,INCOUT,SMLCC
3L#W ... BRN RU2
3L*B ...RIPB ACROSS WHATPERX,1
3L*W ...QK7WHATPER
3LBB ... MFREEW CPAR,JSCE
3LBW ... VFREEW ADATA,AWPER
3LCB ... LDX 1 FX1
3LCW ... STOZ AWORK1(2)
3LDB ...RU2
3LDW ... HUNTW 3,CPAR,JSCE
3LFB ... BNG 3 UP [ ERROR REPORTED IF NO BLOCK FOUND
3LFW ... LDCH 5 JSCEA(3) [ BASIC PERIPHERAL TYPE
3LGB ... LDX 6 JSCEP(3) [ DEVICE LIST PTR OR ZERO
3LGW ... BZE 6 PTYPE [ *PT FORMAT
3LHB ... ANDX 6 BITS22LS [ MASK OUT INVALID CLUSTER BITS
3LHW ... STO 6 JSCEP(3)
3LJB ... SAWCEJX JSCEB(3),SWIT,RIPB
3LJW ... JENVNOT SWIT,CME
3LKB ... LDX 4 JSCEA(3)
3LKW ... ANDX 4 BSB18
3LLB ... BNZ 4 SWIT
3LLW ... ACROSS WHATPERB,2
3LMB ...)
3LMW ...#SKI G203&1$1
3LNB ...(
3LPG PARSORTB XBRK,NOCLUS,INCOUT,SMLCC [ANALYSE PERI DESC.
3PM= HUNTW 3,CPAR,JSCE
3Q6W BNG 3 UP [J IF PARSORT FOUND ERROR
3Q=R LDX 4 JSCEP(3)
3QBN ANDX 4 BITS22LS
3QGK STO 4 JSCEP(3) [CLEAR CLUSTER BITS
3QLG LDX 4 JSCEQ(3)
3R66 SRL 4 12
3RKQ PARANOTX 4 [PASS PARAM FOR USE IN MESSAGES AND .
3S5B [ ANALYSIS OF LOCAL PERI
3SK2 MHUNTW 3,CPAR,JSCE
3T4L LDX 0 JSCEP(3)
3TJ= BZE 0 PTYPE [J IF *PT TYPE PARAM
3W3W SAWCEJX JSCEB(3),YLOCAL,XINVALID [J IF NOT MX LINE
3WHG JENVNOT XINVALID,CME
3X36 LDX 4 JSCEA(3)
3XGQ ANDX 4 BSB18
3Y2B BNZ 4 XINVALID [J IF SPECIFIED PCT
3YG2 ACROSS WHATPERB,2
4PBW YLOCAL
4PWG LDX 0 JSCEA(3)
4QB6 ANDN 0 #777 [GET GEOG NUMBER
4QTQ STO 0 ACOMMUNE1(2)
4R*B FREECORE 3
4RT2 ...)
546L #
54L= # CHECK SWITCH WORD:- IF ANOTHER OPERATOR COMMAND IN PROGRESS
555W # WAIT UNTIL IT HAS FINISHED
55KG #
5656 SWIT BSOFF AWHATBIT,NOWAIT [J IF SWITCH OFF - ALL CLEAR
56JQ COOR3 #114 [WAIT A WHILE
574B BRN SWIT
57J2 NOWAIT
57TQ ... CALL 4 WSON
587H ...#SKI G203&1
58?D ...(
58C* ... SETNCORE K54-K50+19,3,ADATA,AWPER [ BLOCK FOR DVLIST & JOBQ
58H= ... LDX 2 6 [ DV LIST PTR
58M7 ...)
58R4 ...#SKI G203&1$1
58W^ ...(
592W LDX 4 ACOMMUNE1(2) [CONVERTED NUMBER
59GG BZE 4 XINVALID [ERROR IF NOT
5=26 BNG 4 XINVALID [POSITIVE NUMBER
5=FQ SETNCORE K54-K50+19,3,ADATA,AWPER [BLOCK FOR DEV LIST & JOBQ
5=^B #UNS AV7900S
5?F2 FINDPERE 2,APGEOG,4,,AV7900,SWOU [X2 -> ENTRY (INCL. V7900)
5?YL #UNS AV7900S
5#D= #SKI
5#XW FINDPERE 2,APGEOG,4,,,SWOU [X2 -> ENTRY
5*CG BNG 2 UNINST
5*M# SWOU
5*X6 LTYPE 2,5 [GET DEVICE TYPE
5B6Y ...)
5BBQ CALL 0 SET7 [SET X7= -1 UNLESS MT WHEN SET X7=0
5BWB LDX 0 5
5CB2 CALL 4 PROPCHEC
5CTL BNG 7 NOFIL
5D5D ...#SKI G203&1$1
5D*= LDX 6 2
5DSW CALL 4 SYSDOC [SET X7 = NO OF FILES TO OPEN
5F#G CALL 4 OPENFILES [OPEN FILES + CREATE BLOCKS
5FS6 MHUNTW 3,ADATA,AWPER
5G?Q LDX 2 6 [RESTORE POINTER
5GRB NOFIL LDX 7 5 [SAVE X5
5H?2 LDX 4 2
5HQL LDN 5 1
5J== STO 5 A1+1(3) [COUNT OF RECS IN ADATA/AWPER BLK
5JPW LDN 5 A1+5(3)
5K9G MOVE 4 K54-K50 [MOVE DLIST RECORD INTO /AWPER BLOCK
5KP6 ADN 5 K54-K50
5L8Q JONL 2,ONLI
5LNB ADN 5 7
5M82 BRN MAINR
5MML ONLI CALL 0 SRJOB
5N7= MAINR LDX 3 5
5NLW CALL 0 PIA
5P6G CALL 0 WPROPS
5PL6 LDX 5 7 [RESTORE DEV TYPE
5Q5Q BRN MAINS [JOIN OUTPUT ROUTINE
5QKB #
5R52 # ROUTINE TO DEAL WITH CASE OF PERIPHERAL TYPE
5RJL #
5S4= # 1ST SEARCH OF DEVICE LIST
5SHW #
5SMR ...#SKI G203&1
5SRN ...(
5SXK ...PTYPE
5T3G ... LDX 4 JSCEQ(3)
5T7C ... ANDN 4 #7777
5T?# ... SBN 4 3
5TC9 ... BNZ 4 PFERR
5TH6 ... LDX 4 JSCER(3)
5TM3 ...)
5TQY ...#SKI G203&1$1
5TWT ...(
5W2Q PTYPE
5WGB LDX 5 JSCEA(3)
5X22 SRL 5 18 [PERI TYPE
5XFL FREECORE 3
5X^= ...)
65SQ SWIC BSOFF AWHATBIT,NOWT [J IF ALL CLEAR -NO OTHER OP ACTIVITI
66#B COOR3 #114 [WAIT FOR ONE TO FINISH
66S2 BRN SWIC
673S ...NOWT LDX 3 4
67?L ... CALL 4 WSON
67HD ... LDX 4 3
67R= ...#SKI G203&1$1
68=W ...(
6#7W MHUNT 3,CPB,CUNI
6#MG LDX 4 APARA(3)
6#X# ...)
6*76 BXU 4 XFD(1),NOTFD [IF TYPE *FD
6*LQ LDN 5 13 [THEN SET X5=13
6B6B NOTFD CALL 0 SET7
6BL2 LDN 3 0 [COUNT OF WORDS FOR ADATA,AWPER BLOCK
6C5L LDN 6 0
6C=S STOZ ACOMMUNE1(2)
6CD2 STOZ ACOMMUNE2(2)
6CK= #UNS AV7900S
6D4W SCAN1 FINDPERE 2,APFOTY,5,REENTRY,AV7900,SCN1,SCN3
6DJG #UNS AV7900S
6F46 #SKI
6FHQ SCAN1 FINDPERE 2,APFOTY,5,REENTRY,,SCN1,SCN3
6G3B BNG 2 ZEND [ALL DONE?
6G?8 SCN1
6GH2 ADN 3 K54-K50+14
6H2L BNG 7 REENTRY [NO NEED TO OPEN FILES?
6HG= CALL 4 SYSDOC
6H^W BRN REENTRY [GET NEXT RECORD
6J4F SCN3
6J5Q ... ADN 3 K54-K50+14
6J74 LDN 0 1
6J9M SMO FX2
6J#= ADS 0 ACOMMUNE1
6JBT JSWIN 2,REENTRY
6JFD LDN 0 1
6JJ3 SMO FX2
6JLL ADS 0 ACOMMUNE2
6JP9 BRN REENTRY
6JPG ...#SKI G203&1
6JPR ...(
6JQ4 ...ZEND
6JQ* ... MHUNTW 1,CPAR,JSCE
6JQL ... LDX 4 JSCER(1)
6JQX ...)
6JR8 ...#SKI G203&1$1
6JRF ...(
6JRS ZEND
6JWC MHUNT 1,CPB,CUNI
6J^6 LDX 4 APARA(1)
6K8Y ...)
6KDQ LDX 1 FX1
6KYB BXU 4 UDALL(1),ZEND2
6LD2 ADN 6 1
6LXL BXE 6 THREE(1),ZEND1
6MC= SMO 6
6MWW LDX 5 UDALL(1)
6NBG BRN SCAN1
6NW6 ZEND1 LDN 5 6
6P*Q BRN ZEND4
6PTB ZEND2 BXU 4 SD(1),ZEND4
6Q*2 ADN 6 1
6QSL BXE 6 TWO(1),ZEND3
6R#= LDN 5 25
6RRW BRN SCAN1
6S?G ZEND3 LDN 5 9
6SHY ZEND4
6SSC LDX 2 FX2
6STN LDX 4 ACOMMUNE1(2)
6SW# ... STO 4 AWORK3(2)
6SW^ BZE 4 ZEND5
6SY= LDX 6 ACOMMUNE2(2)
6S^H OUTNUM 4,0
6T2S OUTNUM 6,0
6T2^ ...#SKI G203&1
6T36 ...(
6T3? ... OUTPARN 3,JSCER,CPAR,JSCE
6T3D ...)
6T3K ...#SKI G203&1$1
6T3Q ...(
6T45 OUTPARN 3,APARA,CPB,CUNI
6T4P ...)
6T5B SMO FX1
6T6M LDX 4 XFANON
6T7Y MONOUTX 4
6T8= ZEND5
6T8G ... LDX 4 3
6T8Q ... LDX 0 AWORK3(2)
6T92 ...ZEND6
6T9= ... SBN 0 1
6T9G ... BNG 0 ZEND7
6T9Q ... SBN 4 K54-K50+14
6T=2 ... BRN ZEND6
6T== ...ZEND7
6T=G ... BZE 4 UNTYPE
6T=Q ADN 3 5 [1 FOR INT PTR, 1 FOR REC COUNT, +3
6TQB BNG 7 XGET [BRN IF NO OPENS REQUIRED
6W=2 LDX 0 5
6WPL CALL 4 PROPCHEC
6X9= CALL 4 OPENFILES [OPEN FILES + CREATE DATA BLOCKS
6XNW XGET SETUPCOR 3,3,ADATA,AWPER [BLOCK FOR PLIST ENTRIES ETC
6Y8G #
6YN6 # 2ND PASS OF DEVICE LIST
6^7Q STO 5 7
6^MB LDX 6 ALOGLEN(3)
7272 SBN 6 4 [X6 CONTAINS SPACE LEFT IN BLK
72LL STOZ ACOMMUNE1(2) [INITIALIZE FOR COUNT OF RECS
736= LDN 5 A1+5(3)
73KW STOZ AWORK3(2)
745G #UNS AV7900S
74K6 SCAN2 FINDPERE 2,APFOTY,7,REENT,AV7900,SCN2
754Q #UNS AV7900S
75JB #SKI
7642 SCAN2 FINDPERE 2,APFOTY,7,REENT,,SCN2
76HL BNG 2 PHEW
76RD SCN2
773= LDN 4 1
77GW SMO FX2
782G ADS 4 ACOMMUNE1 [ADD 1 TO COUNT OF RECS
78G6 LDX 4 2
78^Q SBN 6 K54-K50+14
79FB BNG 6 SHORT [J IF NO ROOM
79^2 MOVE 4 K54-K50 [MOVE DEVICE LIST REC INTO BLOCK
7=DL ADN 5 K54-K50 [AND UPDATE POINTER
7=Y= JONL 2,ONLIN
7?CW ADN 5 7
7?XG BRN TESTM
7#C6 ONLIN CALL 0 SRJOB
7#WQ TESTM LDX 3 5
7*BB CALL 0 PIA
7*W2 LDX 0 7
7B*L CALL 4 PROPCHEC
7BT= CALL 0 WPROPS
7C#W LDX 5 3
7CSG ADN 5 5
7D#6 BRN REENT
7DRQ PHEW
7DTN ...#SKI G203&1
7DXL ...(
7D^J ... MHUNTW 1,CPAR,JSCE
7F3G ... LDX 4 JSCER(1)
7F5D ...)
7F7B ...#SKI G203&1$1
7F9# ...(
7F?B MHUNT 1,CPB,CUNI
7FR2 LDX 4 APARA(1)
7G2S ...)
7G=L LDX 1 FX1
7GQ= BXU 4 UDALL(1),PHEW2 [IF *DA PARAM
7H9W LDX 2 FX2
7HPG LDX 4 AWORK3(2)
7J96 ADN 4 1
7JNQ BXE 4 THREE(1),PHEW1 [THEN GET THE NEXT
7K8B STO 4 AWORK3(2)
7KN2 SMO 4
7L7L LDX 7 UDALL(1) [UDAS DEV TYPE IN X7
7LM= BRN SCAN2
7M6W PHEW1 LDN 7 6
7MLG BRN PHEW4
7N66 PHEW2 BXU 4 SD(1),PHEW4
7NKQ LDX 2 FX2
7P5B LDX 4 AWORK3(2)
7PK2 ADN 4 1
7Q4L BXE 4 TWO(1),PHEW3
7QJ= STO 4 AWORK3(2)
7R3W LDN 7 25
7RHG BRN SCAN2
7S36 PHEW3 LDN 7 9
7SGQ PHEW4 SBN 6 1
7T2B BNG 6 SHORT
7TG2 MHUNTW 3,ADATA,AWPER
7T^L SMO FX2
7WF= LDX 5 ACOMMUNE1
7WYW STO 5 A1+1(3) [SAVE COUNT OF RECS IN ADATA/AWPER BL
7XDG LDX 5 7 [RESTORE PERIPHERAL TYPE
7XY6 MAINS
82TW QENTRY2
8=?B CALL 0 SET7
8=BG BZE 7 MAINU
8=FL ACROSS WHATPERB,1
8=JQ MAINU
8=MW ACROSS WHATPERA,1 [PROCESS DATA BLOCK + OUTPUT MESSAGES
8?7G #
8DHB #
8F32 #
8FGL # S/R TO SET X7=0 FOR DEV TYPES 0 TO 5, DRUMS & IPB28'S, ELSE -1
8G2= #
8GFW SET7 LDN 4 5
8G^G SBX 4 5
8HF6 BPZ 4 YES
8HYQ ADN 4 4
8JDB BZE 4 YES
8JY2 ADN 4 16
8KCL BZE 4 YES
8KX= ADN 4 3
8LBW BZE 4 YES
8LWG NGN 7 1
8MB6 EXIT 0 0
8MTQ YES LDN 7 0
8N*B EXIT 0 0
8NT2 #
8P#L # SUBROUTINE TO DECIDE WHETHER ITS NECESSARY TO OPEN SYSTEM.DOCUMENT
8PS= # AND SYSTEM.SERIAL . IF BOTH,X7 IS SET TO 2; IF ONLY SYS.DOC SET TO
8Q?W SYSDOC
8QRG TXU 7 TWO(1)
8R?6 BCC XIT2 [EXIT IF X7=2
8RQQ TXU 5 SLOW(1)
8S=B BCC XIT2 [J IF DRUM TYPE9
8SQ2 TXU 5 QUICK(1)
8T9L BCC XIT2 [OR TYPE 25
8TP= TXU 5 PB(1)
8W8W BCC XIT2 [J IF IPB28
8WNG JONL 2,MTEST [J IF ONLINE
8X86 TXU 5 MTNO(1)
8XMQ BCC MT [J IF MT
8Y7B JFREE 2,XIT2 [J IF IDLE
8YM2 LDN 7 1
8^6L XIT2 EXIT 4 0
8^L= MTEST TXU 5 MTNO(1)
925W BCS XIT2 [J IF NOT MT
92KG MT DFJUMPS 2,WORK,XIT2 [J IF WORKTAPE
9356 LDN 7 2
93JQ EXIT 4 0
944B #
94J2 # SUBROUTINE TO OPEN SYSTEM.DOCUMENT AND SYSTEM.SERIAL IF X7=2, AND
953L # OPEN SYSTEM.DOCUMENT ONLY IF X7=1
95H= #
962W OPENFILES
96GG SMO FX2 [KEEP CT OF FILES OPENED
9726 STO 7 AWORK1 [FOR COMMAND
97FQ SBX 4 FX1
97^B BZE 7 XIT3A [J IF NOT DOC OR SERIAL TO BE OPENED
98F2 OPENSYS XBRK,DOCUMENT,READ
98YL TESTREPN OK,RONGREP
99D= GETCOREN 7,1
99XW FINDCORE 2
9=CG NAME 2,ADATA,AWDOC
9=X6 TXU 7 TWO(1)
9?BQ BCS XIT3A
9?WB OPENSYS RONGO,SERIAL,READ
9#B2 TESTREPN OK,RONGREP
9#TL XIT3A
9**= SMO FX2
9*SW LDX 0 AWORK4
9B#G BZE 0 XIT3B [J IF NO PROPERTIES
9BS6 SETNCORE 10,2,FILE,FABSNB
9C?Q ADN 1 ZFABS
9CRB ADN 2 A1
9D?2 MOVE 1 10
9DQL OPEN RONGO,READ [OPEN SYSTEM.PROPERTY
9F== TESTREPN OK,RONGREP
9FPW LDN 0 1
9G9G ADS 0 AWORK1(2) [UPDATE COUNT OF FILES OPEN
9GP6 XIT3B
9H8Q ADX 4 FX1
9HNB XIT3 EXIT 4 0
9J82 #
9JML # SUBROUTINE TO EXTRACT THE JOB AND USER NAMES FROM THE JOB BLOCK
9K7= SRJOB LJOBNO 2,1 [GET JOB NUMBER
9KLW STO 2 4 [PRESERVE X2
9L6G SMO 5
9LL6 STO 1 0
9M5Q ADN 5 1
9MKB SMO FX2
9N52 STO 0 ACOMMUNE5
9NJL JOBLOCK 1,1
9P4= SRJ1 LDX 2 4
9PHW SMO FX2
9Q3G LDX 0 ACOMMUNE5
9QH6 BNG 1 XIT4
9R2Q LDX 4 ALOGLEN(1)
9RGB SBN 4 ASTJOB
9S22 BZE 4 XIT4 [J IF NO USER
9SFL LDN 4 JUSER(1)
9S^= MOVE 4 3
9TDW ADN 5 3 [UPDATE POINTER IN DATA BLOCK
9TYG LDN 4 JNAME(1)
9WD6 MOVE 4 3
9WXQ ADN 5 3
9XCB EXIT 0 0
9XX2 XIT4 ADN 5 6
9YBL EXIT 0 0
9YW= #
9^*W # S/R TO CHECK IF DEV IS IPB(28),UDAS OR MT
9^TG # IPB(TYPE 28): GETS NO OF LINKS USING IT
=2*6 # UDAS: CHECKS "IN USE BY SYSTEM" BIT
=2SQ # MT: GETS TSN AND ALSO CHECKS IF TAPE LOADED,
=3#B # AND IF NONSTANDARD, POOL OR WORKTAPE.
=3S2 #
=4?L PIA
=4R= STOZ 4
=5=W SMO FX2
=5QG STO 0 ACOMMUNE5
=6=6 SMO FX2
=6PQ STO 7 AWORK2
=79B SBN 7 5
=7P2 BZE 7 TAPE [J IF MAG TAPE
=88L SBN 7 1
=8N= BZE 7 UDAS [J IF UDAS DEV TYPE 6
=97W SBN 7 1
=9MG BZE 7 UDAS [OR 7
==76 SBN 7 6
==LQ BZE 7 UDAS [J IF UDAS - TYPE 13
=?6B SBN 7 13
=?L2 BZE 7 UDAS [J IF UDAS - TYPE 26
=#5L #SKI IPCV1-1
=#K= BRN XIT5
=*4W #SKI IPCV1
=*JG (
=B46 SBN 7 2
=BHQ BNZ 7 XIT5 [J IF NOT IPB - TYPE 28
=C3B NUMLINK 2 [X0 CONTAINS NO OF LINKS
=CH2 LDX 4 0
=D2L BRN XIT5A
=DG= )
=KBG UDAS JTWIN 2,TWUD
=KW6 BRN UDAS1
=L*Q TWUD LDN 4 #200
=LTB LADDP 2,1
=M*2 JSHARED 1,UDAS1
=MSL SRL 4 1
=N#= JDED 1,UDAS1
=NRW SRL 4 1
=P?G UDAS1 LDXC 5 2(1)
=PR6 BCC XIT5A
=Q=Q ADN 4 #20
=R=2 BRN XIT5A
=RPL TAPE DFLOAD 2,TSN,4
=S9= STO 4 0(3) [SAVE TSN
=SNW DFLOAD 2,NONS,4
=T8G BNZ 4 TAPLO [J IF NONKTANDARD
=TN6 DFLOAD 2,WORK,4
=W7Q SLL 4 1
=WMB BNZ 4 TAPLO [J IF WORK
=X72 DFLOAD 2,POOL,4
=XLL SLL 4 2
=Y6= TAPLO DFJUMPN 2,LOAD,XIT5A [J IF TAPE NOT LOADED
=YKW ADN 4 #10
=^5G XIT5A STO 4 1(3)
=^K6 XIT5 SMO FX2
?24Q LDX 0 ACOMMUNE5
?2JB ADN 3 2
?342 SMO FX2
?3HL LDX 7 AWORK2
?43= EXIT 0 0
?4GW #
?52G # S/R TO MOVE APERPROP WORDS INTO ADATA/AWPER BLOCK
?5G6 #
?5^Q WPROPS
?6FB SMO FX2
?6^2 LDX 5 AWORK4
?7DL BZE 5 NPROP [J IF NOT SLOW O/P PERIPHERAL
?7Y= LADDP 2,1
?8CW LDN 4 APERPROP(1)
?8XG LDX 5 3
?9C6 MOVE 4 ATTMAX [MOVE PROP WORDS
?9WQ EXIT 0 0
?=BB NPROP STOZ 0(3)
?=W2 LDX 4 3
??*L LDN 5 1(3)
??T= MOVE 4 ATTMAX-1 [ZEROISE PROP WORD AREA IN WP BLOCK
?##W EXIT 0 0
?#B? ...#
?#CN ...#
?#F5 ...#
?#GG ...#
?#HX ...#
?#K# ...#
?#LP ...WSON
?#N6 ... OPSCON WSSET,XIT6
?#PH ...WSSET ON AWHATBIT
?#QY ...XIT6 EXIT 4 0
?#SG #
?*#6 # COMMAND ERROR REPORTING
?*RQ #
?B?B XJPARMIS
?BR2 CALL 1 MISTAKE
?C=L +JPARMIS
?CQ= XINVALID
?DPG OFF AWHATBIT
?F96 CALL 1 MISTAKE
?FNQ +JSETP1
?G8B UNINST
?H7L OFF AWHATBIT [MARK AS ALL CLEAR
?HM= CALL 1 MISTAKE
?J6W +JNOPER
?JLG PFERR CALL 1 MISTAKE
?K66 +ERRPERC
?KKQ UNTYPE
?LK2 OFF AWHATBIT [MARK AS ALL CLEAR
?M4L CALL 1 MISTAKE
?MJ= +FUNTYPE
?N3W MISTAKE
?N4^ ...#SKI G203&1
?N64 ...(
?N77 ... HUNTW 3,CPAR,JSCE
?N8= ... BNG 3 RU1
?N9* ... LDX 7 JSCEQ(3)
?N=D ... SRL 7 12
?N?H ... LDX 6 0(1)
?N#L ... PARANOTX 7 [ GET PARAMETER BLOCK FOR ERROR
?N*P ... ERRORX 6
?NBS ... MFREE CPB,CUNI
?NCX ... BRN QK7WHATPER [ GO BACK FOR NEXT PARAM
?NF2 ...RU1
?NG5 ...)
?NHG COMERRX 0(1)
?P36 RONGO
?PGQ LDX 7 AWORK1(2)
?Q2B BZE 7 UP
?QG2 XCL CLOSE [CLOSE ALL FILES OPEN FOR COMMAND
?Q^L BCT 7 XCL
?RF= XBRK COMBRKIN
?RHT ...#SKI G203&1$1
?RLD ...(
?RP3 ...QK7WHATPER
?RRL ... GEOERR 1,NO-WP7
?RW9 ...)
?RYW RONGREP
?SDG GEOERR 1,WRONGREP
?SY6 SHORT
?TCQ GEOERR 1,SHORTWPB [NOT ENOUGH ROOM IN WP BLOCK
?TXB UP
?WWL FON #114
?XB= ENDCOM
?XTW MENDAREA 50,K99WHATPER
?Y*G #END
^^^^ ...211557750004