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