SPERION867
(George Source)
Macros used: ACROSS, BACKTRAN, BADBLOCK, CAPCA, CHAIN, CHECKB, CHTRAN, CONVERTX, EXMESS, FADDRESS, FOUTMOVE, FREECORE, GEOERR, GETWORD, HUNTW, ILLEGALX, JENVNOT, JNENVX, KEEPMESS, LOCK, LPROP, MENDAREA, MFINDEXOF, MFINDSU, OLPFIN1, OUTPACK, PAIR, PMODES, PROGBRKIN, RELSTX, RUNPROG, SEG, SEGENTRY, SETNCORE, SMUSEST, STEPBACK, SUSESTX, TESTREP, TOPCA1, TRACE, UNPLUG, WORDFIN
- SPERION867.txt
22FL ... SEG SPERION,860,FRANK BLUNDELL,SPERION 22T* ...# 2394 ...# COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982 23JR ...# 23YG # 24D6 # THIS SEGMENT DEALS WITH TRUSTED MODE 4,5 AND 6 24XQ # 25CB SEGENTRY K1SPERION,QK1SPERION 25X2 # 26BL # MONITORING FILE MESSAGE IDENTIFIERS 26W= # 27*W ZRR1 +JYINVAL 27TG ZRR2 +JYMODE [MODE IN ERROR 28*6 ZRR3 +JYNOBUF [BUFFER OUT OF RESERVATIONS 28SQ ZRR4 +JYCOUNT [COUNT OUT OF RANGE 29#B ...RFAIL +EWOWNS [BLOCK N FAIL 2=?L PERF +JYPERFAIL [ONLINE %A FAIL 2=R= # 2?=W # LOCAL DEFINES 2#=6 #DEF TAC1=EWORK6 2*P2 #DEF TAC2=TAC1+1 2B8L #DEF TAC3=TAC2+1 2BN= #DEF TAC4=TAC3+1 2C7W #DEF TAC5=TAC4+1 2CMG #DEF TAC6=TAC5+1 2DLQ #DEF TAC7=ACOMMUNE7 2G5L #DEF TAC8=TAC7+1 2GK= #DEF TAC9=TAC8+1 2H4W #DEF XCA=EVENT2 2HJG #DEF TREP=EXEC3 [BSTS REPLY 2J46 #DEF PB=BSET+BOBJ+BONL 2JHQ # 2K3B # CONSTANTS 2KH2 # 2L2L ZA PAIR PERION,1 2LG= TEN +10 2L^W RMASK #100000 2MFG SESS +CHREAD 2M^6 # 2NDQ # DEVICE SUBTYPES 2NYB # 2PD2 PEDS +EDS 2PXL PEMDS +EMDS 2QC= PAFDS +AFDS 2QWW PBFDS +BFDS 2RBG # 2RW6 # GEOERRS 2S*Q # 2STB RZR GEOERR 1,EWMESS [NO EWDAS/EWMESS 2T*2 RERR GEOERR 1,RESVIOLA [RESERVATION VIOLATION 2TSL # 2W#= QK1SPERION 2WRW #SKI K6SPERION>99-99 2X?G TRACE 6,SPERION 2XR6 LDX 0 6 [MODE 2Y=Q ANDN 0 7 2YQB STO 0 AWORK3(2) 2^=2 LDX 0 6 2^PL SRL 0 9 329= ANDN 0 #30 32NW STO 0 AWORK1(2) [ADDITIVE MODE 338G ANDN 6 7 [X6 CONTAINS BASIC MODE 33N6 LDX 4 XCA(2) [CONTROL ADDRESS 347Q STO 4 TAC6(2) 34MB LDN 7 5 [LENGTH OF CONTROL AREA 3572 LDX 3 APETADDR(2) 35LL LDN 5 TAC1(2) 36KW FOUTMOVE 3,4,5,7,HLOCK1,2 [MOVE CA TO ACOMMUNE1-5 384Q #SKI K6SPERION>199-199 38JB ( 3942 TRACE TAC1(2),SPERICA1 39HL TRACE TAC2(2), 3=3= TRACE TAC3(2), 3=GW TRACE TAC4(2), 3?2G TRACE TAC5(2), 3?G6 ) 3?^Q STOZ AWORK4(2) [ZEROISE FOR REPLY 3#FB LDX 7 TAC5(2) [LBN 3#^2 BZE 7 RONGLBN [OUT OF RANGE IF ZERO 3*DL BNG 7 RONGLBN [OR NEGATIVE 3*Y= MFINDEXOF 3,EXNUM(2) [GET POINTER TO EXOF IN X3 3BCW LDN 1 FDCELLS(3) 3BXG SBN 1 7 3CC6 LDEX 6 FIP+5(3) [NO OF FILE AREAS 3CWQ NEXT BZE 6 RONGLBN 3DBB SBN 6 1 [REDUCE COUNT OF AREAS 3DW2 ADN 1 6 [NEXT CELL 3F*L TXL 7 6(1) 3FT= BCC NEXT [J NOT IN THIS CELL 3G#W SBX 7 0(1) [LBN RELATIVE TO START OF CELL 3GSG LDX 4 FIP+8(3) 3H#6 ANDN 4 #77 [BUCKET SIZE 3HRQ MPY 7 4 [NO OF BLOCKS IN X0 3J?B DVD 7 5(1) [CYL X0 BLOCK X7 3JR2 ADX 0 2(1) [ADD STCYL RELATIVE TO SU 3K=L STO 0 EWORK1(2) 3KQ= LDX 6 5(1) [BLOCKS/SEEK AREA 3L9W SBX 6 7 [X6=MAX NO. OF BLOCKS TO TRANSFER 3LPG #SKI K6SPERION>199-199 3M96 TRACE 6,MAX BLKS 3MNQ ADX 7 3(1) [ST. SEG 3N8B STO 7 EWORK2(2) 3NN2 LDX 0 1(1) [SERIAL NO. 3P7L STO 0 EWORK3(2) [AND STORE 3R66 ... SUSESTX 1(1),NOTON [SEE IF SU ONLINE 3RKQ LDX 0 ABSUN(1) [BSUN FROM ASTUC 3S5B LDX 2 FX2 3SK2 STO 0 TAC2(2) 3T4L LDX 0 ASUBASE(1) [ST CYL OF SU 3TJ= STO 0 EWORK5(2) 3W3W ADX 0 EWORK1(2) 3WHG LDX 4 0 3WJX ...[ 3WL# ...[ EMULATION CHANGE: 3WMP ...[ STORE CYL*BLOCKS PER CYL+BLOCK IN EWORK2 INTO X4 3WP6 ...[ CONVERTX THEN RETURNS WITH B0 OF BLOCK SET FOR EMULATION 3WQH ...[ 3WRY ... JENVNOT NEMU,MEEP [J IF NOT MEEP EMULATION 3WT* ... LDX 5 EWORK2(2) [GET BLOCK PART 3WWQ ... MPA 4 HBLOCK(1) [CALCULATE ABSOLUTE BLOCK ADDRESS 3WY7 ... STO 5 4 [FOR CONVERTX MACRO 3W^J ...NEMU 3X36 LDX 5 HTYPE(1) [SUBTYPE AND TYPE FROM ASTUC 3XGQ STO 5 EWORK4(2) 3Y2B ANDN 5 #77 [ISOLATE SUBTYPE 3YG2 CONVERTX 4,EWORK2(2),EWORK4(2) [GET HARDWARE ADDRESS 3Y^L LDX 1 FX1 3^F= LDX 2 FX2 3^YW STO 0 TAC5(2) 42DG LDX 4 AWORK3(2) [MODE 42Y6 SBN 4 6 43CQ BNZ 4 NSIX [J IF NOT MODE 6 43XB TXU 5 PAFDS(1) 44C2 BCC RX9A [J IF 2A 44WL TXU 5 PBFDS(1) 45B= BCS RX9 [J IF NOT 2B FDS 45TW RX9A LDX 7 ZRR2(1) [MODE IN ERROR 46*G BRN RX6 46T6 RX9 TXU 5 PEMDS(1) 472^ ... BCS PAB [J IF NOT EMDS 478S ... MFINDSU 1,EWORK3(2) [GET ASTUC - CSN IN EWORK3 47BM ... LPROP HUNIT(1),0 [PROPERTIES IN X0 47JG ... ANDN 0 #100 [ISOLATE BIT 11 OF K52+1 47Q* ... LDX 1 FX1 47Y8 ... BNZ 0 PAB [INTEGRATED EDS30-60 BIT SET 4863 ... LDN 0 1 [ELSE COUNT OF 1 FOR MODE 6 48*9 ... STO 0 TAC3(2) 48JC ... BRN RX10A 48RL PAB LDX 0 TAC3(2) 49?= BZE 0 RONGLEN [ZERO LENGTH ILLEGAL FOR EDS8 MODE #6 49QW ... BNG 0 RONGLEN [ ALSO ILLEGAL IF -VE 4==G ... SBX 0 BIT11 [ BIT11 = 4096 4=Q6 ... BPZ 0 RONGLEN [ ILLEGAL IF > 4095 4#NL RX10A STOZ TAC4(2) [ZERO CORE ADDRESS 4*8= LDN 0 6 4*MW STO 0 TAC1(2) [MODE FOR BSTS 4B7G BRN RX8 [TO BACKTRAN 4BM6 NSIX LDX 0 TAC3(2) [LENGTH 4C6Q TXL 0 RMASK(1) 4CLB BCC RONGLEN [ILLEGAL LENGTH IF >#77777 OR -VE 4D62 ADN 4 1 4DKL BZE 4 PHIVE [J IF MODE 5 4F5= LDX 7 TAC3(2) [COUNT FOR CHECKA 4FJW BRN NOT5 4G4G PHIVE LDN 7 1 [CHECK 1 WD ONLY FOR MODE 5 4GJ6 NOT5 LDX 3 APETADDR(2) 4H3Q LDX 1 ANM(3) [MEMBER NO. 4HHB ANDN 1 #3 4J32 PMODES 1,3 4JGL ANDN 1 #10 4K2= BNZ 1 NP [22 BIT ADDRESSING 4KFW LDX 0 BSP16 [15 BIT ADDRESSING 4K^G BRN NP1 4LF6 NP LDX 0 BITS22LS 4LYQ NP1 ANDS 0 TAC4(2) 4M58 ...#SKI G4 [RELEASE SU IN G4 IN CASE QUOTA 4M9L ...( 4MB4 ... RELSTX EWORK3(2),NP8A [NEEDS TO BE INCREASED 4MGG ...NP8A LDX 2 FX2 4MLY ...) 4MRB ... LDX 1 FX1 4MY2 LDX 3 SESS(1) [READ ACCESS TO OBJ PROG 4N8G ... CHECKB TAC4(2),7,OUT,APETADDR(2),3,NP8,HLOCK2,,PERION 4NF2 ...#SKI G4 [GET SU BACK ONLINE IN G4 4NPG ...( 4P22 ...NP8 SUSESTX EWORK3(2),NOTON 4P=G ... LDX 1 FX1 4PH2 ... LDX 2 FX2 4PRG ...) 4Q42 ...#SKI G3 4Q#G ...NP8 4QK2 ... BNZ 4 RX1 [J NOT MODE 5 4QTQ TXL 6 TAC3(2) [MAX LENGTH NOT EXCEEDED 4R*B BCC RX11 4RT2 LDX 0 TAC3(2) 4S#L SBX 0 6 4SS= STO 0 AWORK4(2) [DIFFERENCE TO REPLY WD 4T?W STO 6 TAC3(2) [MAX LENGTH ALLOWED 4TRG LDCT 0 #200 4W?6 ORS 0 AWORK4(2) [END OF CYLINDER REPLY 4WQQ RX11 TXU 5 PEMDS(1) 4X=B BCS RX12 [NOT EMDS 4XQ2 STOZ TAC4(2) [ZERO CORE ADDRESS 4Y9L LDN 0 5 [MODE 4YP= STO 0 TAC1(2) [FOR BACKTRAN 4^8W BRN RX8 [J TO BACKTRAN 4^NG RX1 TXU 5 PAFDS(1) 5286 BCC RX2 52MQ TXU 5 PBFDS(1) 537B BCS RX3 [J NOT 2B 53M2 SLL 6 1 [MAX BLOCK *2 546L RX2 TXL 6 TAC3(2) 54L= BCC RX3 [J NOT OVER MAX 555W LDX 0 TAC3(2) 55KG SBX 0 6 5656 STO 0 AWORK4(2) [BLOCKS NOT TO BE DEALT WITH TO REPLY 56JQ STO 6 TAC3(2) [MAX LENGTH ALLOWED 574B LDCT 0 #10 57J2 ORS 0 AWORK4(2) 583L RX3 TXU 5 PEMDS(1) 58H= BCS RX4 [J NOT EMDS 592W LDX 0 TAC5(2) 59GG ANDN 0 #7777 5=26 BZE 0 RX5 [ERROR IF BOTTOM 12 BITS NON-ZERO 5=FQ RX7 LDX 7 ZRR1(1) 5=^B BRN RX6 5?F2 RX4 TXU 5 PEDS(1) 5?YL BCS RX5 [J NOT EDS 5#D= LDX 0 TAC5(2) 5#XW ANDN 0 #77 5*CG BNZ 0 RX7 [MAKE SURE BOTTOM 6 BITS ARE ZERO 5*X6 RX5 LDN 0 7 5BBQ STO 0 TAC1(2) [MODE FOR BSTS 5BH8 ... LDX 0 AWORK1(2) [GET ADDITIVE MODES IF ANY 5BML ... ANDN 0 #30 [SEE IF #20000 OR#30000 REQUIRED 5BS4 ... SLL 0 9 [ADD MODE OR ZERO IN X0 5BYG ... STO 0 4 [RETAIN FOR BACKTRAN 5C4Y ... BACKTRAN TAC1(2),PB,TAC3(2),,TAC2(2),TAC5(2),TAC4(2),APETADDR(2),- 5C9B ... EX4 5CB2 BRN RX13 5CH8 ...RX8 LDX 0 AWORK1(2) [ADDITIVE MODE SEQUENCE ... 5CNB ... ANDN 0 #30 [ ... AS ABOVE 5CTJ ... SLL 0 9 5D2Q ... STO 0 4 5D7Y ... BACKTRAN TAC1(2),BONL+BSET,TAC3(2),,TAC2(2),TAC5(2),TAC4(2),,EX4 5D*= RX13 LDX 0 TREP(2) [BSTS REPLY 5DSW STO 0 AWORK2(2) [REMEMBER 5F#G CHTRAN EWORK4(2),TFAIL,TFAIL [CHECK REPLY 5H?2 ...RX14 RELSTX EWORK3(2),RX14B [RELEASE UNIT 5HQL BRN RX14A 5J== RX14B LDX 2 FX2 5JPW RX14A LDX 3 APETADDR(2) [PCA ADDRESS 5K9G LDX 1 TAC6(2) [CA ADDRESS 5KP6 ADN 1 1 [REPLY WORD 5L8Q FADDRESS 3,1,HLOCK1 [GEORGE ADDRESS OF REPLY 5LNB LDX 0 AWORK4(2) [ACTUAL REPLY 5M82 STO 0 0(1) [TO PROG 5MML LDX 1 FX1 5N7= OLPFIN1 ZA(1) [TERMINATE 5NLW # 5P6G # CHECK READ-NOT EMDS. MODE 5 NOT AVAILABLE ON DEVICES OTHER THAN 5PL6 # EMDS SO SET UP BUFFER AND DO ORDINARY READ. 5Q5Q # 5QKB RX12 SETNCORE 128,3,EWDAS,FBUF [SET UP BUFFER 5R52 LDX 6 TAC3(2) [COUNT 5RJL STOZ TAC1(2) [MODE TO READ 5S4= LDN 0 128 5SHW STO 0 TAC3(2) [COUNT FOR BSTS 5T3G LDN 0 A1(3) [CORE ADDRESS 5TH6 STO 0 TAC4(2) [FOR BSTS 5W2Q LOCK 3 [LOCK DOWN BUFFER 5WGB LDX 4 EWORK1(2) 5X22 ADX 4 EWORK5(2) [CYL 5X3C ...[ 5X4S ...[ EMULATION CHANGE: 5X69 ...[ STORE CYL*BLOCKS PER CYL+BLOCK PART IN EWORK2 INTO X4 5X7L ...[ CONVERTX THEN RETURNS IN X0 THE ABSOLUT BLOCK ADDRESS WITH B 5X93 ...[ 5X=D ... JENVNOT RX13A,MEEP [J IF NOT MEEP EMULATION 5X?T ... MFINDSU 3,EWORK3(2) 5X*= ... LDX 5 EWORK2(2) [GET BLOCK PART OF ADDRESS 5XBM ... MPA 4 HBLOCK(3) [CALCULATE ABSOLUTE BLOCKADDRESS 5XD4 ... STO 5 4 [FOR CONVERTX MACRO 5XFL RX13A CONVERTX 4,EWORK2(2),EWORK4(2) [CONVERT TO HARDWARE BS ADDRESS 5X^= LDX 2 FX2 5YDW STO 0 TAC5(2) [FOR BSTS 5YL4 ... LDX 0 AWORK1(2) [ADDITIVE MODE SEQUENCE ... 5YR= ... ANDN 0 #30 [ ... AS FOR PREVIOUS BACKTRANS 5YYD ... SLL 0 9 5^5M ... LDX 7 0 5^=W ... BACKTRAN TAC1(2),BSET+BONL,TAC3(2),,TAC2(2),TAC5(2),TAC4(2),,EX7 5^D6 LDX 0 TREP(2) [SAVE BSTS 5^XQ STO 0 AWORK2(2) [REPLY 62CB CHTRAN EWORK4(2),XFAIL,XFAIL [CHECK REPLY 62X2 SBN 6 1 [REDUCE COUNT OF BLOCKS TO CHECK 63BL ADN 0 1 63W= ADS 0 EWORK2(2) [UPDATE BLOCK ADDRESS 642Y ... JNENVX NEMU1,MEEP,1 [J IF NOT MEEP EMULATION 647L ... ADX 4 0 [UPDATE X4 FOR EMULATION 64=Q ...NEMU1 64*W BNZ 6 RX13A [J NOT LAST BLOCK 64TG HUNTW 1,EWDAS,FBUF 65*6 FREECORE 1 [FREE BUFFER 65SQ BRN RX14 66#B # 66S2 # TRANFER FAILURES 67?L # 67R= # 68=W TFAIL STOZ AWORK4(2) 68QG BRN RX15 69=6 XFAIL ORS 6 AWORK4(2) 69PQ RX15 MFINDSU 3,EWORK3(2) [PTR TO SU 6=9B LDX 7 EWORK1(2) 6=P2 SBX 7 ASUBASE(3) 6?8L MPY 7 HBLOCK(3) 6?N= ADX 0 EWORK2(2) 6#7W LDX 7 0 6B6B ... RELSTX EWORK3(2),RX16 [RELEASE UNIT 6BL2 RX16 LDX 2 FX2 6C5L LDX 3 TAC6(2) [CA ADDRESS 6CK= BADBLOCK TAC2(2) 6D4W KEEPMESS RFAIL(1),EWORK3(2),7 [BLOCK N FAIL 6DJG LDCT 0 #40 6F46 ORS 0 AWORK4(2) [FAILED REPLY 6FHQ LDCT 0 #100 6G3B ANDX 0 AWORK2(2) [TEST FOR B2 IN BSTS REPLY 6GH2 ORS 0 AWORK4(2) [SET B2 IF B2 SET IN BSTS REP 6H2L BNZ 0 RX17 [B2 SET 6HG= LDX 0 AWORK2(2) [BSTS REPLY 6H^W SRL 0 18 6JFG SBN 0 4 6J^6 BZE 0 RX17 [ONLY B3 SET 6KDQ LDCT 0 #10 6KYB ORS 0 AWORK4(2) [B5=1 IF OTHER BITS SET 6LD2 RX17 LDX 4 AWORK1(2) [ADDITIVE MODES 6LXL LDX 5 EWCHAN(2) [CHANNEL NO. 6MC= LDX 6 AWORK4(2) [REPLY TO OBJECT PROGRAM 6MWW HUNTW 1,EWDAS,EWMESS 6NBG BNG 1 RZR 6NW6 CHAIN 1,APETADDR(2) [CHAIN BEHIND PCA 6P*Q TOPCA1 ZA(1) [CHANGE TO PCA 6PTB UNPLUG [FREE EXEC SOCKET 6Q*2 CAPCA EWDAS,EWMESS [CHANGE TO CPA TAKING EWMESS WITH US 6QSL EXMESS ALL [OUTPUT BLOCK N FAIL 6R#= LDN 7 0 [RESTART O/P MARKER 6RRW ANDN 4 #20 6S?G BNZ 4 RX18 [J IF ADDITIVE MODE #20000 SET 6SR6 RX21 STO 6 AWORK1(2) [REMEMBER OBJECT PROGRAM REPLY 6T=Q NGN 7 1 [DON'T RESTART PROG 6TQB ...XPAR LDCT 6 #006 [ TYPE IN B0-8 6W=2 ... ADX 6 EWCHAN(2) [ CHANNEL IN B9-23 6WPL ... OUTPACK 6,1,PERINAME,XPAR [ ASSEMBKE PARAM FOR ILLEGALX 72LL LDX 6 AWORK1(2) [OBJECT PROGRAM REPLY 745G RX18 ADN 3 1 74K6 GETWORD 3,3 754Q TESTREP RESVIOL,RERR 75JB STO 6 0(3) 7642 WORDFIN 7=Y= BNG 7 RX19 [J IF PROG NOT TO BE RESTARTED 7?CW RUNPROG [RESTART PROG 7?XG RX19 LDX 7 PERF(1) [ONLINE *THING FAIL MESSAGE 7#C6 RX22 ILLEGALX 7 [REPORT ILLEGAL AND FINISH 7#WQ # 7*BB # STORAGE UNIT NOT ONLINE 7*W2 # 7B*L NOTON LDX 2 FX2 7BT= LDX 3 TAC6(2) [REMEMBER CONTROL AREA ADDRESS 7C#W LDX 5 EWCHAN(2) [AND CHANNEL NO. 7CSG LDX 6 EWORK3(2) [AND SERIAL NO. 7D#6 LDX 1 FX1 7DRQ TOPCA1 ZA(1) [CHANGE TO PCA 7F?B UNPLUG [FREE SOCKET 7FR2 CAPCA [TO CPA 7KN2 SMUSEST 6,NONL,REAKIN [GET SU ONLINE 7L7L RELSTX 6,RX20 [RELEASE UNIT 7M6W RX20 STEPBACK [STEP PROGS ONR BACK 7MLG RUNPROG [TRY AGAIN 7N66 # 7NKQ # OPERATOR TYPES CANTDO LOAD SU 7P5B # 7PK2 NONL LDCT 6 #50 [REPLY 7Q4L BRN RX21 [JOIN ILLEGAL PATH 7QJ= # 7R3W # BREAKIN OCCURS WHILE WAIT FOR SU 7RHG # 7S36 REAKIN 7SGQ STEPBACK [STEP ONR BACK 7T2B PROGBRKIN [REPORT BREAK IN 7TG2 # 7T^L # LOGICAL BUCKET NUMBER OUT OF RANGE 7WF= # 7WYW RONGLBN 7XDG LDCT 0 #10 [LBN OUT OF RANGE REPLY 7XY6 STO 0 AWORK4(2) 7YCQ BRN RX14A [J TO PUT REPLY IN PROG 7YXB # 7^C2 # BUFFER OUT OF RESERVATIONS 7^WL # 82B= OUT LDX 7 ZRR3(1) [BUFFER OUT OF RESERVATIONS MESSAGE 82TW BRN RX6 83*G # 83T6 # ILLEGAL LENGTH 84#Q # 84SB RONGLEN 85#2 LDX 7 ZRR4(1) [COUNT OUT OF RANGE MESSAGE 87=G ...RX6 RELSTX EWORK3(2),RX23 [RELEASE SU 87Q6 RX23 LDX 1 FX1 889Q TOPCA1 ZA(1) [CHANGE TO PCA TO REPORT ILLEGAL 88PB UNPLUG [FREE EXEC PROG SOCKET 8992 BRN RX22 [J TO DO ILLEGAL 89NL # 8=8= # RETURN TO START ALL OVER: (G4)-PROGRAM'S QOTA HAS BEEN CHANGED 8=MW # 8?7G PERION 8?M6 ACROSS PERION,2 8#6Q # 8#LB MENDAREA 40,K99SPERION 8*62 #END ^^^^ ...41265223000100000000