PROPERTY867
(George Source)
Macros used: APPEND, BXGE, BXL, BXU, CHEKLFN2, CLOSE, COMBRKIN, COMERRX, DELETE, ENDCOM, FINDPEREC, FREECORE, FSHENTRY, GEOERR, HUNTW, INFORM, INSERT, JENVNOT, LADDP, MHUNT, MHUNTW, NAMEX, OPENSYS, OUTPARAM, P, PARAFREE, PARALYSE, PARAMOVE, PARANUMB, PARSORTX, POP, PROPCANC, PROPERTY, PROPUSE, PUTCONS, REWIND, SEGENTRY, SETNCORE, SPARABEG, SPARANOT, SPARAPAS, STEP, TEST, TESTNAMX, TESTREP, TESTREP2, V, VOP
- PROPERTY867.txt
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 <A 7MB# ... BXGE 0 PLPF(1),NAMOK [J. CHAR OUT OF RAOGE > 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