(George Source)
Macros used: ACROSS, BXE, BXGE, BXL, BXU, CLALLOC, CLOSETOP, DFSET, DOWN, ENDCOM, ERRORX, FINDPEREC, FREECORE, FSHENTRY, GEOERR, INSERT, JALLOC, LONGON, LPROP, MASK, MENDAREA, MFREE, MHUNT, MTCHAR, MTHWSER, NAMETOP, OPENSYS, READAGAIN, REWIND, REWRITE, SDSEARCH, SEG, SEGENTRY, SETALLOC, SETNCORE, SPARANOX, SSEARCH, TAPEOPEN, TESTREP, TRACE, UNLOAD
22FL #LIS K0NEWPW>K0ALLGEO>K0GREATGEO>K0LIBRARY 22^= SEG NEWPW,65,N.R.BOULT,LIBRARY 23DW SEGENTRY K1NEWPW,QK1NEW 23JR ...[ 23NN ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982 23SK ...[ 23YG FSHENTRY K2NEWPW,QK2NEW,QK2NEW,QK2NEW 24D6 # 24XQ # ENTRY POINT FOR UNANTICIPATED CLOSEDOWN OF M/C 'B' 25CB # 25X2 FSHENTRY K3NEWPW,QK3NEW,,QK3NEW 26BL # 26W= MASK #37777777 27*W MASK2 #77377777 27TG MASK3 #57377777 28*6 ZERAL +ERALKNOWN 28SQ ZTINUSE +ERTINUSE 29#B ZPARWRNG +ERPARWRNG 29S2 ZEROWN +EROWN 2=?L ZFAILMAG +FAILMAG 2=R= ZOPWRONG +EROPWRONG 2?=W ZUSWRONG +ERUSWRONG 2?QG ZNOTAV +ERNOTAV 2#=6 POOLHD 0 2#PQ 4HPOOL 2*9B 4H TAP 2*P2 4HE 2B8L 0 2BN= 0 2C7W 0 2J46 QK1NEW 2JHQ SETNCORE 1,3,FLIB,FMES 2K3B LDX 0 CPPTR(2) 2KH2 STO 0 A1(3) 2L2L STOZ CPPTR(2) 2LG= NEWK1 2L^W STOZ AWORK1(2) 2MFG STOZ AWORK2(2) 2M^6 STOZ AWORK3(2) 2NDQ STOZ AWORK4(2) 2NYB LDN 3 0 2PD2 NEXTP 2PXL ADN 3 1 2QC= MHUNT 1,AONBS,GLIST 2QWW BXE 3 ALOGLEN(1),TEND [BR IF NO MORE PARAMS TO END CMD 2RBG STO 3 AWORK2(2) 2RW6 SMO 3 2S*Q LDX 6 A1(1) [PICK UP NEXT TSN 2STB LDXC 7 6 2T*2 BZE 7 NEXTP [NOTHING TO DO IF PARAM ZERO 2TSL BNG 6 POOLTP [X6 NEG IF POOL TAPE TO BE NEWED 2W#= # 2WRW # A WORKTAPE IS TO BE NEWED 2X?G # 2XR6 CALL 5 OPENBOTH [ OPEN SYS.SER. AND SYS. DOC. 2Y=Q CALL 5 SSEARCH [ SEARCH SYS.SER FOR TAPE 2YQB BRN TALKNOWN [ ENTRY PRESENT 2^=2 STOZ AWORK1(2) 2^PL CALL 5 SFINDPER 32NW BNG 3 TDIR 3=3= JALLOC 3,TINUSE 3=GW SETALLOC 3 3?2G STO 3 CPPTR(2) 3?G6 TDIR 3*Y= # UPDATE THE PERIPHERAL LIST AND :SYSTEM.DOCUMENT 3BCW TSEROP 3BXG CALL 5 UPLSD 3CC6 # APPEND RECORD TO :SYSTEM.SERIAL 3CWQ LDCT 4 #200 3DBB CALL 5 SAP [APPEND RECORD TO :SYSTEM.SERIAL 3DW2 TDEAL 3F*L LDX 2 FX2 3FT= LDX 3 CPPTR(2) 3G#W BZE 3 TSUB [BRANCH IF TAPE NOT ALLOCATED 3GSG CLALLOC 3 [DE-ALLOCATE DECK 3H#6 STOZ CPPTR(2) 3HRQ LONGON #63 [WAKE UP ACTIVITIES WAITING FOR WORKT 3J?B BRN TSUB 3JR2 # 3K=L # POOL TAPE TO BE NEWED - NO ENTRY IN SYS.SER. 3KQ= # 3L9W POOLTP 3LPG CALL 5 OPENSER [OPEN SYS. SER. 3M96 CALL 5 SSEARCH [SEARCH FOR TAPE 3MNQ BRN TALKNOWN [ENTRY PRESENT 3N8B LDX 0 GSIGN 3NN2 STO 0 AWORK1(2) [INDICATES POOLTAPE FOR UPDATE DEV.LI 3P7L CALL 5 SYSCLOSE [CLOSE SYSTEM SERIAL 3PM= TAPEOPEN ZBRKIN,7,WRITE,NOTOL,NOSS,NOQUERY 3Q6W TESTREPN OK,TAPREPNOK 3QLG # RECHECK THAT THERE IS NO ENTRY IN SYS. SERIAL 3R66 CALL 5 OPENSER [OPEN SYSTEM.SERIAL 3RKQ CALL 5 SSEARCH 3S5B ... BRN TALKNWN2 [ENTRY PRESENT 3SK2 CALL 5 SYSCLOSE [CLOSE SYS. SER. 3T4L SETNCORE 9,3,AONBS,GREN 3TJ= LDN 0 POOLHD(1) 3W3W LDN 1 A1(3) 3WHG MOVE 0 7 3X36 STOZ ACOMMUNE2(2) 3XGQ DOWN RENAMEMT,2 3Y2B NULL 3YG2 MFREE AONBS,GREN 3Y^L TESTREP OK,NOM1 3^F= LDX 4 ZFAILMAG(1) 3^YW CALL 5 ZERROR 42DG BRN UNCL1 42Y6 NOM1 43CQ CALL 5 OPENBOTH [OPEN :SYSTEM.DOCUMENT & SERIAL 43XB CALL 5 UPLSD 44C2 LDN 4 0 44WL CALL 5 SAP 45B= UNCL1 45TW CALL 5 SYSCLOSE 46*G LDX 0 CPPTR(2) 46T6 BZE 0 TSUB [BRANCH IF TAPE NOT ALLOCATED 47#Q LDN 3 0 47SB UNLOAD ,3,4,AUT,RET [FREE DECK FROM T IS ACTIVITY 48#2 TSUB 48RL CALL 5 SYSCLOSE [CLOSE ANY OPEN FILES 49?= CALL 5 SEEKFAB 49QW FREECORE 1 4==G LDX 3 AWORK2(2) 4=Q6 BRN NEXTP 4?9Q # END OF COMMAND 4?PB TEND 4#92 MHUNT 1,FLIB,FMES 4#NL LDX 0 A1(1) 4*8= STO 0 CPPTR(2) 4*MW FREECORE 1 4B7G ENDCOM 4BM6 4C6Q # 4CLB # ERROR CONDITIONS 4D62 # 4DKL TINUSE 4H3Q SMO FX1 4HHB LDX 4 ZTINUSE [TAPE IN USE 4J32 CALL 5 ZERROR [OUTPUT ERROR MESSAGE 4JGL BRN TSUB 4K2= TALKNOWN 4KFW LDX 4 ZERAL(1) 4K^G BRN TAPERR 4L45 ...[ ERROR AFTER TAPE LOADED 4L6N ...TALKNWN2 4L9? ... LDX 4 ZERAL(1) 4L?W ... CALL 5 ZERROR 4LBF ... BRN UNCL1 4LF6 # 4LYQ TAPREPNOK 4MDB TESTREP NOTAV,TAPREPA 4MY2 LDX 4 ZEROWN(1) 4NCL BRN TAPERR 4NX= TAPREPA 4PBW LDX 4 ZNOTAV(1) 4PWG # 4QB6 TAPERR 4QTQ CALL 5 ZERROR 4R*B BRN TSUB 4RT2 # 4S#L # 4SS= # BREAKIN 4T?W ZBRKIN 4TRG ACROSS NEWA,2 4W?6 # 4WQQ # SUBROUTINES 4X=B # 4XQ2 # APPEND RECORD TO :SYSTEM.SERIAL 4Y9L SAP 4YP= SBX 5 FX1 4^8W LDX 6 5 4^NG SETNCORE 6,3,FILE,FWB 5286 LDN 0 6 52MQ STO 0 A1(3) [RECORD HEADER 537B STO 7 A1+1(3) [TSN 53M2 STOZ A1+2(3) 546L STOZ A1+3(3) 54L= STOZ A1+4(3) 555W STO 4 A1+5(3) 55KG SAP2 5656 LDX 2 FX2 56JQ LDX 1 FX2 574B SAP2A 57J2 LDX 1 FPTR(1) 583L LDX 0 ATYPE(1) 58H= BXGE 0 CACT,SAP2D 592W SRL 0 12 59GG SBN 0 FLIB+FSPD 5=26 BNZ 0 SAP2A 5=FQ LDX 0 ATYPE(1) 5=^B ANDN 0 #7777 5?F2 BXU 0 AWORK2(2),SAP2A 5?YL LDX 0 A1(1) 5#D= STO 0 ACOMMUNE1(2) 5#XW MTCHAR 5*3R ...#UNS JMODGCR 5*7N ...#SKI 5*?K ...( 5*CG LDX 2 ACOMMUNE1(2) 5*X6 BNG 2 SAP2D [JUMP IF NO TRACK PROPERTIES 5BBQ LDX 1 2 5BWB ANDN 2 3 5CB2 ERN 1 #200 5CTL BZE 1 SAP2D [JUMP IF TRACK9 5D*= SRL 1 5 5DSW ADX 2 1 5F#G ... BRN SAP2B 5FG7 ...) 5FMS ...#UNS JMODGCR 5FTF ...( 5G36 ... LDX 0 ACOMMUNE1(2) 5G8R ... BNG 0 SAP2D 5GBD ... LDX 1 0 5GJ5 ... ERN 1 HWPTRACK9 5GPQ ... BZE 1 SAP2D 5GXC ... BRN SAP2F 5H54 ...) 5H?2 SAP2D 5HQL LDX 2 FX2 5J== LDX 0 CPPTR(2) 5JPW BZE 0 SAP2C [J TAPE NOT LOADED 5JRD ...#UNS JMODGCR 5JT2 ...( 5JWJ ... LPROP ,0 5JY6 ...SAP2F 5J^N ... MTHWSER 0,2 5K3= ...) 5K4S ...#UNS JMODGCR 5K6B ...#SKI 5K7Y ...( 5K9G LPROP ,5 [TAPE LOADED SO PROPERTIES CAN BE 5KP6 LDN 2 4 [DETERMINED 5L8Q LDX 0 5 5LNB ANDN 0 #200 5M82 BZE 0 SAP2B 5MML LDX 2 5 5N7= ANDN 2 3 5NC4 ...) 5NLW SAP2B 5NS4 ...#UNS JMODGCR 5N^= ...#SKI 5P6G SLL 2 13 5PB# ... MHUNT 3,FILE,FWB 5PL6 ORS 2 A1+5(3) 5Q5Q SAP2C 5QKB #SKI K6NEW>199-199 5R52 ( 5RJL TRACE A1+1(3),NEWSAP1 5S4= TRACE A1+2(3),NEWSAP2 5SHW TRACE A1+5(3),NEWSAP5 5T3G ) 5TH6 CALL 5 SSEARCH 5W2Q ... BRN SAP2E 5WGB INSERT [PUT ENTRY IN SERIAL 5X22 TESTREP OK,SAP3,FNEARLY,SAP3 5XFL GEOERR 1,FILEFULL 5X^= SAP3 5YDW MFREE FILE,FWB 5YYG ADX 6 FX1 5^D6 EXIT 6 0 5^J3 ... 5^MY ...SAP2E GEOERR 1,REC PRES 5^RT ... 5^XQ SSEARCH 62CB # 62X2 # SUBROUTINE TO LOCATE ENTRIAS IN :SYSTEM.SERIAL 63BL # X5 = LINK ; X7 = TSN ; EXIT +0 IF NOT FOUND ELSE EXIT +1 63W= # 64*W SBX 5 FX1 64TG SSEARCH NOTSNINSER,7 65*6 BRN PRES 65SQ NOTSNINSER 66#B ADN 5 1 66S2 PRES 67?L ADX 5 FX1 67R= EXIT 5 0 68=W # 68QG # SUBROUTINE TO SEE IF THE TAPE IS LOADED 69=6 # X5 = LINK ; X7 = TSN ; X3 REQUIRED => DEVICE LIST 69PQ # 6=9B SFINDPER 6=P2 FINDPEREC 3,APTSER,7 6?8L EXIT 5 0 6?N= # 6#7W # SUBROUTINE TO LOCATE ENTRY IN :SYSTEM.DOCUMENT 6#MG # X5 = LINK ; X7 = TSN ; EXIT +0 IF NOT FOUND ELSE +1 6*76 # 6*LQ SDSEARCH 6B6B SBX 5 FX1 6BL2 SDSEARCH NONTRY,TSN,7,1 6C5L ADN 5 1 [ ADJUST LINK IF FOUND 6CK= NONTRY 6D4W ADX 5 FX1 6DJG EXIT 5 0 [ ELSE EXIT 6F46 # 6FHQ # SUBROUTINE TO REWRITE AND FREE A FILE/FRB 6G3B # X5 = LINK ; EXPECTS X3 => FILE/FRB 6GH2 # 6H2L XREWR 6HG= SBX 5 FX1 6H^W NAMETOP 3,FILE,FWB 6JFG REWRITE 6J^6 MFREE FILE,FWB 6KDQ ADX 5 FX1 6KYB EXIT 5 0 6LD2 # 6LXL # 6MC= # SUBROUTINE TO SET POOL/WORKTAPE BIT IN PERIPHERAL LIST 6MWW # AND UNSET INSECURE BIT IN :SYSTEM.DOCUMENT 6NBG # X5=LINK 6NW6 # X7 = TSN 6P*Q UPLSD 6PTB SBX 5 FX1 6Q*2 LDX 2 FX2 6QSL LDX 3 CPPTR(2) 6R#= BZE 3 SAP5 6RRW LDX 0 AWORK1(2) 6S?G BPZ 0 UPLSD3 [BRANCH UNLESS POOL TAPE 6SR6 DFSET 3,POOL 6T=Q BRN UPLSD2 6TQB UPLSD3 6W=2 DFSET 3,WORK 6WPL DFSET 3,PWORK 6X9= UPLSD2 6XNW LDX 4 5 [FIND RECORD IN :SYS.DOC. 6Y8G CALL 5 SDSEARCH 6YN6 BRN SAP4A 6^7Q READAGAIN 1 6^MB MHUNT 3,FILE,FRB 7272 LDX 0 MASK3(1) 72LL ANDS 0 A1+21(3) 736= NAMETOP 3,FILE,FWB 73KW REWRITE 1 745G MFREE FILE,FWB 74K6 SAP4A 754Q LDX 5 4 [ RECOVER FIRST LINK 75JB REWIND 1 7642 SAP5 76HL ADX 5 FX1 773= EXIT 5 0 77GW # SUBROUTINE TO FIND THE FILE/FABSNB BLOCK FOR THE TSN IN X7 782G # X5 IS THE LINK AND X2,3,4,6 ARE UNUSED 78G6 SEEKFAB 78^Q LDX 1 FX2 79FB SEEK1 79^2 LDX 1 FPTR(1) 7=DL LDX 0 ATYPE(1) 7=Y= BXL 0 CACT,SEEK2 7?CW GEOERR 1,FAB LOST 7?XG SEEK2 7#C6 SRL 0 12 7#WQ SBN 0 FILE+FABSNB 7*BB BNZ 0 SEEK1 7*W2 SMO A1(1) 7B*L BXU 7 A1+1(1),SEEK1 7BT= #SKI K6NEW>299-299 7C#W TRACE 7,NEWSEEK 7CSG EXIT 5 0 7D#6 # SUBROUTINE TO OUTPUT AN ERROR MESSAGE 7DRQ # IDENTIFIER IS IN X4 AND X5 HOLDS THE LINK 7F?B ZERROR 7FR2 SBX 5 FX1 7G=L SMO FX2 7GQ= LDX 3 AWORK2 7H9W SPARANOX 3 [PASS PARAMETER WHOSE NO. IS IN X3 7HPG ERRORX 4 7J96 MFREE CPB,CUNI 7JNQ ADX 5 FX1 7K8B EXIT 5 0 7KN2 # SUBROUTINES TO DEAL WITH OPENING :SYSTEM.DOCUMENT & SERIAL 7L7L # OPENSER OPENS :SYSTEM.SERIAL 7LM= # OPENBOTH OPENS BOTH 7M6W # X5 HOLDS THE LINK 7MLG # ON EXIT X0 IS DESTROYED, X1=FX1 ,X2=FX2 7N66 OPENBOTH 7NKQ SBX 5 FX1 7P5B OPENSYS ZBRKIN,DOCUMENT,GENERAL 7PK2 LDN 0 1 7Q4L ADS 0 AWORK3(2) 7QJ= TESTREP OK,OPENSER0 7R3W GEOERR 1,NEWREP 7RHG OPENSER 7S36 SBX 5 FX1 7SGQ OPENSER0 7T2B OPENSYS ZBRKIN,SERIAL,GENERAL 7TG2 LDN 0 1 7T^L ADS 0 AWORK3(2) 7WF= TESTREP OK,OPENSER1 7WYW GEOERR 1,NEWREP 7XDG OPENSER1 7XY6 ADX 5 FX1 7YCQ EXIT 5 0 7YXB # SUBROUTINE TO CLOSE ANY OPEN FILES 7^C2 # X5 HOLDS THE LINK. ON EXIT X1=FX1 , X2=FX2 7^WL SYSCLOSE 82B= SBX 5 FX1 82TW SCL1 83*G SMO FX2 83T6 LDX 0 AWORK3 84#Q BZE 0 SCL2 84SB CLOSETOP 85#2 LDN 0 1 85RL SBS 0 AWORK3(2) 86?= BRN SCL1 86QW SCL2 87=G ADX 5 FX1 87Q6 EXIT 5 0 8JY2 MENDAREA 1023-0?,K99NEW 8KCL #END ^^^^ ...275673540001