{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: SETUPA867)}}
====== SETUPA867 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:ADJUSTLK|ADJUSTLK]], [[george:macro:BXE|BXE]], [[george:macro:BXGE|BXGE]], [[george:macro:CHAIN|CHAIN]], [[george:macro:CHECKXOT|CHECKXOT]], [[george:macro:CLALLOC|CLALLOC]], [[george:macro:DCA|DCA]], [[george:macro:DFSET|DFSET]], [[george:macro:DISENGPER|DISENGPER]], [[george:macro:DOWN|DOWN]], [[george:macro:EMSACTX|EMSACTX]], [[george:macro:EMSCORE|EMSCORE]], [[george:macro:FINDCORE|FINDCORE]], [[george:macro:FIXEMSACTX|FIXEMSACTX]], [[george:macro:FIXEMSCR|FIXEMSCR]], [[george:macro:FREECORE|FREECORE]], [[george:macro:FSHTEST|FSHTEST]], [[george:macro:FWAIT|FWAIT]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GEOSTOP|GEOSTOP]], [[george:macro:GETACT|GETACT]], [[george:macro:GETEMSCR|GETEMSCR]], [[george:macro:GPERI|GPERI]], [[george:macro:HUNTW|HUNTW]], [[george:macro:JANON|JANON]], [[george:macro:JBC|JBC]], [[george:macro:JDISENG|JDISENG]], [[george:macro:JENG|JENG]], [[george:macro:JENV|JENV]], [[george:macro:JENVNOT|JENVNOT]], [[george:macro:JEXOTIC|JEXOTIC]], [[george:macro:JSWOUT|JSWOUT]], [[george:macro:JUNBUSY|JUNBUSY]], [[george:macro:JWRONG|JWRONG]], [[george:macro:LADDP|LADDP]], [[george:macro:LGEOG|LGEOG]], [[george:macro:LINKSET|LINKSET]], [[george:macro:LMODEQ|LMODEQ]], [[george:macro:LOCK|LOCK]], [[george:macro:LPROP|LPROP]], [[george:macro:LPUNSET|LPUNSET]], [[george:macro:LTYPE|LTYPE]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:NAME|NAME]], [[george:macro:PAIR|PAIR]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETALLOC|SETALLOC]], [[george:macro:SETUPCORE|SETUPCORE]]
22CM #SEG SETUPA [GENERAL EMS - COMM
22LG ...[ (C) INTERNATIONAL COMPUTERS LIMITED 1982
22T* #OPT K0SETUPA=0
2394 #LIS K0SETUP>K0EMS>K0ALLGEO>K0SETUPA
23JR 8HSETUPA
23YG # E.M.S. SEGMENT
24D6 # ENTRY POINTS
24XQ SEGENTRY K1SETUPA,Z1SETUPA
25CB MENDAREA 10,K100SETUPA
25X2 SLINK1
26BL PAIR SETUP,3
26FQ #UNS FSHTEST
26JW #SKI
26W= SLINK2
27*W PAIR BSUNJAM,1
28SQ SLINK5
29#B PAIR IPBSTART,4
2#PQ #
2*9B TWENTYFOUR +24
2*P2 S1
2B8L #HAL BSTB+ALFTABLE,0
2BN= S2
2C7W #HAL BSTB+FDTABLE,0
2C9K #UNS JMODGCR
2C?# (
2C*3 [ TABLE FOR MODE 12 PERI
2CBQ SM12 +1
2CDF +0
2CG8 +2
2CHX XGCR +HWPGCR
2CKL )
2CMG # LENGTHS OF APIAS REQUIRED BY DEVICES
2D76 XLEN +BILEN [TR
2D## #UNS JSKI38
2DFG #SKI
2DLQ +BOLEN [TP
2DP* #UNS JSKI38
2DRY +BTLEN [TP
2DWJ #SKI JSKI24<1$1 [PRE VARIABLEWIDTHPRINTERS
2F6B +BOLEN [LP
2F?J #UNSET JSKI24 [POST VARIABLE WIDTHPRINTERS
2FDQ +BLLEN [LP
2FL2 +BILEN [CR
2G5L +BOLEN [CP
2GK= +BMTLEN [MT
2H4W +BUDASLEN [EDS
2HJG +BUDASLEN [MCF
2J46 +0 [DS
2JHQ +BDRLEN [DR
2K3B +COMLEN [UX
2KH2 +COMLEN [MX
2L2L +0 [CT
2LG= +BUDASLEN [FDS
2L^W +0 [AD
2MFG +0 [TYPE 15
2M^6 +0 [TYPE 16
2NDQ +0 [TYPE 17
2NYB +0 [TYPE 18
2PD2 +0 [TYPE 19
2PXL +0 [GP
2QC= +0 [GD
2QWW +0 [DXC
2RBG +0 [UD
2RW6 +COMLEN [IPB
2S*Q +BDRLEN [FASTDRUM
2STB +BUDASLEN [EDS-30(MEDS)
2T*2 +0 [TYPE 27
2TSL +BIPCLEN [IPC
2W#= +0 [TYPE 29
2WRW +0 [TYPE 30
2X?G +0 [TYPE 31
2XR6 +0 [TYPE 32
2Y=Q +0 [TYPE 33
2YQB +0 [TYPE 34
2^=2 +0 [TYPE 35
2^PL +0 [TYPE 36
329= +0 [TYPE 37
32NW +0 [TYPE 38
338G +0 [TYPE 39
33N6 +0 [TYPE 40
347Q +0 [TYPE 41
34MB +0 [TYPE 42
3572 +0 [TYPE 43
35LL +0 [TYPE 44
366= +0 [TYPE 45
36KW +0 [TYPE 46
375G +0 [TYPE 47
37K6 +0 [TYPE 48
384Q +0 [CD
38JB +0 [IP
3942 +0 [OP
39HL +0 [GE
3=3= +0 [CO
3=GW +0 [EM
3?2G +0 [OI
3?G6 +0 [OO
3?^Q +0 [CS
3#FB +0 [RR
3#^2 +0 [ET
3*DL +0 [TYPE RESERVED FOR OBJECT PROG PERIS
3*Y= +0 [TYPE 61
3BCW +0 [TYPE 62
3BXG +CONSLEN [OPERATORS CONSOLE
3CC6 XEXOT +EXOTLEN [EXOTICS
3CCC ...XDIS 4HDIS
3CCN ...XOUT 4HOUT
3CC^ ...XIN 4HIN
3CD= ...XRI 8HRIGHT
3CDH ...XWR 8HWRONG
3CDL ...X401 #401
3CDP ...X402 #402
3CDS ...[
3CF5 ...[ XDATA SUBROUTINE
3CFB ...[
3CFM ...[ SUBROUTINE TO BUILD UP INFORMATION INTO THE ADATA EMS BLOCK FOR E
3CFY ...[ DEVICE DEFINED TO BE ON THE INSTALLATION
3CG9 ...[
3CGG ...[ ON ENTRY X3 = POINTER TO DEVICE LIST X6 = DEVICE TYPE
3CGR ...[
3CH4 ...XDATA
3CH* ... STO 1 AWORK2(2)
3CHL ... LDX 1 FX1
3CHX ... JENVNOT XDAEX,CME [CME EMVIRONMENT IS NOT CME
3CJ8 ... MHUNTW 2,ADATA,EMS [HUNT ADATA EMS BLOCK
3CJF ... SMO A1(2)
3CJQ ... STO 3 A1+1(2)
3CK3 ... JWRONG 3,XDA [J. WRONG
3CK# ... LDX 7 XRI(1)
3CKK ... LDX 0 XRI+1(1)
3CKW ... BRN XDA1 [J TO STORE RIGHT
3CL7 ...XDA LDX 7 XWR(1)
3CLD ... LDX 0 XWR+1(1)
3CLP ...XDA1 SMO A1(2)
3CM2 ... STO 7 A1+2(2) [ST RIGHT OR WRONG
3CM? ... SMO A1(2)
3CMJ ... STO 0 A1+3(2)
3CMT ... JSWOUT 3,XDA2 [J. SWITCHED OUT
3CN6 ... LDX 0 XIN(1)
3CNC ... BRN XDA3
3CNN ...XDA2 LDX 0 XOUT(1)
3CN^ ...XDA3 SMO A1(2)
3CP= ... STO 0 A1+4(2) [ST IN OR OUT
3CPH ... JENG 3,XDA4
3CPS ... LDX 0 XDIS(1)
3CQ5 ... BRN XDA5
3CQB ...XDA4 LDX 0 ACES
3CQM ...XDA5 SMO A1(2)
3CQY ... STO 0 A1+5(2) [ST. DIS OR SPACES
3CR9 ... LGEOG 3,0
3CRG ... SMO A1(2)
3CRR ... STO 0 A1+6(2)
3CRX ... SMO A1(2)
3CS3 ... STO 6 A1+7(2) [X6 = TYPE
3CS7 ... LDN 0 7
3CS* ... ADS 0 A1(2)
3CSL ... LDX 2 FX2
3CSX ...XDAEX
3CT8 ... LDX 1 AWORK2(2)
3CTF ... EXIT 4 0
3CWQ XFINDL [GIVES PTR. TO DEVICE LIST
3DBB BXGE 1 BDTL,NOMORE [INDICATED BY X1(INTERNAL NUMBER)
3DW2 SMO BDTP [X1 CONTAINS INTERNAL NO. OF DEVICE
3F*L LDX 3 0(1) [X3 POINTS TO DEVICE LIST
3FT= LTYPE 3,6 [X6 CONTAINS THE TYPE
3G#W EXIT 4 0
3GSG NOMORE
3H#6 NGN 3 4095 [SET X3 NEGATIVE
3HRQ EXIT 4 0
3J?B START
3JR2 # CALCULATE LENGTH REQUIRED FOR APIAS
3K=L STOZ AWORK1(2)
3KQ= LDN 1 0
3L9W XAP1 CALL 4 XFINDL [FIND DEVICE LIST INDICATED
3LPG # [BY X1
3M96 BNG 3 XCOR [J. IF END OF DEVICE LISTS
3MNQ CHECKXOT 3,XAP2 [J. TO XAP2 IF NOT AN EXOTIC
3N8B SMO FX1
3NN2 LDX 0 XEXOT
3P7L BRN XAP3
3PM= XAP2
3Q6W ADX 6 FX1 [X6 CONTAINS TYP OF DEVICE
3QLG SMO 6
3R66 LDX 0 XLEN
3RKQ XAP3 ADS 0 AWORK1(2) [INCREASE APIAS BLOCK
3S5B ADN 1 1 [GO TO NEXT DEVICE LIST
3SK2 BRN XAP1
3T4L XCOR
3TJ= LDX 2 AWORK1(2) [SET UP BLOCK OF LENGTH IN AWORK1
3W3W CALL 4 SCOREG4
3WHG FINDCORE 5 [FIND THIS BLOCK
3X36 NAME 5,APERI,APIA [NAME BLOCK
3XGQ CHAIN 5,BMISC [CHAIN IN MISCEL CHAIN
3Y2B # NOW TO DIVIDE THE ABOVE BLOCK INTO AREAS FOR EACH DEVICE
3YG2 # AND TO SETUP THE POINTERS IN THE DEVICE LISTS.
3Y^L ADN 5 A1 [POINT TO START F APIA
3^F= LDX 3 AWORK1(2) [ZERORISE APIA BLOCK
3^YW SBN 3 1
42DG SMO 5
42Y6 STOZ 0
43CQ LDX 6 5
43XB ADN 6 1
44C2 MOVE 5 0(3)
44WL LDN 1 0 [INTERNAL NUMBER
45B= LDX 2 HALFTOP
45TW XAPA CALL 4 XFINDL
46*G BNG 3 YBSAPIA [GO TO COMPLETE BSA APIAS AND MT.
46T6 CHECKXOT 3,XAPB [J.IF NOT EXOTIC DEVICE
47#Q SMO FX1
47SB LDX 7 XEXOT [UPDATE PTR. TO NEXT APIA
48#2 BRN XAPC
48RL XAPB
48T* ... JENV XAPBA,CME,EXCL
48X4 ... LDN 0 #77
48YR ... SBX 0 6
492G ... BZE 0 XAPBA [J OPS CONSOLE
4949 ... LDEX 0 JK52C(3)
495Y ... BNZ 0 XAPBA [UNIT NO NOT ZERO
496R ... JENV XAPB1,CMESTAR
497M ... GEOERR 1,ANONUNIT [UNIT NO ZERO - ANONYMOUS!
4989 ...XAPB1 JSWOUT 3,XAPBA
498R ... GEOERR 1,ILLANON
499B ...XAPBA
49?= ADX 6 FX1 [UPDATE PTR.
49QW SMO 6 [X6 CONTAINS THE TYPE OF DEVICE
4==G LDX 7 XLEN [POINTED TO BY X3
4=Q6 XAPC BNZ 7 XAPD
4?9Q STO 2 JADDP(3) [STORE #77770000 IF 0 LENGTH
4?PB BRN XAPE
4#92 XAPD STO 5 JADDP(3) [STORE POINTER TO APIA
4#NL XAPE ADX 5 7
4*8= ADN 1 1 [GO TO NEXT DEVICE LIST
4*MW BRN XAPA
4B7G # GO THROUGH DEVICE LISTS SETTING UP BSA'S ETC.,BEFORE SETTING
4BM6 # THE APIAS SO THAT THE BSA'S ARE NEXT TO EACH OTHER IN CORE.
4C6Q Z1SETUPA
4C7P ...[
4C8N ...[
4C9M ...[ K1SETUPA
4C=L ...[
4C?K ...[
4C#J ... JENVNOT XEXI,CME
4C*H ... HUNTW 3,ADATA,EMS
4CBG ... BPZ 3 XEXI
4CCF ... LDX 6 BDTL [CREATE BLOCK
4CDD ... LDN 5 7 [LENGTH = BDTL X 7 +1
4CFC ... MPY 6 5
4CGB ... ADN 7 1
4CH* ... SETUPCORE 7,3,ADATA,EMS,1
4CJ# ... STOZ A1(3)
4CK? ...XEXI
4CLB LDN 1 0
4D62 XNE CALL 4 XFINDL
4DKL BNG 3 START [NO MORE DEVICES,GO TO SET APIAS.
4DTD ... CALL 4 XDATA
4F5= JWRONG 3,PEMS4 [J.IF WRONGED
4FJW CHECKXOT 3,XEX [J.IF NOT EXOTIC
4FSN SLOWP [TR,TP,LP,CR,CP
4G4G DISENGPER 3
4GJ6 BRN PEMS4
4H3Q XEX
4HHB STO 3 AWORK3(2) [PTR.TO DEVICE LIST
4J32 STO 1 AWORK2(2) [INTERNAL NO.
4JGL SMO 6 [TYPE
4K2= BRN TABLE
4KFW PEMS
4K^G LDX 2 FX2
4LF6 PEM1 LDX 1 AWORK2(2)
4LYQ PEMS4 ADN 1 1
4MDB BRN XNE
4MY2 # GO AND DEAL WITH EACH DEVICE
4NCL TABLE
4NX= BRN SLOWP [TR
4PBW BRN SLOWP [TP
4PG2 #UNS G3SIGNET
4PK6 BRN SLOWPLP [LP
4PN= #UNS G3SIGNET
4PRB #SKI
4PWG BRN SLOWP [LP
4QB6 BRN SLOWP [CR
4QTQ BRN SLOWP [CP
4R*B BRN PEMS4 [MT
4RT2 BRN PTY6 [EDS
4S#L BRN PTY7 [MCF
4SS= BRN PEMS4 [(DS)
4T?W BRN PTY9 [SLOW DR
4TRG BRN PEMS4 [UN,UX OR (IT)
4W?6 BRN PEMS4 [MPX
4WQQ BRN PEMS4 [(CT-NOT ON GEORGE 3 INSTALLATIONS)
4X=B BRN PEMS4 [FDS
4XQ2 BRN PEMS4 [(AD) OR (LV)
4Y9L BRN PEMS4 [TYPE 15
4YP= BRN PEMS4 [TYPE 16
4^8W BRN PEMS4 [TYPE 17
4^NG BRN PEMS4 [TYPE 18
5286 BRN PEMS4 [TYPE 19
52MQ BRN PEMS4 [(GP)
537B BRN PEMS4 [(GD)
53M2 BRN PEMS4 [(DXC)
546L BRN PEMS4 [(UD)
54L= BRN PEMS4 [IPB
555W BRN PTY25 [FAST DRUM
55KG BRN PTY26 [EMDS(EDS-30)
5656 BRN PEMS4 [TYPE 27
56JQ BRN PEMS4 [TYPE 28
574B BRN PEMS4 [TYPE 29
57J2 BRN PEMS4 [TYPE 30
583L BRN PEMS4 [TYPE 31
58H= BRN PEMS4 [TYPE 32
592W BRN PEMS4 [TYPE 33
59GG BRN PEMS4 [TYPE 34
5=26 BRN PEMS4 [TYPE 35
5=FQ BRN PEMS4 [TYPE 36
5=^B BRN PEMS4 [TYPE 37
5?F2 BRN PEMS4 [TYPE 38
5?YL BRN PEMS4 [TYPE 39
5#D= BRN PEMS4 [TYPE 40
5#XW BRN PEMS4 [TYPE 41
5*CG BRN PEMS4 [TYPE 42
5*X6 BRN PEMS4 [TYPE 43
5BBQ BRN PEMS4 [TYPE 44
5BWB BRN PEMS4 [TYPE 45
5CB2 BRN PEMS4 [TYPE 46
5CTL BRN PEMS4 [TYPE 47
5D*= BRN PEMS4 [TYPE 48
5DSW BRN PEMS4 [(CD)
5F#G BRN PEMS4 [(IP)
5FS6 BRN PEMS4 [(OP)
5G?Q BRN PEMS4 [(GE)
5GRB BRN PEMS4 [(CO)
5H?2 BRN PEMS4 [(EM)
5HQL BRN PEMS4 [(OI)
5J== BRN PEMS4 [(OO)
5JPW BRN PEMS4 [(CS)
5K9G BRN PEMS4 [(RR)
5KP6 BRN PEMS4 [(ET)
5L8Q BRN PEMS4 [TYPE RESERVED FOR OBJECT PROG PERIS
5LNB BRN PEMS4 [TYPE 61
5M82 BRN PEMS4 [TYPE 62
5MML BRN PEMS4 [OPERATORS CONSOLE
5MP3 #UNS G3SIGNET
5MQD (
5MRT SLOWPLP
5MS# JENVNOT SLOWP,MEEP [IF MEEP ENV AND THIS IS THE MEEP LP
5MSR [SET UP FIXED CORE POINTER TO IT
5MT= LGEOG 3,0 [LOAD GEOGRAPHIC NO. OF LP
5MWM SEGENTRY K30SETUPA [USED BY RESTORE TIME MACRO MEEPLP
5MY4 SBN 0 0 [TEST IF DEFINED AS THE MEEP LP
5M^F BNZ 0 SLOWP [NOT THE MEEP LP
5N2W STO 3 ASIGNETPTR [STORE DEVICE LIST POINTER IN
5N4? [THE FIXED CORE WORD ASIGNETPTR
5N5N )
5NK# BRN SLOWP
5PL6 PEMS7 [MT.
5Q5Q STO 1 AWORK2(2) [SAVE INTERNAL NUMBER OF MT
5QKB JUNBUSY 3,PMTA [J. IF NOT BUSY
5R52 # OTHERWISE STOP GEORGE AND REENTER GELL.
5RJL LDX 1 FX1
5S4= GEOSTOP PMTH(1)
5SHW PMTH 23,23HMAGNETIC TAPE DECK BUSY
5SM* ...PMTA [SET MODE.
5SQS ... SEGENTRY K50SETUPA
5SW? ... LMODEQ 3,0
5S^Q ... DFSET 3,SMODE,0
5T59 ... BRN XK51SETUPA
5T8N ...#GAP 50
5T#7 ... SEGENTRY K51SETUPA
5TCL ...XK51SETUPA
5TH6 JWRONG 3,YYA [J IF DECK WRONGED
5TH* ... JANON 3,YYA
5THJ #UNS JMODGCR
5TJ2 (
5TJD LPROP 3,4
5TJW LDX 0 4
5TK# ANDN 0 HWPTRACK9
5TKQ BZE 0 TRCK7 [J IF 7-TRACK TAPE
5TL8 LDX 0 4
5TLL ANDN 0 4
5TM4 BZE 0 TRCK7 [J IF NOT SWITCHABLE
5TMG JENVNOT TRCK7,DME [J IF NOT POSSIBLE TO SWITCH
5TMY SEGENTRY K40SETUPA
5TNB LDN 5 HWPPE [LOAD REQUIRED MODE
5TNS ANDN 4 HWPGCR
5TP= TXU 5 4
5TPN BCC TRCK7 [ALREADY IN REQUIRED MODE
5TQ6 LDX 1 FX1
5TQJ TXU 5 XGCR(1)
5TR2 BCS XCHMD
5TRD JBC TRCK7,3,CAPMODGCR
5TRW XCHMD SETALLOC 3
5TS# ERN 5 HWPTRACK9
5TSQ LDN 0 #12
5TT8 DCA 3,DLA,0,MODE
5TTL LDN 0 1
5TW4 DCA 3,STO,0,COUNT
5TWG SMO 5
5TWY LDX 4 SM12-1(1)
5TXB LDN 0 4
5TXS DCA 3,STO,0,CTSA
5TY= LDX 2 FX2
5TYN GPERI 3,2
5T^6 CLALLOC 3
5T^J TRCK7
5W22 )
5W2Q JDISENG 3,YYA
5WGB SETALLOC 3 [MARK ALLOCATED.
5X22 #SKI CAMK7<6-6*G3
5XFL GETACT AREWIND,,1 [GET REWIND ACTIVITY AND FIND IT
5X^= #SKI CAMK7>5-5^G4
5YDW GETACT AREWIND [GET REWIND ACTIVITY AND FIND IT
5YYG LDX 2 BPTR(2)
5^D6 LINKSET 2,SLINK1(1) [LINK TO K3SETUP
5^XQ STO 3 CPPTR(2)
62CB #SKI CAMK7>5-5^G4 [INCLUDE IF G4 OR LLGETCORES IN
62X2 FWAIT HLLOCKAREA
63BL #SKI CAMK7<6-6*G3 [INCLUDE IF G3 AND OLD LL GETCORES
63W= (
64*W STO 2 3
64TG LOCK 2 [LOCK ACTIVITY.
65*6 LDN 0 7
65SQ DCA CPPTR(3),STO,0,MODE [SET REWIND MODE.
66#B GPERI ,3 [INITIATE REWIND
66S2 )
67?L YYA
67R= LDX 1 AWORK2(2) [RESTORE INT. NO.
68=W BRN YAGB
68QG #SKI G3
69=6 (
69PQ SCORAG4 [IN GEORGE 3 THIS ENTRY POINT IS EQUIVALENT TO SCORA
6=9B SCORA
6=P2 SLL 6 12
6?8L EMSACTX 6,2 [GET PERMANENT ACTIVITY FROM
6?N= # [TOP OF STORE AND LOCATE IT
6#7W LDX 2 BPTR(2)
6#MG EXIT 4 0
6*76 SCOREG4 [IN G3 THIS ENTRY POINT IS EQUIVALENT TO SCORE
6*LQ SCOREG4A
6B6B SCORE
6BL2 STOZ 0
6C5L SCOREG4F
6CK= EMSCORE 2,0 [EMSCORE WITH A DIFFERENCE
6D4W EXIT 4 0
6DJG )
6F46 #SKI G4
6FHQ (
6G3B # NO ROUNDING IF X0 0
6GH2 SCOREG4F
6H2L EMSCORE 2,0
6HG= EXIT 4 0
6H^W SCORA SLL 6 12 [THIS ENTRY IS USED IF CORE MUST BE GOT AT TOP
6JFG BRN SCORAM [OF STORE SO WE JUMP INTO FIXEMSACTX TO DO
6J^6 [A STRAIGHT FORWARD EMSACTX
6KDQ SCORAG4 [THIS ENTRY IS USED IFCORE CAN BE OBTAINED FROM
6KYB SLL 6 12 [SPARE SPACE AT END OF FIXED CORE
6LD2 FIXEMSACTX 6,2,SCORAM
6LXL LDX 2 BPTR(2)
6MC= EXIT 4 0
6MWW SCORE BRN SCOREM [THIS ENTRY IS USED IF CORE MUST BE GOT AT TOP
6NBG [OF STORE-J INTO FIXEMSCR TO DO A STRAIGHT
6NW6 [FORWARD EMSCORE
6P*Q SCOREG4 [THIS ENTRY IS USED IF CORE CAN BE OBTAINED FROM
6PTB [SUT PAGE OR AT END OF FIXED CORE
6Q*2 LDX 0 2 [ATTEMPT TO GET CORE FROM SUT PAGE
6QSL ADN 0 A1
6R#= LDN 1 1024
6RRW SBX 1 FSUTPAGE
6S?G SBX 1 0
6S*9 #
6SBY # AFTER THE INTRODUCTION OF THE 'VOPA IN G4' ENHANCEMENT, A DUMMY
6SDM # BLOCK IS PLACED AT THE END OF THE SUT PAGE (JUST RED TAPE WORDS)
6SGB # - SO WE MAKE SURE WE DONT TRY TO USE THESE WORDS.
6SJ5 #
6SKS #SKI G4VOPA
6SL9 (
6SLL #UNS CA1D
6SM3 #SKI
6SMH SBN 1 A1D
6SMY #UNS CA1D
6SN* SBX 1 CA1D
6SNQ )
6SP= #
6SR6 BNG 1 SCOREG4A
6T=Q LDX 1 FSUTPAGE
6TQB ADX 1 BSUT
6W=2 ADS 0 FSUTPAGE
6WPL STO 0 ASIZE(1)
6X9= STO 2 ALOGLEN(1)
6XNW LDX 2 FX2
6Y8G STO 2 BPTR(1)
6YN6 LDX 0 FPTR(2)
6^7Q STO 0 FPTR(1)
6^MB SMO 0
7272 STO 1 BPTR
72LL STO 1 FPTR(2)
736= LDX 1 FX1
73KW EXIT 4 0
745G SCOREG4A [THIS ENTRY IS USED IF CORE MUST NOT BE IN SUT PAGE
74K6 FIXEMSCR 2,SCOREM
754Q EXIT 4 0
75JB )
7642 PEMSX
76HL TXU 3 GEOBSPTR
773= BCS PEMSY [J.IF NOT GEORGE B.S.
77GW EXIT 5 0
782G PEMSY
78G6 SBX 5 FX1
78^Q STO 5 AWORK4(2) [STORE LINK
79FB STO 1 7 [INTERNAL NO. IN X7
79^2 LDX 3 6 [TYPE OF DEVICE IN X3
7=DL LDX 2 BSABL [GET CORE FOR BSA.
7=Y= LDN 6 BSA
7?CW CALL 4 SCORA
7?XG DVS 6 TWENTYFOUR(1) [CALCULATE THE WORD AND FLAG BIT
7#C6 LDX 0 GSIGN [CORRESPONDING TO THIS DEVICE
7#WQ STO 7 BA3(2) [IN THE ENGAGE BUTTON AREA
7*BB STO 3 AWORK1(2) [ANDSTORE THEM FOR LATER USE
7*W2 SMO 6 [IN BA3 AND BA2 RESPECTIVELY
7B*L SRL 0 0 [GSIGN CONTAINS +0.2
7BT= STO 0 BA2(2)
7C#W SMO FX2
7CSG LDX 3 AWORK3
7D#6 STO 3 CPPTR(2) [SET PTR TO DEV LIST IN BSA
7DRQ LDN 4 BSCHANAD(2) [SET UP EMPTY RING ELEMENTS FOR
7F?B LDN 6 BSQWCHAN(2) [THE VARIOUS BACKING STORE QUEUES.
7FR2 LDN 7 BSSCHAD(2)
7G=L STO 4 BSCHANAD(2)
7GQ= STO 6 BSQWCHAN(2)
7H9W STO 7 BSSCHAD(2)
7HPG STO 4 BSBKCHAN(2)
7J96 STO 6 BSQWBACK(2)
7JNQ STO 7 BSSBKCHN(2)
7K8B LDX 5 BSUN [CURRENT BACKING STORE UNIT NUMBER
7KN2 STO 5 BACK2(2)
7L7L LDN 7 1
7LM= ADS 7 BSUN [UPDATE BSUN
7M6W LDX 0 BSTSEP [BS CHAPTER ENTRY POINT
7MLG ADJUSTLK 2
7N66 LDN 5 AFAILLEN
7NKQ GETEMSCR 5 [CORE FOR FAIL LIST
7P5B FINDCORE 3
7PK2 NAME 3,BSTB,BFAIL
7Q4L LDN 6 A1(3)
7QJ= LDN 7 A1+1(3)
7R3W STOZ A1(3) [CLEAR OUT BLOCK
7RHG MOVE 6 AFAILLEN-1
7S36 NGN 7 1
7SGQ STO 7 A1+1(3)
7T2B CHAIN 3,BPTR(2) [CHAIN BEHIND BSA
7TG2 LDX 5 AWORK4(2) [RESTORE LINK
7T^L ADX 5 FX1
7WF= EXIT 5 0
7WYW PTY6 [EDS
7XDG PTY7 [MCF(MAGNETIC CARD FILE)
7XY6 PTY9 [SLOW DRUM
83T6 PTY25 [FAST DRUM
85#2 PTY26 [EDS-30
85RL CALL 5 PEMSX
86?= PEMSA
86QW BRN PEM1
86RC SLP
86RD ... JENVNOT SLPA,CME [J. ENVIRONMENT NOT CME
86RF ... LDN 0 #1000 [BIT 14
86RH ... ORS 0 JPSTATE(3) [SET BIT 14 IN JPSTATE FOR ALL LINE
86X^ ...SLPA
874D LDX 7 K52+4(3)
874^ SLL 7 6
875G ADN 7 #40
8763 SRC 7 6
876J STO 7 K52+4(3)
8787 LPUNSET 3
8788 ... JANON 3,YAGB
8789 ... LPROP 3,5 [TO INITIALISE APIA FOR *LPS
878= ... LDN 7 160
878? ... SRC 5 5
878# ... BNG 5 STOW
878* ... LDN 7 132
878B ... SLC 5 3
878C ... BNG 5 STOW
878D ... LDN 7 120
878F ... SRC 5 2
878G ... BNG 5 STOW
878H ... LDN 7 96
878J ...STOW LADDP 3,2
878K ... STO 7 AREPERT(2)
878L ... LDN 0 65
878M ... SLL 0 12
878N ... ADS 0 AREPERT(2)
878P ... LDX 2 FX2
8799 BRN SNOTLP
87=G YBSAPIA
87Q6 LDX 2 FX2
889Q LDN 1 0 [INTERNAL NUMBER.
88PB YAG
8992 CALL 4 XFINDL
89NL BNG 3 YBS [NO MORE DEVICES
8=8= JEXOTIC 3,YAGB [J. IF EXOTIC
8=BG SBN 6 2
8=JQ BZE 6 SLP
8=R2 SNOTLP
8=^= SBN 6 3
8?7G BZE 6 PEMS7 [BR. IF MT
8?M6 BPZ 6 YBS [NO MORE MTS
8#6Q YAGB
8#LB ADN 1 1
8*62 BRN YAG
8*KL YBS
8B5= LDX 1 FX1
8BJW LDX 2 BBAC [PTR.TO GEORGE'S BSA
8C4G LADDP ,3
8CJ6 LTYPE ,4
8D3Q LDCT 0 #400
8DHB SBN 4 9
8F32 BZE 4 XDR [J IF DR
8FGL SBN 4 16
8G2= BZE 4 XDR [J IF HSDR
8GFW ORS 0 BSUNIT2(3) [B0=1-USED BY SYSTEM
8G^G BRN XNODR
8HF6 XDR
8HYQ SETALLOC
8JDB XNODR
8JY2 # NOW TO DEAL WITH THE REST OF BS UNITS
8KCL YBSA
8KX= LTYPE ,6 [LOAD TYPE
8LBW TXU 6 PEDS(1)
8LWG BCC YEDS [J. IF EDS
8P#L TXU 6 PEMD(1)
8PS= BCC YEMD [J. IF EDS-30
8Q?W LADDP ,3 [LOAD APIA PTR.
8QRG LDX 5 BACK2(2) [DRUM
8R?6 DSA 5 BDRUM(3)
8RQQ BRN YBSA1X
8S=B # PUT INFORMATION IN APIAS
8SQ2 YEDS [EDS
8T9L LDN 6 #100+EDS
8TP= BRN YEMS
96GG YEMD [EDS-30
9726 LDN 6 #100+EMDS
97FQ YEMS
97^B LADDP ,3
98F2 STO 6 BSUNIT1(3) [BS TYPE
98YL LDCH 6 6 [SAVE BS TYPE IN BSA
99D= SLL 6 12 [INTO AWORK1(B0-B11)
99XW ORS 6 AWORK1(2)
9=CG YBSAP
9=X6 LDX 5 BACK2(2)
9?BQ DSA 5 BSUNIT(3) [BS UNIT NO.
9?WB YBSA1X
9#B2 LDX 0 BSUN [LAST PLUS ONE BS UNIT NO
9#TL SBN 0 1
9**= BXE 0 BACK2(2),START1 [NO MORE BSAS
9*SW LDX 4 ASIZE(2)
9B#G ANDX 4 BITS22LS
9BS6 SBX 2 4 [PTR TO NEXT BSA
9C?Q BRN YBSA
9CRB TABL1 [TABLE OF CURRENT B.S. PERIPH. TYPES
9D?2 PEDS +6 [EDS
9F== PDR1 +9 [SLOW DRUM
9G9G PDR2 +25 [FAST DRUM
9GP6 PEMD +26 [EDS-30
9H8Q #DEF ZCOUNT=0?-TABL1
9HNB PUPX +10 [UNIPLEXOR
9J82 PMPX +11 [MULTIPLEXOR
9JML PIPB +24 [IPB TYPE
9K7= PIPC +28 [IPC TYPE
9KLW PEMS1 LDX 2 FX2
9L6G XAGO LDX 1 AWORK2(2)
9LL6 XAGO1 ADN 1 1
9M5Q BRN XAGN
9MKB START1
9N52 SEGENTRY K2SETUPA
9NJL DOWN TWINSET,1
9P4= BRN XNOTWIN [COMES UP IF NOT TWINNED DEVICES
9PHW LDX 6 ACOMMUNE1(2) [ELSE UPPLUS1 - BLOCK TYPE
9Q3G LDX 2 ACOMMUNE4(2) [LENGTH
9QH6 CALL 4 SCORAG4 [GET BSA/ENTWIN
9R2Q STO 2 ENTWINPTR
9RGB LDCT 0 #400
9S22 ORN 0 1
9SFL STO 0 CHAINADD(2)
9S^= LDX 3 FX2
9TDW LINKSET 2,ACOMMUNE2(3)
9TYG XNOTWIN
9WD6 DOWN IPCSTART,2 [GENARAL INITIALISATION FOR IPC'S
9WXQ LDN 1 0
9XCB XAGN CALL 4 XFINDL
9XX2 BNG 3 PEMS3 [J.IF NO MORE DEVICES
9YBL JEXOTIC 3,XAGO1 [J. IF EXOTIC
9YW= STO 3 AWORK3(2)
9^*W STO 1 AWORK2(2)
9^TG LDX 1 FX1
=2*6 TXU 6 PEDS(1)
=2SQ BCC PEMS2
=4?L TXU 6 PDR1(1)
=4R= BCC PEMS2
=6=6 TXU 6 PDR2(1)
=6PQ BCC PEMS2
=79B TXU 6 PEMD(1)
=7P2 BCC PEMS2 [J. IF BACKING STORE TYPE
=88L TXU 6 PMPX(1) [J. IF MULTIPLEXOR
=8N= BCC PPLX1
=97W TXU 6 PUPX(1)
=9MG BCC PPLX1 [J. IF UNIPLEXOR
==76 TXU 6 PIPB(1)
==LQ BCC PIPBX [J IF IPB
=?6B TXU 6 PIPC(1)
=?L2 BCS XAGO [J IF NOT IPC
=#5L PIPCX [IPC
=#K= DOWN IPCSTART,1
=*4W BRN XAGO
=*JG PIPBX [IPB
=B46 LDN 2 BMOPLEN+IPBINLEN
=BHQ LDN 6 AMOP+IPBIN
=C3B CALL 4 SCORAG4 [EMSCORE AN AMOP/IPBIN
=CH2 STO 3 CPPTR(2) [POINTER TO DEVICE LIST
=D2L SMO JADDP(3)
=DG= STO 2 APJOBNO+1 [STORE IPBIN ADDRESS IN APIA
=D^W LDX 7 IPBADDR
=FFG STO 2 IPBADDR [INSERT IN LIST OF IPB ACTIVITES
=F^6 STO 7 IPBL(2)
=G2# ... LPROP 3,4
=G3G ... TXU 4 X401(1)
=G4N ... BCC PIPB1
=G5W ... TXU 4 X402(1)
=G74 ... BCS PIPB3
=G7D ... LDCT 4 3
=G7S ... BRN PIPB1A
=G8= ...PIPB1
=G8L ... LDCT 4 1
=G92 ...PIPB1A
=G9D ... JENV PIPB2,CMESTAR
=G=L ... GEOERR 1,ILL7900E
=G?S ...PIPB2
=GB8 ... ORS 4 IPBSW(2)
=GCB ...PIPB3
=GDQ LINKSET 2,SLINK5(1) [LINK TO K4IPBSTART
=GYB BRN PEMS1
=HD2 PPLX1 [UNIPLEXOR AND MULTIPLEXOR
=HXL # DON'T SETUP IDF ENTRY OR MOP ACTIVITY IF EXOTIC.
=JC= # [X3 CONTAINS PTR. TO DEVICE LIST
=JGB ...[ SCANNER DOES NOT EXIST ON DME MACHINES THEY ARE
=JKG ...[ SMLCC'S WHICH ARE TREATED AS EXOTICS AND
=JNL ...[ HANDLED BY GEORGE AND COMMS MGNR AS VIRTUAL 7900
=JRQ ... JENV XAGO,CME
=JWW LDN 2 BMOPLEN
=KBG LDN 6 AMOP
=KW6 CALL 4 SCORAG4
=L*Q STO 3 CPPTR(2)
=LTB SMO JADDP(3)
=M*2 STO 2 APJOBNO+1
=MSL LPROP ,4 [GET PROPERTY CODE
=N#= ANDN 4 #10 [MASK OUT MAX. CHARS./TRANSFER PROPER
=NRW ADN 4 #10 [-TY BIT (256 IF SET, 128 OTHERWISE)
=P?G SLL 4 4 [SAVE MAX. CHAR. CT. IN AMOP
=PR6 STO 4 AWORK1(2)
=Q=Q LDX 3 ADMULTACT
=QQB STO 3 ADMP(2)
=R=2 STO 2 ADMULTACT
=RPL BRN PEMS1
=S9= PEMS2 [BACKING STORE DEVICES
=SNW JWRONG 3,XAGO
=T8G DOWN CARTCONT,2
=TN6 BRN XAGO
=W7Q PCOPY
=WMB SBX 7 FX1
=X72 STO 7 AWORK4(2) [SAVE LINK
=XLL LDX 3 BINDEX [SEARCH DOWN INDEX CHAIN FOR
=Y6= PCO3 TXU 3 CXIN [BLOCK.
=YKW BCS PCO1
=^5G GEOERR 1,INDXCHN? [NOT FOUND
=^K6 PCO1 TXU 0 ATYPE(3)
?24Q BCC PCO2
?2JB LDX 3 FPTR(3) [LOOK AGAIN
?342 BRN PCO3
?3HL PCO2 LDX 2 ALOGLEN(3) [GET CORE
?43= CALL 4 SCOREG4
?4GW FINDCORE 1 [FIND BLOCK
?52G LDN 5 ATYPE(1)
?5G6 LDN 4 ATYPE(3)
?5^Q LDX 2 ALOGLEN(3)
?6FB ADN 2 A1-ATYPE
?6^2 MOVE 4 0(2) [COPY BLOCK
?7DL LDX 4 1
?7Y= CHAIN 1,BINDEX+1 [CHAIN INTO INDEX CHAIN
?8CW FREECORE 3 [FREE OLD BLOCK
?8XG LDX 7 AWORK4(2) [RESTORE LINK.
?9C6 ADX 7 FX1
?9WQ EXIT 7 0
?=BB PEMS3 DOWN FSTABLE,1 [CREATES ENTRIES FOR LOGICAL FILES.
?=W2 LDX 0 S1(1) [COPY ALFTABLE TO TOP OF CORE.
??*L CALL 7 PCOPY
??T= STO 4 ALFTP [FIXED STORE POINTER.
?##W LDX 0 S2(1) [COPY FDTABLE TO TOP OF CORE.
?#SG CALL 7 PCOPY
?*#6 STO 4 AFDTP [FIXED STORE POINTER.
?*RQ DOWN SETLIST,1 [FIND SHEET SIZE,SET UP BSLIST BLOCKS
?B?B # SETUP BACKING STORE UNJAMMER ACT.
?BR2 LDN 2 ACTUNJAMLEN [GET UNJAMMER ACTIVITY
?C=L LDN 6 ACTUNJAM
?CQ= CALL 4 SCORAG4
?D9W LINKSET 2,SLINK2(1) [LINK TO K1BSUNJAM
?DPG LDX 4 CLEANCT
?F96 LDX 5 EDATE
?FNQ LDCT 6 #200
?G8B STO 4 AWORK1(2)
?GN2 STO 5 AWORK2(2)
?H7L ORS 6 CLONG1(2)
?HM= FWAIT #11 [SET WAITING FOR JAM
?HSD XFSHNBUNJAM
?JF= ACROSS SETUPB,1 [CONTINUE FROM SETUP-RUNNING OUT
#P=B #END
^^^^ ...01153622000600000000