{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: NEWPW867)}}
====== NEWPW867 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:BXE|BXE]], [[george:macro:BXGE|BXGE]], [[george:macro:BXL|BXL]], [[george:macro:BXU|BXU]], [[george:macro:CLALLOC|CLALLOC]], [[george:macro:CLOSETOP|CLOSETOP]], [[george:macro:DFSET|DFSET]], [[george:macro:DOWN|DOWN]], [[george:macro:ENDCOM|ENDCOM]], [[george:macro:ERRORX|ERRORX]], [[george:macro:FINDPEREC|FINDPEREC]], [[george:macro:FREECORE|FREECORE]], [[george:macro:FSHENTRY|FSHENTRY]], [[george:macro:GEOERR|GEOERR]], [[george:macro:INSERT|INSERT]], [[george:macro:JALLOC|JALLOC]], [[george:macro:LONGON|LONGON]], [[george:macro:LPROP|LPROP]], [[george:macro:MASK|MASK]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREE|MFREE]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MTCHAR|MTCHAR]], [[george:macro:MTHWSER|MTHWSER]], [[george:macro:NAMETOP|NAMETOP]], [[george:macro:OPENSYS|OPENSYS]], [[george:macro:READAGAIN|READAGAIN]], [[george:macro:REWIND|REWIND]], [[george:macro:REWRITE|REWRITE]], [[george:macro:SDSEARCH|SDSEARCH]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETALLOC|SETALLOC]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SPARANOX|SPARANOX]], [[george:macro:SSEARCH|SSEARCH]], [[george:macro:TAPEOPEN|TAPEOPEN]], [[george:macro:TESTREP|TESTREP]], [[george:macro:TRACE|TRACE]], [[george:macro:UNLOAD|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