{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: MAKEVCC867)}}
====== MAKEVCC867 ======
(George Source)
**Macros used:** [[george:macro:ALTLEN|ALTLEN]], [[george:macro:ALTLENG|ALTLENG]], [[george:macro:BXE|BXE]], [[george:macro:BXGE|BXGE]], [[george:macro:BXL|BXL]], [[george:macro:BXU|BXU]], [[george:macro:CHAIN|CHAIN]], [[george:macro:CHNUMCOD|CHNUMCOD]], [[george:macro:CLOSE|CLOSE]], [[george:macro:COMERR|COMERR]], [[george:macro:DOWN|DOWN]], [[george:macro:ENDCOM|ENDCOM]], [[george:macro:FNORM|FNORM]], [[george:macro:GEOPACK|GEOPACK]], [[george:macro:HUNTW|HUNTW]], [[george:macro:IDFTPUPD|IDFTPUPD]], [[george:macro:INFORMX|INFORMX]], [[george:macro:JALLOC|JALLOC]], [[george:macro:JMBS|JMBS]], [[george:macro:JV7900|JV7900]], [[george:macro:LAMOP|LAMOP]], [[george:macro:LGEOG|LGEOG]], [[george:macro:MFREE|MFREE]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MURDER|MURDER]], [[george:macro:NAMETOP|NAMETOP]], [[george:macro:OUTNUM|OUTNUM]], [[george:macro:OUTPACK|OUTPACK]], [[george:macro:OUTPARAM|OUTPARAM]], [[george:macro:PARABEG|PARABEG]], [[george:macro:PARANOTX|PARANOTX]], [[george:macro:PARANUMB|PARANUMB]], [[george:macro:PARSORT|PARSORT]], [[george:macro:REPERR2|REPERR2]], [[george:macro:SAWCEJX|SAWCEJX]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SPARUNAC|SPARUNAC]], [[george:macro:STEP|STEP]], [[george:macro:TESTREP|TESTREP]], [[george:macro:TESTREP2|TESTREP2]], [[george:macro:USEROPEN|USEROPEN]], [[george:macro:ZERRORX|ZERRORX]], [[george:macro:ZERRORY|ZERRORY]]
22FL SEG MAKEVCC,,R.WEYAND COMM
22PD ...# (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982
22^= SEGENTRY K1MAKEVCC,Z1MAKEVCC [IMPLEMENTS MAKEVCC COMMAND
23DW SEGENTRY K2MAKEVCC,Z2MAKEVCC [IMPLEMENTS CANCEL MAKEVCC COMMAND
23YG #
24D6 # CONVENTIONS :
24XQ # PRESET LABELS ARE PREFIXED WITH 'P'
25CB # SUBROUTINE LABELS ARE PREFIXED WITH 'S'
25X2 # PROGRAM LABELS ARE PREFIXED WITH 'V'(FOR VIRTUAL 7900)
26BL # ERROR LABELS ARE PREFIXED WITH 'X'
26W= #
27*W [
27TG [ PRESET DATA
28*6 [
28SQ # REMOTE DEVICE TYPE NUMBERS
29#B #DEF PTTDT = 0
29S2 #DEF PLPDT = 3
2=?L #DEF PCRDT = 4
2=R= #DEF PTWDT = 5
2?=W #DEF PTRDT = 6
2?QG #DEF PTPDT = 7
2#=6 #DEF PVDDT = 10
2#PQ #
2*9B #DEF PTYPE7900 = 24
2*P2 PUNITRANGE 256,512 [512 = MAX+1
2B8L PCPREFIX 12HSYSTEM
2BN= PBASICFILE #400
2C7W PFILETERM 4H****
2CMG PMINREC 4
2D76 PSPACE #20
2DLQ PIDENPREFIX 4H000I
2F6B PIDENMAX 4096 [4096 = MAX+1
2FL2 PDTTTW 4HTTW0
2G5L PDTLP 4HLP00
2GK= PDTCR 4HCR00
2H4W PDTTW 4HTW00
2HJG PDTTR 4HTR00
2J46 PDTTP 4HTP00
2JHQ PDTVDU 4HVDU0
2K3B PST7502 4 [LENGTH OF SUBTYPE
2KH2 #00010000 [BIT 11 : 7502 SOFT FORMAT LOOP FLAG
2L2L 4H7502 [SUBTYPE MNEMONIC
2LG= PSTSPOOLING 8
2L^W #00020000 [BIT 10 : SPOOLING CAPABILITY
2MFG 8HSPOOLING
2M^6 ...PAV7900 +AV7900E [VIRTUAL 7900 %A NOW EXISTS
2NDQ PAV7900X +AV7900X [VIRTUAL 7900 %A NOW NON-EXISTENT
2NYB [
2PD2 [ SUBROUTINES
2PXL [
2QC= #
2QWW # SUBROUTINE TO SEARCH A STRING OF CHARACTERS FOR THE FIRST
2RBG # NON-SPACE CHARACTER .
2RW6 # ON ENTRY X3 -> START OF STRING ; X6 = LENGTH OF STRING IN CHARS
2S*Q # IF A NON-SPACE CHAR NOT FOUND,EXITS +0 .
2STB # IF A NON-SPACE CHAR FOUND,EXITS +1 WITH X3 -> NON-SPACE CHAR ;
2T*2 # X6 = LENGTH OF STRING REMAINING INCLUDING THE NON-SPACE ;
2TSL # X0 = THE NON-SPACE CHAR .
2W#= # LINK IN X7 .
2WRW SNONSPACE
2X?G #
2XR6 BZE 6 (7) [NON-SPACE CHAR NOT FOUND : EXIT +0
2Y=Q LDCH 0 0(3)
2YQB BXE 0 PSPACE(1),SNEXTCHAR
2^=2 EXIT 7 1 [NON-SPACE CHARACTER FOUND : EXIT +1
2^PL SNEXTCHAR
329= SBN 6 1
32NW BCHX 3 SNONSPACE
338G #
33N6 #
347Q # SUBROUTINE TO INCREMENT A CHARACTER INDEX WORD AND TO DECREMENT A
34MB # COUNT WORD BY A SPECIFIED NUMBER. XJCONFERR IF COUNT GOES -VE .
3572 # ON ENTRY X3 = CHARACTER INDEX WORD TO BE INCREMENTED ;
35LL # X6 = COUNTER TO BE DECREMENTED ; X0 = THE NUMBER .
366= # LINK IN X7 .
36KW SUPDPTRCT
375G SLC 3 2
37K6 ADX 3 0
384Q SRC 3 2
38JB SBX 6 0
3942 BNG 6 XJCONFERR
39HL EXIT 7 0
3=3= #
3=GW #
3?2G # SUBROUTINE TO CONVERT A DECIMAL CHAR STRING IN RANGE 1 TO 4095 TO
3?G6 # BINARY FORM. XJCONFERR IF DECIMAL INTEGER IS NOT IN RANGE .
3?^Q # ON ENTRY X3 -> START OF DECIMAL CHAR STRING ;
3#FB # X6 >= LENGTH OF DECIMAL CHAR STRING .
3#^2 # ON EXIT X0 = THE BINARY INTEGER ; X3 -> FIRST NON-NUMERIC CHAR ;
3*DL # X6 = LENGTH OF STRING REMAINING .
3*Y= # LINK IN X7 .
3BCW #
3BXG SCDB
3CC6 STO 4 GEN4
3CWQ STO 5 GEN5
3DBB LDN 4 0
3DW2 LDN 5 0
3F*L SCDBCHAR
3FT= BZE 6 SCDBTEST [STRING EXHAUSTED
3G#W CDB 4 0(3)
3GSG BCS SCDBTEST [STRING TERMINATED BY A NON-NUMERIC
3H#6 SBN 6 1
3HRQ BCHX 3 SCDBCHAR [CONVERT NEXT CHAR
3J?B SCDBTEST
3JR2 BNZ 4 XJCONFERR [BINARY NUMBER IS DOUBLE-LENGTH
3K=L BZE 5 XJCONFERR [BINARY NUMBER IS ZERO
3KQ= BXGE 5 PIDENMAX(1),XJCONFERR[BINARY NUMBER IS > 4095
3L9W STO 5 0
3LPG LDX 4 GEN4
3M96 LDX 5 GEN5
3MNQ EXIT 7 0
3N8B #
3NN2 #
3P7L # SUBROUTINE TO TEST IF A STRING MATCHES A SPECIFIED SUBTYPE
3PM= # AND IF TRUE SETS A SPECIFIED FLAG IN AWORK2 .
3Q6W #
3QLG # ON ENTRY X3 -> START OF STRING ; X6 = LENGTH OF STRING IN CHARS ;
3R66 # X1 -> SUBTYPE DETAILS OF THE SUBTYPE TO TEST FOR ;
3RKQ # SUBTYPE DETAILS : WORD 0 = LENGTH OF SUBTYPE, WORD 1 = SUBTYPE
3S5B # FLAG TO BE SET IN AWORK2, WORD 2 = SUBTYPE MNEMONIC .
3SK2 # EXITS +0 IF FALSE WITH X3 AND X6 UNCHANGED, X1 =FX1 .
3T4L # EXITS +1 IF TRUE WITH X3 -> FIRST CHAR FOLLOWING THE SUBTYPE FIELD
3TJ= # AND X6 = LENGTH OF FIELD REMAINING, X1 = FX1 .
3W3W # LINK IN X7 .
3WHG #
3X36 SMATCHSTYPE
3XGQ STO 3 GEN3
3Y2B STO 4 GEN4
3YG2 STO 5 GEN5
3Y^L STO 6 GEN6
3^F= STO 7 GEN0
3^YW LDX 7 1(1) [SUBTYPE FLAG TO BE SET
42DG LDX 4 0(1) [LENGTH OF SUBTYPE
42Y6 SBX 6 4 [DECREMENT STRING LENGTH FOR SUBTYPE
43CQ BNG 6 SMATFAIL [SUBTYPE LONGER THAN STRING
43XB SMATTEST
44C2 LDCH 0 0(3) [STRING CHAR
44WL LDCH 5 2(1) [SUBTYPE CHAR
45B= BXU 0 5,SMATFAIL [NO MATCH
45TW BCHX 3 £
46*G BCHX 1 £
46T6 BCT 4 SMATTEST [TEST NEXT CHAR
47#Q ORS 7 AWORK2(2) [SET SUBTYPE FLAG
47SB LDN 7 1 [EXIT +1
48#2 ADS 7 GEN0
48RL SMATEXIT
49?= LDX 1 FX1
49QW LDX 4 GEN4
4==G LDX 5 GEN5
4=Q6 LDX 7 GEN0
4?9Q EXIT 7 0
4?PB SMATFAIL
4#92 LDX 6 GEN6 [RESET STRING LENGTH
4#NL LDX 3 GEN3 [RESET STRING POINTER
4*8= BRN SMATEXIT [EXIT +0
4*MW #
4B7G [
4BM6 [ MAIN PATHS
4C6Q [
4CLB #
4D62 Z1MAKEVCC [MAKEVCC COMMAND
4DKL #
4F5= # AWORK WORDS USAGE :
4FJW # AWORK1 = VIRTUAL 7900 OPERATOR UNIT NUMBER
4G4G # AWORK2 = CURRENT REMOTE DEVICE SPECIFICATION WORD (SEE
4GJ6 # PSD 14.32.6,SECTION 5.3.3.(J).REMOTE DEVICE)
4H3Q # AWORK3 = CURRENT CONFIGURATION FILE RECORD NUMBER (=/> 0)
4HHB #
4K^G # VALIDATE THE TWO PARAMETERS
4LF6 PARANUMB 5 [GET COUNT OF PARAMETERS
4LYQ SBN 5 3 [TEST NO MORE THAN 2 SPECIFIED
4MDB BPZ 5 XJTOOMANY
4MY2 # TEST FOR THE UNIT NUMBER PARAMETER : U"N"
4NCL LDN 5 1
4NX= LDCT 6 #650 [LOOK FOR PARAM BEGINNING WITH "U"
4PBW PARABEG 1,5
4PWG MHUNT 3,CPB,CUNI
4QB6 LDX 0 ANUM(3)
4QTQ BNG 0 XJPARMIS1 ["U" NON-EXISTENT
4R*B BZE 0 XAPFERR ["N" NON-EXISTENT
4RT2 CHNUMCOD ,3
4S#L TESTREP CHNUMERR,VENDCOM ["N" NOT A VALID NUMBER FORMAT
4SS= LDX 0 ACOMMUNE1(2) [CHECK "N" IS IN THE RANGE 256 TO 511
4T?W BXL 0 PUNITRANGE(1),XERANGE
4TRG BXGE 0 PUNITRANGE+1(1),XERANGE
4W?6 STO 0 AWORK1(2) [SAVE UNIT NUMBER
4WQQ # TEST FOR THE ABSOLUTE FILE NAME PARAMETER
4X=B SPARUNAC
4XQ2 MHUNT 3,CPB,CUNI
4Y9L NGX 0 ANUM(3)
4YP= BPZ 0 XJPARMIS2 [FILE NAME PARAMETER MISSING
4^8W NAMETOP 3,FILE,FNAME [CONVERT FILE NAME TO AN ABSOLUTE
4^NG ... FNORM 128 [FILE NAME BLOCK
5286 TESTREP2 NAMEFORM,VENDCOM [ERROR IN FILE NAME REPORTED
52MQ MHUNT 3,FILE,FNAME [RENAME FNAME FOR USEROPEN
537B NAMETOP 3,CPB,CUNI
53M2 MHUNT 3,FILE,FABSNB [CHECK SYNTACTIC FORM IS AN ABSOLUTE
546L [NAME BY DEDUCTION
54L= JMBS XAPFERR,3,BFABTSN,BFABLOCONLY,BFABWORK
555W # OPEN THE CONFIGURATION FILE
55KG LDN 5 PCPREFIX(1) [PRETEND TO BE IN USER CONTEXT UNDER
5656 LDN 6 CPREFIX(2) [:SYSTEM FOR USEROPEN MACRO BY
56JQ MOVE 5 3 [SETTING UP CPREFIX
574B USEROPEN (GEOERR),READ,LEAVE,NOWAIT,REPLY
57J2 REPERR2 VOPENED [REPLY OK
583L BRN VENDCOM
58H= VOPENED
592W MHUNTW 3,FILE,ENT [SET UP BY USEROPEN (MODE LEAVE)
59GG LDX 0 ETM(3) [CHECK FILE TYPE IS BASIC
5=26 SRL 0 15
5=FQ BXU 0 PBASICFILE(1),XERWRONG
5=^B # TIDY UP
5?F2 MFREEW FILE,ENT
5?YL MFREE FILE,FABSNB
5#D= # CONVERT EACH CONFIGURATION FILE RECORD TO A DCP'S CONFIGURATION REPORT
5#XW # REMOTE DEVICE SPECIFICATION WORD FORMAT AND STORE IN AN IDF/IREPORT
5*CG # BLOCK .
5*X6 SETNCORE 65,4,IDF,IREPORT [ALLOW AN ARBITRARY 64 ENTRIES
5BBQ STOZ AWORK2(2) [INITIALISE CURRENT REMOTE DEVICE
5BWB [SPECIFICATION WORD .
5CB2 STOZ AWORK3(2) [INITIALISE CURRENT CONFIGURATION
5CTL [FILE RECORD NUMBER .
5D*= VNEXTRECORD
5DSW STEP [READ A CONFIGURATION FILE RECORD
5F#G BZE 3 XJCONFERR [END OF FILE : NO TERMINATOR
5FS6 LDX 6 0(3)
5G?Q SBN 6 2 [RECORD LENGTH IN WORDS MINUS HEADER
5GRB SLC 6 2 [RECORD LENGTH IN CHARS PLUS ANY
5H?2 [UNUSED SPACE CHARS IN LAST WORD
5HQL # TEST FOR THE CONFIGURATION FILE TERMINATOR RECORD IN THE
5J== # FIRST FOUR CHARS
5JPW BXL 6 PMINREC(1),XJCONFERR[RECORD LENGTH IS BELOW MINIMUM (4)
5K9G ADN 3 2 [SET POINTER TO START OF RECORD DATA
5KP6 LDX 0 0(3)
5L8Q BXE 0 PFILETERM(1),VTERMINATED [CONFIG. FILE TERMINATOR FOUND
5LNB # CONVERT THE IDENTIFIER FIELD TO AN IDENTIFIER NUMBER IN
5M82 # B12-23 OF AWORK2
5MML CALL 7 SNONSPACE [SEARCH FOR THE IDENTIFIER FIELD
5N7= BRN XJCONFERR [IDENTIFIER FIELD NOT FOUND
5NLW BXU 0 PIDENPREFIX(1),XJCONFERR[IDEN FIELD NOT PREFIXED WITH "I"
5P6G LDN 0 1 [STEP TO NEXT CHAR (IDENTIFIER)
5PL6 CALL 7 SUPDPTRCT
5Q5Q CALL 7 SCDB [CONVERT IDENTIFIER TO BINARY(IN X0)
5QKB LDX 5 AWORK2(2)
5R52 ANDN 5 #7777 [PREVIOUS IDENTIFIER NUMBER
5RJL STO 0 AWORK2(2) [STORE NEW IDENTIFIER NUMBER
5S4= BXGE 5 0,XJCONFERR [IDENTIFIER NUMBER NOT ASCENDING
5SHW # CONVERT THE DEVICE TYPE FIELD TO A DEVICE TYPE NUMBER IN
5T3G # B5-8 OF AWORK2
5TH6 CALL 7 SNONSPACE [SEARCH FOR THE DEVICE TYPE FIELD
5W2Q BRN XJCONFERR [DEVICE TYPE FIELD NOT FOUND
5WGB SBN 6 2 [DECREMENT RECORD LENGTH FOR DEV TYPE
5X22 BNG 6 XJCONFERR [DEVICE TYPE FIELD NOT FOUND
5XFL LDN 0 0
5X^= LDN 4 0 [OBTAIN THE 2 CHAR DEVICE TYPE IN X0
5YDW MVCH 3 2 [AND STEP PAST THE DEVICE TYPE CHARS
5YYG # MATCH WITH RECOGNISED DEVICE TYPE
5^D6 # MNEMONICS
5^XQ BXE 0 PDTLP(1),VDTLP
62CB BXE 0 PDTCR(1),VDTCR
62X2 BXE 0 PDTTW(1),VDTTW
63BL BXE 0 PDTTR(1),VDTTR
63W= BXE 0 PDTTP(1),VDTTP
65*6 MVCH 3 1 [NOT A 2 CHAR DEVICE TYPE:TEST FOR 3
65SQ SBN 6 1 [DECREMENT RECORD LENGTH FOR DEV TYPE
66#B BXE 0 PDTTTW(1),VDTTT
66S2 BXE 0 PDTVDU(1),VDTVD
67R= BRN XJCONFERR [DEVICE TYPE FIELD INVALID
68=W # PICK UP CORRESPONDING DEVICE TYPE
68QG # NUMBER
69=6 VDTTT LDN 0 PTTDT
69PQ BRN VDTPACK
6=9B VDTLP LDN 0 PLPDT
6=P2 BRN VDTPACK
6?8L VDTCR LDN 0 PCRDT
6?N= BRN VDTPACK
6#7W VDTTW LDN 0 PTWDT
6#MG BRN VDTPACK
6*76 VDTTR LDN 0 PTRDT
6*LQ BRN VDTPACK
6B6B VDTTP LDN 0 PTPDT
6BL2 BRN VDTPACK
6C5L VDTVD LDN 0 PVDDT
6CK= VDTPACK
6D4W SRC 0 9
6DJG ORS 0 AWORK2(2)
6F46 # CONVERT ANY SUBTYPE FIELDS TO SPECIAL FLAGS IN
6FHQ # B9-11 OF AWORK2
6G3B VNEXTSTYPE
6GH2 CALL 7 SNONSPACE [SEARCH FOR A SUBTYPE FIELD
6H2L BRN VRECORDOK [NO MORE SUBTYPES
6HG= LDN 1 PST7502(1) [TEST FOR SUBTYPE 7502
6H^W CALL 7 SMATCHSTYPE
6JFG BRN VSTSPOOLING [NO MATCH
6J^6 LDX 0 AWORK2(2) [CHECK DEVICE TYPE IS LP
6KDQ SRL 0 15
6KYB SBN 0 PLPDT
6LD2 BNZ 0 XJCONFERR [DEVICE TYPE NOT LP
6LXL BRN VNEXTSTYPE [ANYMORE SUBTYPES ?
6MC= VSTSPOOLING
6MWW LDN 1 PSTSPOOLING(1) [TEST FOR SUBTYPE SPOOLING
6NBG CALL 7 SMATCHSTYPE
6NW6 BRN XJCONFERR [NO MATCH : SUBTYPE NOT RECOGNISED
6P*Q BRN VNEXTSTYPE [ANYMORE SUBTYPES ?
6PTB # STORE THE REMOTE DEVICE SPECIFICATION WORD (AWORK2) IN
6Q*2 # THE IDF/IREPORT BLOCK
6QSL VRECORDOK
6R#= MHUNTW 3,IDF,IREPORT
6RRW LDX 4 ALOGLEN(3) [TEST IF ROOM EXISTS FOR THE WORD
6S?G SBN 4 2 [(NUMBER OF THE LAST ENTRY)
6SR6 BXL 4 AWORK3(2),VEXTEND [NO ROOM
6T=Q LDX 0 AWORK2(2) [STORE NEW ENTRY
6TQB SMO AWORK3(2)
6W=2 STO 0 A1+1(3)
6WPL LDN 0 1 [UPDATE RECORD NUMBER FOR NEXT RECORD
6X9= ADS 0 AWORK3(2)
6XNW BRN VNEXTRECORD [PROCESS THE NEXT RECORD
6Y8G VEXTEND [EXTEND THE IREPORT BLOCK BY AN
6YN6 [ARBITRARY 64 WORDS AND RETURN
6^7Q ADN 4 2+64
6^MB ALTLEN 3,4,IDF,IREPORT
7272 BRN VRECORDOK
72LL VTERMINATED
736= LDX 4 AWORK3(2)
73KW BZE 4 XJCONFERR [CURRENT CONFIGURATION FILE RECORD
745G [NUMBER = 0 : NULL CONFIGURATION
74K6 CLOSE [THE CONFIGURATION FILE
754Q ADN 4 1 [SET UP IDF/IREPORT COUNT WORD
75JB MHUNTW 3,IDF,IREPORT
7642 STO 4 A1(3)
76HL ALTLENG 3,4 [SHORTEN IDF/IREPORT IF NOT FULL
773= # CREATE THE VIRTUAL 7900 IN THE IDF AND CORE
77GW LDX 0 AWORK1(2) [SET THE VIRTUAL 7900'S OPS UNIT NO.
782G STO 0 ACOMMUNE1(2) [IN ACOMMUNE1 FOR K3SETIDF
78G6 ... DOWN IDFCHK,3
78^Q LDX 3 ACOMMUNE1(2) [VIRTUAL 7900 DEVICE LIST POINTER
79FB [(RETURNED BY K3SETIDF)
79^2 BZE 3 XERALREX [VIRTUAL 7900 UNIT NO. ALREADY EXISTS
7=DL # INSERT THE IDENTIFIER CONFIGURATION(IDF/IREPORT) IN THE IDF
7=Y= IDFTPUPD (GEOERR),3
7?CW LDN 0 0
7?XG DSA 0 ATYPE(3) [NOW THAT THE VIRTUAL 7900 HAS A
7#C6 [CONFIGURATION INDICATE THAT IT IS NO
7#WQ [LONGER BEING CREATED BY ZEROISING
7*BB [APERI/AV7900.ATYPE.B12-23(WHICH WAS
7*W2 [SET BY K3SETIDF)
7*YK ... SETNCORE 499,2,AMXOR,AJOURN
7B38 ... STOZ IPBCOUNT(2)
7B5R ... STO 3 IPBDATA+497(2)
7B8B ... LAMOP 3,4
7B=^ ... CHAIN 2,4
7B*L # INFORM THE CENTRAL OPERATOR AND ENDCOM
7BT= LDX 6 PAV7900(1)
7C#W VINFORMX
7CSG GEOPACK 5,AWORK1(2),UNIT [OUTPUT UNIT NO. PARAMETER : U'N'
7D#6 OUTPACK 5,1,GEOPER
7DRQ INFORMX ,6,1 [CENTRAL OPERATOR
7F?B VENDCOM
7FR2 ENDCOM
7G=L #
7GQ= Z2MAKEVCC
7H9W #
7KN2 # VALIDATE THE UNIT NUMBER PARAMETER
7L7L PARSORT (GEOERR)
7LM= HUNTW 3,CPAR,JSCE
7M6W BNG 3 VENDCOM [UNIT NO. PARAMETER MISSING/INVALID
7MLG SAWCEJX JSCEB(3),VLOCALUNIT,XJUNITERR,XJUNITERR
7N66 VLOCALUNIT
7NKQ LDCH 0 JSCEA(3)
7P5B SBN 0 PTYPE7900
7PK2 BNZ 0 XJUNITERR [UNIT NOT A 7900
7Q4L JV7900 JSCEP(3),VIRTUAL7900
7QJ= BRN XJUNITERR [UNIT NOT A VIRTUAL 7900
7R3W # TEST VIRTUAL 7900 IS MOPPED OFF AND IS NOT BEING MOPPED ON NOR
7RHG # ACCESSED (WITHOUT COORDINATING)
7S36 VIRTUAL7900
7SGQ JALLOC JSCEP(3),XJRES1 [MOPPED ON
7T2B LAMOP JSCEP(3),4 [SET X4 -> V7900 AMOP/IPBIN ACTIVITY
7TG2 LDCT 0 #10
7T^L SMO 4
7WF= ANDX 0 IPBSW
7WYW BNZ 0 XJRES1 [BEING MOPPED ON
7XDG # NOTE THE V7900 AMOP/IPBIN IS NOW IMPLICITLY ASLEEP
7XY6 SMO JSCEP(3) [TEST IF V7900 IS BEING ACCESSED BY
7Y9G ... LDN 0 AVOLPARING
7YGW ... SMO JSCEP(3)
7YS= ... TXU 0 AVOLPARING
7^5L ... BCS XJRES1 [J IF BEING ACCESSED BY A PROG
7^C2 LGEOG JSCEP(3),0 [SET THE V7900 OPS UNIT NO FOR INFORM
7^WL STO 0 AWORK1(2)
82B= # REMOVE THE VIRTUAL 7900 FROM CORE :
82TW # REMOVE THE DEVICE LIST FROM THE MISCELLANEOUS CHAIN AND THE AMOP/
83*G # IPBIN FROM THE IPB LIST (WITHOUT COORDINATING)
83T6 # FINALLY MURDER THE AMOP/IPBIN .
84#Q # REMOVE THE V7900 DEVICE LIST FROM THE MISCELLANEOUS CHAIN
84SB # AS IT CAN NOT BE DESTROYED YET
85#2 CHAIN JSCEP(3),2 [CHAIN IT TO THIS CPAT
85RL # REMOVE THE V7900 AMOP/IPBIN FROM THE IPB LIST ::
86?= # SEARCH THE IPB LIST FOR ITS POINTER TO THE V7900 AMOP/
86QW # IPBIN ACTIVITY AND REPLACE IT WITH THE V7900 AMOP/IPBIN'S
87=G # POINTER TO THE NEXT AMOP/IPBIN(IPBL)
87Q6 LDN 3 IPBADDR-IPBL [BEGIN SEARCH WITH IPBADDR
889Q VPTRSEARCH
88PB LDX 0 IPBL(3)
8992 BXE 0 4,VPTRFOUND [POINTER FOUND
89NL STO 0 3 [CHECK NEXT AMOP/IPBIN'S IPBL
8=8= BRN VPTRSEARCH
8=MW VPTRFOUND
8?7G SMO 4
8?M6 LDX 0 IPBL [V7900 AMOP/IPBIN'S PTR TO NEXT AMOP
8#6Q STO 0 IPBL(3) [OVERWRITE PTR TO THE V7900 AMOP
8#LB # MURDER THE V7900 AMOP/IPBIN
8*62 MURDER 4 [AMOP/IPBIN IS ALWAYS LOCKED
8*KL # REMOVE THE VIRTUAL 7900 FROM THE IDF
8B5= MHUNTW 3,APERI,AV7900 [REMAINS LOCKED
8BJW IDFTPUPD (GEOERR),3 [THE WHOLE UNIT WILL BE REMOVED AS
8C4G [NO IDF/IREPORT BLOCK IS PRESENT
8CJ6 # INFORM THE CENTRAL OPERATOR AND ENDCOM
8D3Q # LET ENDCOM DESTROY THE V7900 DEVICE LIST
8DHB LDX 6 PAV7900X(1)
8F32 BRN VINFORMX
8FGL #
8G2= [
8GFW [ EXCEPTION PATHS
8G^G [
8HF6 XJPARMIS1
8HYQ COMERR JPARMIS,JUNNO [UNIT NUMBER PARAMETER MISSING
8JDB ZERRORY ["COMERRX"
8JY2 XJCOMDEV [K1MAKEVCC & K2MAKEVCC
8KCL ZERRORX JCOMDEV [THIS COMMAND IS ONLY ALLOWED IN A
8KX= [DME ENVIRONMENT
8LBW XJTOOMANY
8LWG ZERRORX JTOOMANY [TOO MANY PARAMETERS
8MB6 XAPFERR
8MTQ ZERRORX APFERR [PARAMETER FORMAT ERROR
8N*B XJPARMIS2
8NT2 COMERR JPARMIS,JFNAME [FILE NAME PARAMETER MISSING
8P#L XERANGE
8PS= ZERRORX ERANGE [%C IS OUT OF RANGE
8Q?W XERWRONG
8QRG CLOSE
8R?6 ZERRORX ERWRONG [ENTRANT %C IS OF THE WRONG TYPE FOR
8RQQ [THIS OPERATION
8S=B XJCONFERR
8SQ2 #SKI K6VIPB>599-599
8T9L (
8TP= STO 0 GEN0
8W8W LDX 0 ASWITCH1 [IF MOP TR IS "ON", GEOERR INSTEAD .
8WNG SLL 0 7
8X86 BNG 0 (GEOERR)
8XMQ )
8Y7B CLOSE [THE CONFIGURATION FILE
8YM2 OUTNUM AWORK3(2),0 [CONVERT THE CURRENT CONFIGURATION
8^6L [FILE RECORD NO. TO A MESSAGE PARAM.
8^L= ZERRORX JCONFERR [CONFIGURATION RECORD %A INVALID
925W XERALREX
92KG # ACCESS THE COMPLETE UNIT NUMBER PARAMETER FOR THIS
9356 # ERROR MESSAGE
93JQ MFREE CPB,CUNI [FILE NAME CUNI
944B MHUNT 3,CPB,CUNI [UNIT NUMBER CUNI
94J2 PARANOTX JPARNUM(3)
953L #
95H= ZERRORX ERALREX [%C ALREADY EXISTS
962W XJUNITERR [K2MAKEVCC
96GG LDN 4 0
9726 BRN XPERIDESC
97FQ XJRES1 [K2MAKEVCC
97^B LDN 4 1
98F2 XPERIDESC
98YL LDX 5 JSCEQ(3) [GET PARAMETER LENGTH
99D= ANDN 5 #7777
99XW OUTPARAM 5,JSCER,CPAR,JSCE [OUTPUT PERIPHERAL DESCRIPTION PARAM
9=CG BNZ 4 XZJRES1 [XJRES1 ENTRY
9=X6 ZERRORX JUNITERR [UNIT %A IS NOT A SUITABLE DEVICE
9?BQ XZJRES1
9?WB ZERRORX JRES1 [UNIT %A NOT IN REQUIRED STATE
9#B2 #END
^^^^ ...561652210004