{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: PROPERTY867)}}
====== PROPERTY867 ======
(George Source)
**Macros used:** [[george:macro:APPEND|APPEND]], [[george:macro:BXGE|BXGE]], [[george:macro:BXL|BXL]], [[george:macro:BXU|BXU]], [[george:macro:CHEKLFN2|CHEKLFN2]], [[george:macro:CLOSE|CLOSE]], [[george:macro:COMBRKIN|COMBRKIN]], [[george:macro:COMERRX|COMERRX]], [[george:macro:DELETE|DELETE]], [[george:macro:ENDCOM|ENDCOM]], [[george:macro:FINDPEREC|FINDPEREC]], [[george:macro:FREECORE|FREECORE]], [[george:macro:FSHENTRY|FSHENTRY]], [[george:macro:GEOERR|GEOERR]], [[george:macro:HUNTW|HUNTW]], [[george:macro:INFORM|INFORM]], [[george:macro:INSERT|INSERT]], [[george:macro:JENVNOT|JENVNOT]], [[george:macro:LADDP|LADDP]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:NAMEX|NAMEX]], [[george:macro:OPENSYS|OPENSYS]], [[george:macro:OUTPARAM|OUTPARAM]], [[george:macro:P|P]], [[george:macro:PARAFREE|PARAFREE]], [[george:macro:PARALYSE|PARALYSE]], [[george:macro:PARAMOVE|PARAMOVE]], [[george:macro:PARANUMB|PARANUMB]], [[george:macro:PARSORTX|PARSORTX]], [[george:macro:POP|POP]], [[george:macro:PROPCANC|PROPCANC]], [[george:macro:PROPERTY|PROPERTY]], [[george:macro:PROPUSE|PROPUSE]], [[george:macro:PUTCONS|PUTCONS]], [[george:macro:REWIND|REWIND]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SPARABEG|SPARABEG]], [[george:macro:SPARANOT|SPARANOT]], [[george:macro:SPARAPAS|SPARAPAS]], [[george:macro:STEP|STEP]], [[george:macro:TEST|TEST]], [[george:macro:TESTNAMX|TESTNAMX]], [[george:macro:TESTREP|TESTREP]], [[george:macro:TESTREP2|TESTREP2]], [[george:macro:V|V]], [[george:macro:VOP|VOP]]
22#C ...#SEG PROPERTY [LEN WAGSTAFF
22FK ...# (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1983
22LS ...#OPT K0PROPERTY=0
22^= 8HPROPERTY
23DW #LIS K0PROPERTY>K0PROPSYS>K0ALLGEO
23YG #
24D6 #
24XQ # THIS SEGMENT IMPLEMENTS THE PROPERTY & CC PROPERTY COMMANDS
25CB # IT HAS TWO ENTRY POINTS
25X2 # K1 PROPERTY
26BL # K2 CC PROPERTY
26W= #
27*W #
27TG SEGENTRY K1PROPERTY,PROPERTYK1
28*6 SEGENTRY K2PROPERTY,PROPERTYK2
28SQ #
28TT ...[ UNANTICIPATED CLOSEDOWN ENTRY (PR COMMAND)
28WY ...[
28Y3 ... FSHENTRY K3PROPERTY,XK3A,,XK3A
28^6 ...[
2929 ...[ ENTRY TO GET IDFANDPROP SEMAPHOR IN B
293# ...[
294C ... FSHENTRY K4PROPERTY,,XK4,XK4
295G ...[
296K ...[ ENTRY TO DO PUTCONS IN M/C B
297N ...[
298R ... FSHENTRY K5PROPERTY,XK5,XK5,XK5
299W ...[
29=^ ...[ ENTRY FOR UNANTICIPATED CLOSEDOWN (CC PR)
29#4 ...[
29*7 ... FSHENTRY K7PROPERTY,XK7A,,XK7A
29B= ...[
29C* ...[ ENTRY TO DO PROPCANC IN M/C B
29DD ...[
29FH ... FSHENTRY K8PROPERTY,XK8,XK8,XK8
29GL ...[
29HP ...[ ENTRY POINT TO DO 'PARSORTX' IN M/C B FOR M/C B COMMAND
29JS ...[
29KX ... FSHENTRY K9PROPERTY,,XK9,XK9
29M2 ...[
29N5 ...[ ENTRY POINT IN M/C B TO RELEASE SEMAPHOR & SUICIDE @ END OF COMMAND
29P8 ...[
29Q? ... FSHENTRY K10PROPERTY,,XK10,XK10
29S2 #
2=?L ONEBIT #57777777
2=R= TEMEX #40000000 [DEFAULT :TEMP & EXCL/S
2?=W ONE #20000000
2?QG TWO #37777777
2#=6 PCATEGORY 16HPERMINCLEXCLTEMP
2#PQ PCONS 7HCONSOLE
2*9B TWOBITS #17777777
2*P2 TESTBIT #60000000
2B8L PCENTRAL 8HCENTRAL
2BN= PERMBIT #20000000
2C7W PTAPE +1
2CMG PCARDS +4
2D76 PRINTER +2
2DLQ PDRUM1 +9
2F6B PDRUM2 +25
2FL2 PIPC +28
2G5L PTREADER +0
2GK= PCREADER +3
2GL^ ...#SKI G3SIGNET
2GNN ...(
2GQC ...PLPL 4H000L
2GS6 ...PLPP 4H000P
2GTT ...PLPA 4H000A
2GXJ ...PLPF 4H000G
2G^? ...TEN +10
2H32 ...)
2H4W #
2QC= #
2QWW # ASSORTED MESSAGES TO THE OPERATOR:
2RBG #
2RW6 ZPARMIS +JPARMIS [UC PARAMETER MISSING
2S*Q ZPROPNA +JPROPNA [PROPERTY NAME
2STB ZNOTPAIR +JNOTPAIR [DELIMITERS MUST BE PAIRED
2T*2 ZILLCOMB +ILLCOMB [THIS COMBINATION OF QUALIFIERS IS IL
2TSL ZPROPUNK +JPROPUNK [PROPERTY NAME %C UNKNOWN
2W#= ZQUALIFIER +JQUALIFIER [ONLY ONE SET OF QUALIFIERS MAY BE GI
2WRW ZNLFNF +JNLFNF [%C IS NOT A CORRECTLY FORMED NAME
2X?G ZPROPEXISTS +JPROPEXIST [PROPERTY %C ALREADY EXISTS
2XR6 ZCONSABS +JCONSABS [CONSOLE PARAMETER MISSING
2Y=Q ZNOTCONS +JNOTCONS [%C IS NOT A CONSOLE
2YQB ZCENTRAL +JCENTRAL [PROPERTY NAME'CENTRAL'EXISTS & MAY N
2^=2 [BE CANCELLED
2^PL ZPROPNEED +JPROPNEED [PROPERTY %C STILL BEING USED
2^SQ ...#SKI JSKI04 [FOR COMMAND ISSUERS
2^XW ...ZCIINUSE +CIINUSE [COMMAND ISSUER IN USE
3232 ...#SKI JSKI32 [FOR 15-BIT PROP NOS
3266 ...ZMAXPROP +JMAXPROP [MAX NO OF PROPS DEFINED
326L ...#SKI G3SIGNET
3276 ...(
327L ...ZPMEEP +JPROPMEEP [ERROR IN %B %A : MEEP PROPERTY
3286 ... [%C MUST BE TEMPORARY AND EXCLUSIVE
328L ...)
328N ...#UNS ANSTOOMANY
328Q ...ZPARMAX +JMAXPAR [MAX NO PARAMS EXCEEDED
328T ...#
3294 ...VOP [ S/ROUTINE TO CLEAR 'IDFANDPROP'
329? ... V IDFANDPROP
329G ... EXIT 7 0
329P ...#
329Y ...#
32=7 ...POP [ S/ROUTINE TO GET 'IDFANDPROP'
32=B ... SBX 4 FX1
32=K ... P IDFANDPROP
32=S ... ADX 4 FX1
32?3 ... EXIT 4 0
32?= ...#
32?F ...#
32M4 ...#
32NW # WAY OUT IN CASE OF COMMAND ERROR
338G #
33?5 ...QER1
3455 ... COMERRX 6,5
347Q #
34?M ...QER2
3535 ... CALL 7 VOP [FREE SEMAPHORE
3572 CLOSE
359K ...QER3
363H ... COMERRX 6
366= # LOADING OF REQUIRED ERROR MESSAGE
36KW #
375G PANON
37K6 LDX 1 FX1
384Q LDX 6 ZPARMIS(1)
38JB ... LDX 5 ZPROPNA(1)
3942 BRN QER1
39HL UNPAIR
3=3= LDX 1 FX1
3=GW LDX 6 ZNOTPAIR(1)
3?2G BRN QER3
3?G6 ZCATMOD
3?^Q LDX 1 FX1
3#FB LDX 6 ZILLCOMB(1)
3#^2 BRN QER2
3*DL PRUNK
3*Y= LDX 1 FX1
3BCW LDX 6 ZPROPUNK(1)
3BXG BRN QER2
3CC6 TOOMANY
3CWQ LDX 1 FX1
3DBB LDX 6 ZQUALIFIER(1)
3DW2 BRN QER3
3F*L PFORMAT
3FT= LDX 1 FX1
3G#W LDX 6 ZNLFNF(1)
3GSG BRN QER3
3H#6 XEXISTS
3HRQ LDX 1 FX1
3J?B LDX 6 ZPROPEXISTS(1)
3JR2 BRN QER2
3K=L XCONSABS
3KQ= LDX 1 FX1
3L9W LDX 6 ZCONSABS(1)
3LPG BRN QER2
3M96 PNOTCONS
3MNQ LDN 5 0
3N8B SPARAPAS 5
3NN2 MHUNT 3,CPB,CUNI
3P7L FREECORE 3
3PM= SPARAPAS 5
3Q6W LDX 6 ZNOTCONS(1)
3QLG BRN QER2
3R66 XCENTRAL
3RKQ LDX 1 FX1
3S5B LDX 6 ZCENTRAL(1)
3SK2 BRN QER3
3T4L PROPNEED
3TJ= LDX 6 ZPROPNEED(1)
3W3W BRN QER2
3W54 ...#SKI JSKI04 [CI
3W6= ...(
3W7D ...USECI LDX 1 FX1
3W8L ... LDX 6 ZCIINUSE(1)
3W9S ... BRN QER2
3W?2 ...)
3W#8 ...#SKI JSKI32 [15BIT PROPS
3W*B ...(
3WBJ ...NOROM LDX 1 FX1
3WCQ ... LDX 6 ZMAXPROP(1)
3WDY ... BRN QER2
3WG6 ...)
3WG? ...#SKI G3SIGNET
3WGD ...(
3WGK ...XMEEP LDN 7 1
3WGQ ... SPARANOT 1,7
3WGX ... LDX 6 ZPMEEP(1)
3WH4 ... BRN QER2
3WH9 ...)
3WJM ...#UNS ANSTOOMANY
3WL5 ...(
3WMH ...PARMAX1
3WN^ ... LDX 6 ZPARMAX(1)
3WQC ... BRN QER2
3WRT ...PARMAX2
3WT? ... LDX 6 ZPARMAX(1)
3WWP ... BRN QER3
3WY7 ...)
3W^K ...#
3X36 # THIS SUBROUTINE PASSES ACROSS THE FIRST PARAM.,CHECKS FOR LOCAL NA
3XGQ # CHECKS NAME NOT 'CENTRAL',SETS UP BLOCK TO OPEN :SUS.PROP,OPENS :SYS.P
3Y2B # FREES NAME BLOCK&EXITS.IF :SYS.PROP NOT OPEN OK-GEOERR'PROPFILE'
3YG2 #
3Y^L #
3^F= NAMEX SBX 7 FX1
3^YW SPARAPAS
43CQ PARFD CHEKLFN2 PANON,PFORMAT [CHECK FORMAT
43XB TESTNAMX 2,APARA(3),PCENTRAL(1),NOTCENT,4
44C2 BRN XCENTRAL [THIS IS THE ILLEGAL 'CENTRAL'
44WL NOTCENT
45B= LDX 4 ACES [SPACEFILL BED FOR NAME
45TW STO 4 AWORK1(2)
46*G STO 4 AWORK2(2)
46T6 STO 4 AWORK3(2)
47#Q LDN 0 APARA(3)
47SB LDN 1 AWORK1(2)
48#2 LDEX 2 ANUM(3)
48RL MVCH 0 0(2) [MOVE PROP NAME INTO AWORK WORDS
4?^8 ... CALL 4 POP [SET SEMAPHORE
4B7G OPENSYS SBRKIN,PROPERTY,GENERAL,CAREFUL
4BM6 [OPEN :SYSTEM.PROPERTY
4JGL ADX 7 FX1
4K2= EXIT 7 0
4LF6 SBRKIN
4LYQ COMBRKIN [END COMMAND IF BROKEN-IN
4MY2 #
4NCL #
4NX= #
4PBW # THIS SUBROUTINE GETS RID OF'()'IN PARAM.,SPLITS AT ',',PASSES
4PWG # ACROSS FIRDT QUAL.,TESTS IF LEGAL QUAL.,SETS APPROPRIATE BIT
4QB6 # IN APROPNO.IN APPEND BLOCK,&GOES BACK TO PASS ACROSS NEXT QUAL.
4QTQ # IF SAME QUAL.GIVEN TWICE OR'TEMP'&'PERM'OR'EXCL'&'INCL'GIVEN-ERROR
4R*B #
4RT2 TEST SBX 7 FX1
4S#L LDN 4 2
4SS= PARALYSE ,,4 [GET RID OF ()
4S^D ...#UNS ANSTOOMANY
4T6L ... TESTREP2 TOOMANY,PARMAX1
4T?W PARALYSE #34 [SPLIT CAT/MOD QUALIFIERS
4TL? ...#UNS ANSTOOMANY
4TYN ... TESTREP2 TOOMANY,PARMAX1
4W?6 NGN 4 1 [SET EXCL/INCL SWITCH
4WQQ NGN 6 1 [SET PERM/TEMP SWITCH
4X=B START SPARAPAS
4XQ2 MHUNT 3,CPB,CUNI
4Y9L LDX 5 ANUM(3)
4YP= BZE 5 START [IF NULL TRY AGAIN
4^8W CHEKLFN2 NOPROPMOD,ZCATMOD,3
4^NG LDX 0 APARA(3)
5286 LDN 5 4 [COUNT
52MQ LDN 3 PCATEGORY(1)
537B TRYAGAIN
53M2 TXU 0 0(3) [TEST IF EQUAL
546L BCC XFOUND
54L= ADN 3 1
555W BCT 5 TRYAGAIN
55KG BRN ZCATMOD
5656 XFOUND [BRANCH TO APPROPRIATE LABEL
56JQ SBN 5 2
574B BNG 5 TEMP
57J2 BZE 5 PEXCL
583L SBN 5 2
58H= BNG 5 PINCL
592W BRN PERM
59GG TEMP
5=26 BZE 6 ZCATMOD
5=FQ ADN 6 1 [SET SWITCH 0
5=^B BRN START
5?F2 PEXCL
5?YL BZE 4 ZCATMOD
5#D= ADN 4 1 [SET SWITCH 0
5#XW BRN START
5*CG PINCL
5*G5 ...#SKI G3SIGNET
5*JN ...(
5*M? ... LDX 0 AWORK4(2)
5*PW ... BNZ 0 XMEEP [J. TEMP-EXCL ONLY FOR MEEP
5*SF ...)
5*X6 BZE 4 ZCATMOD
5B6Y ...#SKI JSKI32<1$1
5BBQ MHUNTW 3,FILE,FAPB
5BHY ...#SKI JSKI32
5BP6 ... MHUNTW 3,FILE,FWB
5BWB LDX 5 APROPNO+A1(3)
5CB2 ANDX 5 TWO(1)
5CTL STO 5 APROPNO+A1(3)
5D*= ADN 4 1 [SET SWITCH 0
5DSW BRN START
5F#G PERM
5FC5 ...#SKI G3SIGNET
5FFN ...(
5FJ? ... LDX 0 AWORK4(2)
5FLW ... BNZ 0 XMEEP [J. TEMP-EXCL ONLY FOR MEEP
5FPF ...)
5FS6 BZE 6 ZCATMOD
5G3Y ...#SKI JSKI32<1$1
5G?Q MHUNTW 3,FILE,FAPB
5GDY ...#SKI JSKI32
5GL6 ... MHUNTW 3,FILE,FWB
5GRB LDX 5 APROPNO+A1(3)
5H?2 ORX 5 ONE(1)
5HQL STO 5 APROPNO+A1(3)
5J== ADN 6 1 [SET SWITCH 0
5JPW BRN START
5K9G NOPROPMOD
5KP6 ADX 7 FX1
5L8Q EXIT 7 0
5LNB #
5M82 #
5MML #
5N7= # THIS SUBROUTINE PASSES ACROSS THE CONSOLE PARAM.,OVERWRITES
5NLW # 'CONSOLE ' IN THE BLOCK WITH THE DEVICE DESCRIPTION
5P6G #
5PL6 TESTCONS
5Q5Q SBX 7 FX1
5QKB PARAFREE
5R52 LDN 4 7
5RJL SPARABEG 1,4,PCONS(1),,0 [PUT PARAM STARTING WITH 'CONSOLE'
5S4= MHUNT 3,CPB,CUNI [INTO CPB/CUNI
5SHW LDX 5 ANUM(3)
5T3G BZE 5 T1 [JUMP TO T1 IF NULL PARAM
5TH6 BNG 5 T2 [JUMP TO T2 IF NO PARAM
5W2Q LDX 5 JPARNUM(3)
5WGB PARAMOVE 4,5 [MOVE PERIPH DESC UP TO
5X22 [OVERWRITE 'CONSOLE'
5XFL LDN 5 2
5XPD ...#SKI JSKI04<1$1
5X^= PARSORTX T3,5 [ANALYSE PERIPH DESC
5Y6D ...#SKI JSKI04
5Y?L ... PARSORTX T3,5,SYSPROP [ANALYSE PERIPH DESC
5YDW [JUMP TO T3 IF BREAK-IN
5YX6 ...XCHKJSCE
5YYG HUNTW 3,CPAR,JSCE
5^D6 BNG 3 T3 [JUMP TO T3 IF PARAM NOT VALID
5^XQ ADX 7 FX1
62CB EXIT 7 3 [OK
62X2 T1 ADX 7 FX1
63BL EXIT 7 1 [NULL PARAM
63W= T2 ADX 7 FX1
64*W EXIT 7 2 [NON-EXISTENT PARAM
64TG T3
65*6 ADX 7 FX1
65SQ EXIT 7 0 [INVALID PARAM OR BREAK-IN
66#B #
66S2 #
67?L # THIS SUBROUTINE CANCELS THE ATTRIBUTIONS OF THE PROPERTY
67R= # IN THE APIA.X6 CONTAINS THE TYPE OF PERIPHERAL.
68=W # X5 CONTAINS PROP NUMBER
68QG #
69=6 RECORD
69PQ SBX 7 FX1
6=47 ... FINDPEREC 1,APFOTY,6,R2,,RSWOK [FIND FIRST DEVICE LIST FOR TH
6=BJ ...RSWOK
6=P2 BNG 1 R1 [BRANCH IF NO MORE OF THIS TYPE
6?8L LADDP 1,2 [FIND POS'N IN APIA
6?N= LDN 4 4
6#7W R4
6#MG TXU 5 APERPROP+1(2)
6*76 BCC R3 [BRANCH IF PROP NUMBERS THE SAME
6*LQ ADN 2 1
6B6B BCT 4 R4
6BL2 BRN R2 [FIND NEXT DEVICE LIST
6C5L R3
6CK= SBN 4 1
6D4W BZE 4 R23 [BRANCH IF LAST ATTRIBUTION
6DJG R20 LDX 0 APERPROP+2(2) [
6F46 BZE 0 R23 [MOVE UP REMAINING ATTRIBUTIONS
6FHQ STO 0 APERPROP+1(2) [TO O'WRITE UNWANTED ENTRY
6G3B ADN 2 1 [
6GH2 BCT 4 R20
6H2L R23 STOZ APERPROP+1(2) [ZEROISE LAST ENTRY
6HG= BRN R2 [FIND NEXT DEVICE LIST
6H^W R1
6JFG ADX 7 FX1
6JP# ... LDX 1 FX1
6J^6 EXIT 7 0
6KDQ #
6KYB # THIS SUBROUTINE CANCELS THE ASSOCIATIONS OF THE PROPERTY
6LD2 # IN THE DEVICE LIST.
6LXL # [THE CODE IS AS FOR S/R RECORD EXCEPT THAT
6MC= # THE ENTRIES FOR ASSOCIATIONS ARE 2 WORDS LONG]
6MWW #
6NBG RECORD2
6NW6 SBX 7 FX1
6P8H ... FINDPEREC 1,APFOTY,6,R6,,RSWOK2
6PGY ...RSWOK2
6PTB BNG 1 R5
6Q*2 LADDP 1,2
6QSL LDN 4 3
6R#= R8
6RRW TXU 5 APERPROP+1(2)
6S?G BCC R7
6SR6 ADN 2 2
6T=Q BCT 4 R8
6TQB BRN R6
6W=2 R7
6WPL SBN 4 1
6X9= BZE 4 R53
6XNW R50 LDX 0 APERPROP+3(2)
6Y8G BZE 0 R53
6YN6 STO 0 APERPROP+1(2)
6^7Q LDX 0 APERPROP+2(2)
6^MB STO 0 APERPROP(2)
7272 ADN 2 2
72LL BCT 4 R50
736= R53 STOZ APERPROP(2)
73KW STOZ APERPROP+1(2)
745G BRN R6
74K6 R5
754Q ADX 7 FX1
75JB EXIT 7 0
7642 #
76HL #
773= # # # #
77GW # # # #
782G # # # #
78G6 # ## #
78^Q # # # #
79FB # # # #
79^2 # # # #
7=DL #
7=Y= #
7?CW # ENTRY POINT FOR PROPERTY COMMAND
7?XG # FIRST SPLIT PARAM INTO NAME & QUALS(IF ANY),IF MORE THAN 2 COMPONENTS
7#C6 # PARAM-ERROR,CALLS'NAMEX',STEPS DOWN :SYS.PROP COMPARING EXISTINGNAMES
7#WQ ...# TO NEW ONE.IF NAME EXISTS-BRANCH,SET UP WRITE BLOCK,MOVE NAME,
7*BB ...# STORE FRH,GET LOWEST UNUSED PROP.NO.&SET DEFAULT TEMP/EXCL BITS& STORE
7*W2 ...# WRITE BLOCK,ZEROIZE COUNT OF ATTRIBUTIONS & 'CONSOLE'PROP. WORD
7B*L # IF ANY QUALS.-CALL 'TEST',FREE ALL CMULTI BLOCKS,PICK UP'CONSOLE'PARAM
7BT= # (IF DOES NOT EXIST-BRANCH),OVER WRITE CH'S'CONSOLE',SPLIT PARAM. AT'.'
7C#W # 0 APROPGROUP TO SHOW'CONSOLE'PROP.,SET PERM.BIT ,PASS INF TO I.D.F.APP
7CSG # TO :SYS.PROP.,CLOSE :SYS.PROP,END.
7D#6 # IF PROP NAME ALREADY EXISTED IN :SYS.PROP &WAS'CONSOLE PROP.-FREE
7DRQ # CMULTI BLOCKS,PICK UP 'CONSOLE'PARAM(IF NONE-ERROR),OVER WRITE CH'S
7F?B # 'CONSOLE',SPLIT PARAM AT'.',PASS INF TO I.D.F.,CLOSE ESYSPROP,
7FR2 # END.
7G=L #
7GQ= #
7H9W PROPERTYK1
7HPG PARALYSE
7HSL ...#UNS ANSTOOMANY
7HXQ ... TESTREP2 UNPAIR,UNPAIR,TOOMANY,PARMAX2
7J2W ...#UNS ANSTOOMANY
7J62 ...#SKI
7J96 TESTREP UNPAIR,UNPAIR [IF DELIMITERS UNPAIRED-ERROR
7JNQ LDN 5 1
7K8B PARANUMB 6,5
7KN2 SBN 6 3
7L7L BPZ 6 TOOMANY [COMERR IF MORE THAN 1 SET
7LM= [OF QUALIFIERS
7M6W CALL 7 NAMEX [VALIDATE PROPNAME AND OPEN SYSPROP
7M7C ...#SKI G3SIGNET
7M7Y ...(
7M88 ... JENVNOT NAMOK,MEEP [J. IF NOT MEEP ENVIRONMENT.
7M8F ... LDX 1 FX1
7M92 ... LDCH 0 AWORK1(2)
7M9H ... BXU 0 PLPL(1),NAMOK [J. 1ST CHAR NOT 'L'
7M=4 ... BCHX 2 £
7M=K ... LDCH 0 AWORK1(2)
7M?6 ... BXU 0 PLPP(1),NAMOK [J. 2ND CHAR. NOT 'P'
7M?M ... LDN 4 2
7M#8 ...NAM BCHX 2 £
7M#P ... LDCH 0 AWORK1(2)
7M*= ... BXL 0 TEN(1),NAMB [J. CHAR IN RANGE 0-9
7M*R ... BXL 0 PLPA(1),NAMOK [J. CHAR NOT IN RANGE A-F F
7MBT ...NAMB BCT 4 NAM
7MCB ... LDX 2 FX2
7MCX ... LDX 4 AWORK2(2)
7MDD ... BXU 4 ACES,NAMOK
7MD^ ... LDX 4 AWORK3(2)
7MFG ... BXU 4 ACES,NAMOK
7MG3 ... LDX 4 BIT9
7MGJ ... STO 4 AWORK4(2)
7MH5 ... BRN NAMOK1
7MHL ...NAMOK LDX 2 FX2
7MJ7 ... STOZ AWORK4(2)
7MJN ...NAMOK1
7MK9 ...)
7MLG #
7N66 STEP1 STEP
7NKQ BZE 3 NOPROP [PROPERTY UNKNOWN
7P5B TESTNAMX 3,APROPNAME(3),AWORK1(2),STEP1,4
7PK2 BRN XCHANGE [JUMP IF PROP EXISTS
7Q4L #
7QJ= NOPROP
7QN7 ...#
7QS4 ...#SKI JSKI32<1$1
7QX^ ...(
7R3W SETNCORE 7,3,FILE,FAPB [SETUP APPEND BLOCK
7RHG LDN 4 AWORK1(2)
7S36 LDN 5 APROPNAME+A1(3)
7SGQ MOVE 4 3 [MOVE PROP NAME-> APPEND BLOCK
7T2B LDN 0 7
7TG2 STO 0 A1+FRH(3) [PUT HEADER IN APPEND BLOCK
7T^L LDX 4 APROPWORD [GET CURRENT NUMBER
7WF= ADN 4 1 [UPDATE BY 1
7WYW STO 4 APROPWORD [UPDATE APROPWORD BY 1
7XDG ORX 4 TEMEX(1) [SET DEFAULT TEMP & EXCL BITS
7XY6 ANDX 4 ONEBIT(1)
7Y5# ...#SKI G3SIGNET
7Y=G ... ORX 4 AWORK4(2) [BIT 9 TO BE SET IF MEEP
7YCQ STO 4 APROPNO+A1(3) [STORE IN APPEND BLOCK
7YXB LDN 5 0
7^C2 STO 5 ATTCOUNT+A1(3)
7^WL STO 5 APROPGROUP+A1(3)
826D ...)
82B= #
82BP ...#SKI JSKI32
82C8 ...(
82CM ...#
82D6 ...# NOW FIND PLACE TO INSERT NEW RECORDS: PROP NUMBERS ARE IN
82DK ...# ASCENDING ORDER - WE CHOOSE THE LOWEST FREE ONE
82F4 ...#
82FH ... REWIND
82FJ ...#SKI G3SIGNET
82FK ...(
82FL ... LDX 7 BIT9
82FM ... ANDX 7 AWORK4(2)
82FN ... BZE 7 SFIND [J NOT A MEEP PR. NO REQUIRED
82FP ...NEXTM
82FQ ... STEP [POSITION ON IST MEEP PR NO.
82FR ... BZE 3 SPACE [NO MEEP EXIST IN SYSPROP:INSERT MEEP
82FS ... LDX 0 APROPNO(3)
82FT ... SLL 0 9 [ SHIFT TO SEE IF BIT 9 SET -MEEP
82FW ... BNG 0 TFREE [FIRST MEEP PROP FOUND :FD LOWEST FRE
82FX ... BRN NEXTM
82FY ...SFIND
82F^ ...)
82G2 ... LDN 7 1
82GF ...NEXT STEP
82GY ... BZE 3 SPACE [J IF NO GAPS FOUND
82H5 ...#SKI G3SIGNET
82H= ...TFREE
82HC ... LDX 0 APROPNO(3) [PROPERTY NUMBER
82HW ... ANDX 0 BSP16
82J* ... TXL 7 0
82JS ... BCS SPACE [J IF LOWEST UNUSED FOUND
82K? ... LDX 7 0
82KQ ... ADN 7 1
82L9 ... TXL 7 BSP16
82LN ... BCC NOROM [NO ROOM AT THE INN
82M7 ... BRN NEXT
82ML ...#
82N5 ...SPACE SETNCORE 7,3,FILE,FWB [FOR NEW RECORD
82NJ ... LDN 0 7
82P3 ... STO 0 A1+FRH(3)
82PG ... ORX 7 TEMEX(1) [SET DEFAULT TEMP,EXCL BITS
82P^ ... ANDX 7 ONEBIT(1)
82QD ... STO 7 APROPNO+A1(3)
82QX ... STOZ ATTCOUNT+A1(3) [NO AU OR AE (NATURLICH)
82RB ... LDN 4 AWORK1(2)
82RT ... LDN 5 APROPNAME+A1(3)
82S# ... MOVE 4 3 [PROPERTY NAME
82SR ... STOZ APROPGROUP+A1(3)
82T= ...)
82TW LDN 5 1
83*G PARANUMB 4,5
83T6 SBN 4 2
84#Q BNG 4 XCONSPROP [JUMP IF NO QUALIFIERS
84SB XQUALS
85#2 CALL 7 TEST
85RL #
86?= XCONSPROP
86QW CALL 7 TESTCONS [TEST IF CONSOLE PROP
87=G BRN PEND [PARAM NOT VALID
87Q6 BRN XCONSABS [CONSOLE PARAM NULL
889Q BRN PAPPEND [JUMP IF NOT CONSOLE PROP
88PB [
8992 [ROUTINE FOR NEW CONSOLE PROPERTY
89NL [
8=8=
8=D4 ...#SKI JSKI32<1$1
8=MW MHUNTW 3,FILE,FAPB
8=T4 ...#SKI JSKI32
8?2= ... MHUNTW 3,FILE,FWB
8?7G LDX 5 TEMEX(1)
8?M6 ORS 5 APROPGROUP+A1(3) [SET CONSOLE BIT
8#6Q #
8#LB LDX 5 APROPNO+A1(3)
8*62 ORX 5 PERMBIT(1) [CONSPROP ALWAYS PERM
8*KL STO 5 APROPNO+A1(3) [STORE PROP NO. IN APPEND BLOCK
8BCL ... PUTCONS XBRK,5,PEND,PNOTCONS [PUT PROP IN IDF
8BJW #
8C4G PAPPEND
8C## ...#SKI JSKI32<1$1
8CJ6 APPEND [APPEN BLOCK TO SYSPROP
8CP# ...#SKI JSKI32
8CWG ... INSERT
8D3Q [CLOSE & END
8D88 ...PEND CALL 7 VOP [FREE SEMAPHORE
8F32 CLOSE
8F4C ...XENDC
8FGL ENDCOM
8G2= #
8GFW XCHANGE
8G^G LDX 5 APROPGROUP(3)
8HF6 BPZ 5 XEXISTS [IF NOT CONS PROP ERROR
8HYQ [
8JDB [ROUTINE FOR EXISTENT CONSOLE PROP
8JY2 [
8KCL LDX 6 APROPNO(3)
8KX= CALL 7 TESTCONS
8LBW BRN PEND [INVALID PARAM
8LWG BRN XCONSABS [NULL PARAM
8MB6 BRN XCONSABS [NO CONSOLE PARAM
8N86 ... PUTCONS XBRK,6,PEND,PNOTCONS [PUT PROP IN IDF
8N*B BRN PEND
8NT2 #
8P#L #
8PS= # # # ###
8Q?W # # # # #
8QRG # # # #
8R?6 # ## #
8RQQ # # # #
8S=B # # # #
8SQ2 # # # #####
8T9L #
8TP= #
8W8W # ENTRY POINT FOR CANCEL PROPERTY COMMAND
8WNG # CALLS'NAMEX',CHECKS PROPERTY IN :SYS.PROP.,IF 'CONSOLE PROPERTY-BRANCH
8X86 # FOR EACH PERIPH,REMOVE ATTRIBUTIONS AND ASSOCIATIONS
8XMQ # OF THE PROPERTY FROM APIA.
8Y7B # UNSET BITS0&1 OF PROP.NO.,CANCEL PROPERTY IN I.D.F.,DELETE RECORD IN
8YM2 # :SYS.PROP.,OUT PUT 'PROPERTY CANCELLED'MESSAGE,CLOSE :SYS.PROP.,END
8^6L # IF 'CONSOLE'PROPERTY-UNSET B1&SETBIT0 OF PROP.NO.,CANCEL PROPERTY
8^L= # IN I.D.F.,DELETE RECORD IN :SYS.PROP.,OUT PUT 'PROPERTY CANCELLED'
925W # MESSAGE,CLOSE :SYS.PROP.,END
92KG #
9356 PROPERTYK2
93JQ CALL 7 NAMEX [VALIDATE NAME AND OPEN SYSPROP
944B STEP2
94J2 STEP
953L BZE 3 OUT2
95H= TESTNAMX 3,APROPNAME(3),AWORK1(2),STEP2,4
962W OUT2
96GG BZE 3 PRUNK [ERROR IF UNKNOWN
9726 LDCT 0 8 [UNSET BIT 5 TO TELL CANCEL THAT
97FQ ERS 0 EXT+11(2) [PARAMETER WAS OK
97^B LDX 5 APROPNO(3)
98F2 LDX 6 APROPGROUP(3)
98YL PROPUSE 5,PROPNEED [CHECK IF PROPERTY IS NEEDED
99D= STO 6 AWORK1(2)
99XW ...#SKI JSKI04 [FOR COMMAND ISSUERS
9=CG ...(
=3#B LDX 1 FX1
=3S2 ANDX 5 TWOBITS(1) [UNSET BIT0 & BIT1
=4?L LDX 6 AWORK1(2)
=4R= BPZ 6 XNIDF [IF NOT CONS PROP BRANCH
=5=W ORX 5 TEMEX(1) [SET BIT 0
=5QG XNIDF
=672 ... PROPCANC XBRK,5,USECI,STPCI
=6HG ... STOZ 7 [SET MARKER "NOT CI"
=6Y2 ... BRN NOTCI
=7#G ...STPCI LDN 7 1 [SET MARKER "CI"
=7P2 MHUNT 3,CPB,CUNI
=88L LDX 4 ANUM(3)
=8N= ANDN 4 #7777
=97W OUTPARAM 4,APARA,CPB,CUNI
=984 ... INFORM 1,JCIGONE,1
=98= ...)
=98? ...NOTCI
=98# ...[
=98* ...[ ENTRY POINT FOR PROPCANC IN M/C B
=98B ...[
=98C ...XK8
=98D ...[
=98F ... BNG 6 PAPIA [JUMP IF CONSOLE PROP.
=98L ...[
=98S ...[CANCEL ALL ATTRIBUTIONS OF PROP FROM APIA
=992 ...[
=998 ...
=99B ... LDX 6 PTAPE(1)
=99J ... [FIND THE NEXT TP DEVICE LIST-
=99Q ... CALL 7 RECORD
=9=6 ... LDX 6 PCARDS(1)
=9=# ... [FIND THE NEXT CP DEVICE LIST-
=9=G ... CALL 7 RECORD
=9=W ... LDX 6 PRINTER(1)
=9?4 ... [FIND THE NEXT LP DEVICE LIST-
=9?= ... CALL 7 RECORD
=9?L ... LDX 6 PDRUM1(1)
=9?S ... [FIND THE NEXT DR DEVICE LIST
=9#2 ... CALL 7 RECORD
=9#B ... LDX 6 PDRUM2(1)
=9#J ... [FIND THE NEXT HS DR DEVICE LIST
=9#Q ... CALL 7 RECORD
=9*6 ... LDX 6 PIPC(1)
=9*# ... [FIND THE NEXT IPC DEVICE LIST
=9*G ... CALL 7 RECORD
=9*N ...XAECAN
=9*W ... LDX 2 FX2
=9B4 ... LDX 1 FX1
=9B= ... LDX 6 AWORK1(2)
=9BD ... BZE 6 PNCONS
=9BL ... ORX 5 TEMEX(1)
=9BS ... BRN PAPIA
=9C2 ...PNCONS
=9C8 ... ANDX 5 TWO(1)
=9CB ...PAPIA
=9CJ ...[
=9CQ ...[CANCEL ALL ASSOCIATIONS OF PROP FROM APIA
=9CY ...[
=9D6 ... LDX 6 PTREADER(1)
=9D# ... [FIND TR DEVICE LIST
=9DG ... CALL 7 RECORD2
=9DN ... LDX 1 FX1
=9DW ... LDX 6 PCREADER(1)
=9F4 ... [FIND CR DEVICE LIST
=9F= ... CALL 7 RECORD2
=9FD ... LDX 2 FX2
=9FL ...#
=9FS ...#
=9G2 ...#SKI JSKI04<1$1
=9G8 ...(
=9GB ...XIDFCAN
=9GJ ... LDX 1 FX1
=9GQ ... ANDX 5 TWOBITS(1) [UNSET BIT0 & BIT1
=9GY ... LDX 6 AWORK1(2)
=9H6 ... BPZ 6 XNIDF [IF NOT CONS PROP BRANCH
=9H# ... ORX 5 TEMEX(1) [SET BIT 0
=9HG ...XNIDF
=9J= ... PROPCANC XBRK,5
=9JP ...)
=9JQ ... DELETE [DELETE RECORD OF PROPERTY FROM SYSPR
=9JS ... [OUTPUT 'PROPERTY CANCELLED'MESSAGE
=9K2 ... MHUNT 3,CPB,CUNI
=9K8 ... LDX 4 ANUM(3)
=9KB ... ANDN 4 #7777
=9KJ ... OUTPARAM 4,APARA,CPB,CUNI
=9MG INFORM 1,JPRCANOK,1
==76 BRN PEND
==LQ #
==^7 ...XBRK GEOERR 1,CCPRBKIN
=??J ...#
=?L2 #END
^^^^ ...70052073000100000000