(George Source)
Macros used: CCOUT, CCSTOP, CHECKXOT, CLCOUNT, CLDRM, CLEARJPS, CLWTBSW, DISENGPER, DOWN, FPUT, FREECORE, FREEPER, FSHENTRY, GEOERR, GEOPACK, GETACT, GSCAN, HUNTW, INFORMX, JANON, JENV, JENVNOT, JEXOTIC, JMT, JNWTBSW, JONL, JRIGHT, JWTBWR, LGEOG, LINKSET, LINT, LONGON, LTYPE, MENDAREA, NOTBUSY, OUTPACK, PAIR, SAWCE, SEGENTRY, SETALLOC, SETWTBWR, SWOUT, UP, WRONG, XWRONG, YWRONG
22FL #SEG FREEPER [LEN WAGSTAFF. 22PD ...# (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1983. 22^= #OPT K0FREEPER=0 23DW #OPT K6FREEPER=K6PERI 23YG #LIS K0FREEPER>K0PERI>K0GREATGEO>K0ALLGEO 24D6 # 24XQ # THIS SEGMENT IS ENTERED FROM THE FREEPER MACRO TO RELEASE THE 25CB # PERIPHERAL OWNED BY THE CALLING ACTIVITY. AN ACTLF IS SET UP 25X2 # FOR A SLOW OUTPUT DEVICE, UNLESS THE CALLING ACTIVITY ITSELF 26BL # IS AN ACTLF. THE DEVICE IS WRONGED IF MARKED WAITING TO BE SO, 26W= # AND THE APPROPRIATE MESSAGE IS SENT TO THE RELEVANT CONSOLE. 27*W # 27TG 8HFREEPER 28*6 # 28SQ # 29#B SEGENTRY K1FREEPER,X1FREEPER 29J8 FSHENTRY K2FREEPER,X2FREEPER,,X2FREEPER 29S2 # 2=?L # 2=R= XCR +3 2?=W XLP +2 2?QG XTP +1 2#=6 XCP +4 2#PQ PLINK 2*9B PAIR LISTINIT,4 2*P2 PLINKTC [TP OR CP 2B8L PAIR LISTINTC,8 2BN= XAZFREE +AZFREE 2C7W XJWRONG +JWRONG 2C*4 XJSWRJ +JSWOREJ 2CG= XJUSWO +JUNITSWO 2CJW ... +JUNITCSWO 2CMG X1FREEPER 2D76 LDN 7 0 2DLQ LDX 3 CPPTR(2) [UNTIL FOUND DIFFERENT 2F6B #SKI K6FREEPER>199$199 2FL2 ( [SKIPPED IF K6FREEPER<200 2G5L BNZ 3 PLOCAL 2GK= LDX 0 JSOURCE2(2) 2H4W BNZ 0 REMOTE [BR IF REMOTE, OTHERWISE... 2HJG GEOERR 1,LOCAL!! 2J46 PLOCAL 2JHQ ) 2K3B #SKI K6FREEPER<199$199 2KH2 BZE 3 REMOTE [BR IF REMOTE 2L2L # ^ SKIPPED IF K6FREEPER >200 2LG= NOTBUSY 2L^W #SKI K6FREEPER>12$12 2MFG ( 2M^6 LGEOG 3,4 2NDQ GSCAN 4,FREEPERL 2NYB ) 2PD2 CLCOUNT 3,GEORGE 2PXL CLCOUNT 3,OBJECT [CLEAR DEVICE COUNTS 2QC= CLCOUNT 3,REPEAT 2QWW CLCOUNT 3,FAIL 2RBG LTYPE 3,4 [DEVICE TYPE TO X4 2RW6 CLDRM 3 [CLEAR ONLINE IN DRM MARKER 2S*Q LDN 7 1 [MARK ONLINE 2STB JONL 3,ONLINE 2T*2 LDN 7 0 [MARK NOT ONLINE 2TSL ONLINE 2W#= JWTBWR 3,XWTBWR [BR IF WAITING TO BE WRONGED 2WRW CLEARJPS 3 [CLEAR JPSTATE WORD 2X?G TXU 4 XLP(1) 2XR6 BCC XOP [BR IF LINEPRINTER 2Y=Q TXU 4 XTP(1) 2YQB BCC XOP [BR IF TAPEPUNCH 2^=2 TXU 4 XCP(1) 2^PL BCS XNOP [BR IF NOT CARDPUNCH 329= XOP 32NW LDCH 0 ATYPE(2) 338G SBN 0 ACTLF/64 33N6 BZE 0 XACTLF [BR IF ACTLF ISSUED 347Q SETALLOC 3 [MARK DEVICE ALLOCATED 34MB GETACT ACTLF,CENTRAL [GET CENTRAL ACTLF FOR DEVICE 3572 LDX 2 BPTR(2) [X2 NOW POINTS TO NEW ACTLF 35LL TXU 4 XLP(1) 366= BCC TOLP [J. IF LP 36KW LINKSET 2,PLINKTC(1) [MOVE IN LINK FOR TP 375G BRN NOTLP 37K6 TOLP LINKSET 2,PLINK(1) [MOVE IN LINK FOR LP 384Q NOTLP 38JB STO 3 CPPTR(2) [STORE D1L POINTER IN CPPTR 3942 SLL 4 18 [SET UP DEVICE TYPE FOR JSOURCE1 39HL LGEOG 3,0 [LOAD GEOG NO OF DEVICE 3=3= ADX 4 0 3=GW STO 4 JSOURCE1(2) [SET UP JSOURCE1 3?2G FPUT 3?G6 BRN XNOMESS [BR TO TIDY UP - NO MESSAGE 3?^Q # 3#FB XWTBWR [DEVICE WAITING TO BE WRONGED 3#^2 CLEARJPS 3 [CLEAR 3*DL JMT 3,XMT [JUMP IF MAGNETIC TAPE 3*Y= DISENGPE 3 [... ELSE DISENGAGE IT 3BCW JEXOTIC 3,XOTIC [BR IF EXOTIC 3BXG SBN 4 10 3CC6 BZE 4 UXZ [BR IF UNIPLEXOR... 3CWQ SBN 4 1 3DBB BZE 4 UXZ [...OR IF MULTIPLEXOR 3DW2 SBN 4 13 3F*L BNZ 4 XALDIS [BR IF NOT IPB 3FHW #SKI IDFMARK8<1$1 3FQ6 YWRONG SGOT,3 3FYB #SKI IDFMARK8 3G6L YWRONG XBRK,SGOT,3 [WRONG IPB IN IDF 3G#W BRN XALDIS 3GSG UXZ 3H2Q #SKI IDFMARK8<1$1 3H92 XWRONG SGOT,3 3HC= #SKI IDFMARK8 3HKG XWRONG XBRK,SGOT,3 [WRONG UX/MX IN IDF 3HRQ XOTIC 3J?B XALDIS 3JR2 XMT 3K=L WRONG 3 [WRONG THE DEVICE 3KB5 JNWTBSW 3,XWRONG 3KB8 ... JENVNOT XMT8,CMESTAR 3KB? ... LDX 6 XJWRONG(1) 3KBB ... GEOPACK 5,JK52C(3),COBBLERS 3KBF ... OUTPACK 5,1,GEOPER 3KBJ ... INFORMX 7,6,1 3KBM ... JMT 3,XMT1 3KBQ ... BRN XMT8 3KBT ...XMT1 3KBY ... STO 3 AWORK1(2) 3KC3 ... LFMTCL 3,5 3KC6 ... STO 5 AWORK2(2) 3KC9 ... LDX 3 5 3KC# ... LNOMTCL 3,5 3KCC ...XMT2 3KCG ... JRIGHT 3,XUP 3KCK ...XMT3 3KCN ... SBN 5 1 3KCR ... BZE 5 XMT4 3KCW ... CALL 6 ZNXTDK 3KC^ ... JANON 3,XMT3 3KD4 ... BRN XMT2 3KD7 ...XMT4 3KD= ... LDX 3 AWORK2(2) 3KD* ... LNOMTCL 3,5 3KDD ...XMT5 3KDH ... SBN 5 1 3KDL ... BZE 5 XMT6 3KDP ... CALL 6 ZNXTDK 3KDS ... CLWTBSW 3 3KDX ... BRN XMT5 3KF2 ...XMT6 3KF5 ... LDX 3 AWORK2(2) 3KF8 ... BRN XMT8 3KF? ...XMT8 3KFJ CLWTBSW 3 3KK3 SWOUT 3,XBRKN,XSWRJ 3KKC ... STOZ 4 3KKR ... JENV XSW,CME,EXCL 3KL7 ... JMT 3,XMT9 3KLH ... BRN XSW 3KLX ...XMT9 3KM? ... ADN 4 1 3KMM ...XSW 3KN3 ... SMO 4 3KNG LDX 6 XJUSWO(1) 3KR^ BRN XOUT 3KXD XSWRJ 3L2X LDX 6 XJSWRJ(1) 3L6B BRN XOUT 3L9W XACTLF [CALLING ACTIVITY IS AN ACTLF 3LPG LONGON #27 [WAKE UP FOR SLOW O/P DEVICE 3M96 BRN XNOMESS [NO MESSAGE FOR SLOW OJP DEVICE 3MNQ XNOP [NOT SLOW OUTPUT DEVICE 3N8B JMT 3,XNOMESS [NO DIS OR MESSAGE FOR MT 3NN2 DISENGPER 3 [DISENGAGE THE DEVICE 3P7L CHECKXOT 3,XNFWOREX [BR IF NOT EXOTIC 3PM= LONGON #30 [WAKE UP FOR EXOTICS 3Q6W BRN XFREE [BR TO TIDY UP - FREE MESSAGE 3QLG XNFWOREX [NOT FLAGWAVER OR EXOTIC 3R66 TXU 4 XCR(1) 3RKQ BCC XSLIP [BR IF CARDREADER 3S5B BNZ 4 XFREE [BR IF NOT TAPEREADER 3SK2 XSLIP [TR OR CR 3T4L LONGON #60 [WAKE UP FOR SLOW INPUT DEVICE 3TJ= XFREE [FREE MESSAGE REQUIRED 3W3W LDX 6 XAZFREE(1) [LOAD MESSAGE IDENTIFIER (FREE) 3WHG BRN XOUT 3X36 XWRONG [WRONGED MESSAGE REQUIRED 3XGQ LDX 6 XJWRONG(1) [WRONGED MESSAGE IDENTIFIER 3Y2B XOUT 3YG2 BNZ 3 SNOUT [USE CPPTR IF LOCAL PERIPHERAL 3Y^L GEOPACK 5 [PACK JSOURCE WORDS 3^F= BRN XINF 3^YW SNOUT 42DG GEOPACK 5,JK52C(3),COBBLERS [PACK G:OG NO 42Y6 XINF 43CQ OUTPACK 5,1,GEOPER [AND OUTPUT PERI DESC 43XB INFORMX 7,6,1 [SEND MESSAGE 44C2 XNOMESS 44WL XUP 45B= LDCH 0 ATYPE(2) [DONT CLEAR JSOURCE WORDS ... 45TW SBN 0 ACTLF/64 46*G BNZ 0 XNJSCE [BR IF NOT ACTLF 46T6 STOZ JSOURCE1(2) 47#Q STOZ JSOURCE2(2) [ZEROISE JSOURCE WORDS 47SB STOZ JSOURCE3(2) 48#2 XNJSCE 48RL STOZ CPPTR(2) 49?= STOZ CPRW1(2) [CLEAR CPPTR, CPRW1,2, AND CPRSW 49QW STOZ CPRW2(2) 4==G STOZ CPRSW(2) 4=Q6 UP [RETURN 4?9Q # 4?PB SGOT 4#92 # 4#NL # THIS LABEL IS USED IF SOME MISERABLE MOGUPPER SNATCHED A UX,MX, OR CC 4*8= # FROM THE IDF BEFORE WE GOT IN TO WRONG IT. THE DEVICE IS MARKED 4*MW # WAITING-TO-BE-WRONGED AND NO MESSAGE IS OUTPUT,THUS CONFUSING THE 4B7G # POOR OLD OPERATOR 4BM6 # 4C6Q SETWTBWR 3 [SET WAITING TO BE WRONGED 4CLB BRN XNJSCE 4D62 # 4DKL REMOTE 4F5= GSCAN JSOURCE1(2),FREEPERR,3 4FJW SAWCE PCT,XPCT [BR IF NOT FROM IPB 4G4G XIPB 4GJ6 LDX 4 JSOURCE1(2) 4H3Q ANDN 4 #7777 [IDENTIFIER IN X4 4HHB CALL 6 XHDCB [HUNT DCB ON X3 4J32 LDX 5 IWAIT(3) 4JGL ANDN 5 #1000 [MASK IN WAITING TO BE WRONGED BIT 4K2= BZE 5 XIPB3 [... AND BR IF NOT SET 4KFW LDCT 5 2 4K^G ORS 5 FOURTHWD-FPTR(2) [MARK DEVICE WRONGED 4LF6 XIPB3 4LYQ # CHECK IF INITIAL BULK OUTPUT HAS FAILED 4MDB LDEX 0 FOURTHWD-FPTR(2) 4MY2 ANDN 0 3 4NCL ERN 0 3 4NX= BNZ 0 XFDV [J IF NOT LP OR TP 4PBW LDCT 0 #20 [CHECK IF DEVICE HAS FAILED 4PWG ANDX 0 ISTATUS(3) 4QB6 BZE 0 XFDV [J IF NOT FAIL 4QTQ LDN 0 #4000 4R*B ORS 0 FOURTHWD-FPTR(2) [SET INITIAL BULK OUTPUT FAIL BIT 4RT2 # 4S#L XFDV 4SS= STOZ A1+BPTR(3) [FREE DEVICE BY ZEROISING BPTR OF 4T?W STOZ 1(2) [THE RING PAIRS 4TRG LDX 4 FOURTHWD-FPTR(2) [B23=1 IF OUTPUT DEVICE 4W?6 ANDN 4 1 4WQQ ERN 4 1 [X4=1 FOR INPUT DEVICE 4X=B BZE 4 XCLOSE [J IF OUTPUT DEVICE 4XQ2 BZE 5 XCLOSE [J IF DEVICE NOT BEING WRONGED 4Y9L CCSTOP IDENTNO(3),IADIN(3) [STOP I/P AND CLEAR ON THIS DEVICE 4YP= CALL 6 XHDCB [HUNT DCB ON Y3 4YQ? XCLOSE 4YR# # IF REQUESTED TO CLOSE THE IDENTIFIER (B18 OF IWAIT) 4YS* # AND IT IS NOT ALREADY CLOSED, SEND CRASH CLOSE 4YTB LDN 0 #40 4YWC ANDX 0 IWAIT(3) 4YXD BZE 0 XFRE [CLOSE IDENTIFIER NOT REQUESTED 4YYF SLL 0 9 4Y^G ANDX 0 FOURTHWD-FPTR(2) 4^2H BNZ 0 XFRE [ALREADY CLOSED 4^3J LDN 6 #0127 [COUNT + SPERVISORY CODE 4^4K SMO FX2 4^5L STO 6 ACOMMUNE1 4^6M CCOUT IDENTNO(3),IADIN(3) [SEND CRASH CLOSE 4^7N CALL 6 XHDCB [HUNT DCB ON X3 4^8W XFRE 4^NG FREECORE 3 [AND FREE IT 5286 XIPB4 52MQ LDX 2 FX2 537B LDN 3 0 [SET X3=0 TO MEAN REMOTE 53M2 BNZ 5 XWRONG [BR TO TIDY UP - WRONG MESSAGE 546L BNZ 4 XFREE [BR TO TIDY UP - FREE MESSAGE 54L= BRN XUP [BR TO TIDY UP - NO MESSAGE 555W # 55KG # 5656 XPCT [PCT DEVICE 56JQ DOWN PCTDIS,1 574B LDX 4 ACOMMUNE1(2) [GET INPUT DEVICE MARKER 57J2 LDX 5 ACOMMUNE2(2) [GET WRONGED MARKER 583L BRN XIPB4 58H= # 592W XHDCB 59GG # SUBROUTINE HUNTS FOR THE AMXOR/ADCB BLOCK, AND GIVES A POINTER 5=26 # TO IT IN X3. ALSO LEAVES, IN X2, A POINTER TO THE ADEVS RING 5=FQ # ELEMENT. LINK IN X6 5=^B HUNTW 3,AMXOR,ADCB 5?F2 BPZ 3 XHD1 [BRANCH IF DCB FOUND, OTHERWISE... 5?YL GEOERR 1,NO DCB 5#D= XHD1 5#XW LDX 2 A1+FPTR(3) [X2= POINTER TO ADEVS RING ELEMENT 5*CG EXIT 6 0 5*X6 # 5*XS ...ZNXTDK 5*YG ...# 5*^8 ...# 5*^W ... LINT 3,4 5B2J ... ADN 4 1 5B3= ... LDX 3 BDTP 5B3Y ... SMO 4 5B4L ... LDX 3 0(3) 5B5# ... EXIT 6 0 5B62 ...# 5B6Y XBRK GEOERR 1,BREAKIN! [BRK-IN ON IDF 5B=T XBRKN GEOERR 1,SWOUTBRK 5BBQ # 5BWB #PAGE 5CB2 MENDAREA 24,K100FREEPER 5CTL #END ^^^^ ...34331276000200000000