LOADERDA867
(George Source)
Macros used: DCA, FINDPEREC, GPERI, JBUSY, JDISENG, JENV, JENVNOT, JFAIL, JNCMESH, JNENVX, OFF, ON, SHOPEN, STUBASEX, WRONG
- LOADERDA867.txt
22FL ...#SEG LOADERDA86 [M. DRUKKER 22J9 ...# ######################################################## 22LS ...# 22PC ...# (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982 22S2 ...# 22WK ...# ######################################################### 22^= #LIS K0LOADER>K0ALLGEO>K0LOADERMT 23DW # 23YG # THIS SEGMENT HANDLES DISCS,I.E. IT IS ENTERED WHEN ONE 24D6 # OF THE FOLLOWING COMMANDS IS INPUT: 24XQ # 25CB # DA ED FD CT DS EF #SKI ENTWINE (DC UN) 25X2 # 26BL # 26Q* ...OSCA +JLSCA [THESE ARE BUFFERS IN LOADERDB 2764 ...OSCAFAC +JLSCAFAC [THEY ARE DATUMISED IN LOADERMT 27FR ...FIXDB +0 [INTENDED(0) / PREVIOUS(<0) PERI 27TG SDSWFIX +0 [FOR SEARCHDISC 28*6 JLSWFIX 28SQ SWFIX -1 [SETTING DETERMINES ACTION BY 29#B # [PERIDISC OVER FIXES/FAILS 29S2 [ZERO -> FIXES IGNORED & FAILS REPORT 2=?L [-1 -> FIXES REPORTED & WAITED ON, 2=R= # [ & FAILS REPORTED & RETURNED TO COM 2?=W STRGLINK +0 [FOR STRINGOUT 2?QG SLINK +0 [FOR SEARCHDISC 2#=6 SNLINK +0 [FOR SEARCHBYSN 2#PQ PDLINK +0 [PERIDISC LINK 2*9B PDINOP +0 [-VE AS SOON AS INOP DISC FOUND 2*P2 [DURING DISC SEARCHES 2B8L WDPART +0 [FROM CONVERSION ROUTINE XCONV 2BN= XSURF +BSURF [BLKS/SURFACE ON 2B 2C7W # 2CMG TYPEDISC +0 [SUBTYPE OF DISC IN CT COMMAND 2D76 SDISCDL +0 [DL PTR OF DISC IN CT COMMAND 2DLQ PHLAGS #70000000 [ALL FLAGS SET 2F6B SPACE 4H000 2F?J ...OXSYF 2FDR ...XSYF 4HSYFL 2FL2 WDAC 4H0DA, [FOR CT COMMAND 2G5L SERIALNUM +0 [USN 2GK= XFILES [DATA FROM DS COMMANDS 2H4W #REP 16 2HJG +0 2J46 MAXSIZE +0 [NO.OF CYLS ON DISC IN CT COMMAND 2JHQ STOR +0 [WORK WD 2K3B JLNOB 2KH2 NOBPERC +0 [NO.OF BLKS/CYL ON DEVICE CONCERNED 2L2L PLAST #37777777 [LAST FIC WD.0 2L*3 ...SUBTYPES +EDS,+EMDS [DISC SUBTYPES 2LMD ...XSHARE #4000000 2L^W # 2MFG TEMPLATE [FILE INDEX CELL TEMPLATE 2M^6 +0 [NEXT CELL CONTIGUOUS 2NDQ +0 [ADDR OF FAC 2NYB +0,+0,+0 [FILENAME 2PD2 +0 2PXL +0 [GEN/VERSION NOS. 2QC= #20000001 [INTEGRITY/NO.OF FACS 2QWW +0 [DATE 2RBG +0 [RETENTION PERIODS 2RW6 +1 [BLKS/BKT 2S*Q +0 2STB +1 [LOG.BKT.NO OF EOF TAG 2T*2 +0,+0,+0,+0 [RESERVED 2TSL ...SDISCA +0,+128,+JLSCA,+0 [MODE/COUNT/CTSA/DTSA FOR SCA 2W#= ...SDISCB +0,+128,+JLSCAFAC,+0 [MODE/COUNT/CTSA/DTSA FOR FAC CHAIN 2WRW # [OR FIC CHAIN 2X?G ONE +1 2XR6 TWO +2 2Y=Q THREE +3 2YQB XFIVE +5 2^=2 #SKI 77?<515$515 [SKIP LABEL IF GIN515 OR LATER 2^PL OCT8 329= +8 32NW THIRTEEN +13 32W4 ...OXDEVICE 333= ...XDEVICE +0 [STORE FOR DL POINTER 338G # AREAS FOR HANDLING INOP DISCS DURING SEARCHES 33D# ...OSTRGMK 33N6 STRGMK #400:0 [0->REPORT FIXES DURING SEARCHES, -VE FOR NOT. 347Q ON 4HON [RP... 34MB OFF 4HOFF [..PARAMETERS. 3572 JLNUMIN 35LL NUMINOP +0 [NO. OF GEOGNOS IN LIST 366= STRINOP +8,8H UNITS 36KW #REP 25 375G 4H 37K6 STRREST 16H INOPERABLE^* 384Q NEWLINE +2,2H^* 38JB ...OPRINT +16,16H = #00000000^*^* 3942 ...JLRSW +0 [PTR TO TABLE JLRTAB 39HL # AREAS FOR DC/UN 3=3= # 3=GW JLUNDC 3?2G UNDCADDR +AUNRES+DCDUM [FOR UN 3?G6 +ARES+DCDUM [FOR DC 3?PY ...OSMOTAB 3?^Q SMOTAB +0 [ABS PTR TO TABUNDC 3#9J ...OUNDCTAB 3#FB UNDCTAB 3#P8 ...OTABUNDC 3#^2 TABUNDC [FOR PARAMS IN DC/UN COMMAND 3*DL #REP 2*24 3*Y= +0 3BXG # 3CC6 # FURTHER ERROR MESSAGES 3CWQ # 3DBB XEM1 +32,32H CARTRIDGE/UNIT NOT FOUND^*^* 3DNR ...OXEM2 3F38 ...XEM2 +25,25H UNIT 000 NOT UDAS^*^* 3F*L XEM3 +34,34H DISC NOT NEWLY INITIALISED^*^* 3FT= XEM4 +21,21H WRONG CONTEXT^*^* 3G#W XEM5 +26,26H INVALID CYL.NO(S).^*^* 3GG4 ...XEM6 +43,24H FILENAME 3GM= ... 19H CANNOT BE SHARED^* 3GSG # 3H#6 SPACES 4H 3J?B # 3JR2 # 3K=L # S/R TO PERFORM DISC TRANSFERS 3KQ= # CALLED VIA X0 3L9W # EXPECTS X3 -> RELEVANT DL 3LPG # X1 -> CA WORDS 3M96 # FIX/FAIL ACTION: 3MNQ # SWFIX=0 & FIX -> EXIT 0 0 3N8B # & FAIL -> OUTPUT FAIL MESS & EXIT 0 0 3NN2 # SWFIX=-1 & FIX -> OUTPUT FIX MESS & WAIT TILL OPERABLE 3P7L # & FAIL -> OUTPUT FAIL MESS & GO TO JLER 3PM= # NORMAL EXIT 0 1 3Q6W # IF DISC IS INOP PDINOP IS SET -VE BEFORE EXIT 0, 3QLG # (I.E. WHEN SWFIX=0) ELSE IT IS ZERO ON EXIT. 3R66 JLPDISC 3RKQ PERIDISC 3S5B STO 0 PDLINK(2) 3SK2 STOZ PDINOP(2) [CLEAR INOP DISC MARKER 3T4L STO 3 JLPSBS(2) [DL PTR TO PSEUDO-ACT.BLK 3TJ= LDX 0 0(1) 3W3W DCA 3,STO,0,MODE 3WHG LDX 0 1(1) 3X36 DCA 3,STO,0,COUNT 3XGQ LDX 0 2(1) 3Y2B DCA 3,STO,0,CTSA 3YG2 DCA 3,ADS,2,CTSA [DATUMISE 3Y^L LDX 0 3(1) 3^F= DCA 3,STO,0,DTSA 3^YW # 42DG # READY TO ATTEMPT TRANSFER 42Y6 # 43CQ JDISENG 3,PD4 [UNIT NOT ENGAGED 43J8 ...PD5 43NL ...#SKI G3 43T4 ... LDX 0 JLSWBUF(2) 43^G ... LDN 1 JLPSBS-CPPTR(2) [POINT TO PSEUDO-ACT.BLK 445Y ...#SKI G3 44=B ... BNZ 0 PD1 [DOUBLE BUFFERING 44C2 GPERI 3,1,NC [INITIATE TRANSFER 44WL PD1 JBUSY 3,PD1 [WAIT FOR TERMINATION 45B= JFAIL 3,PD2 [TRANSFER FAILURE 45DT ...#SKI G3 45HD ...( 45L3 ... LDX 0 JLSWBUF(2) 45NL ... BZE 0 PD10 [SINGLE BUFFERING 45R9 ... GPERI 3,1,NC [INITIATE TRANSFER 45TS ... LDX 0 FIXDB(2) 45YC ... BZE 0 PD10 [NOTHING OUTSTANDING FROM FIX 4632 ... STOZ FIXDB(2) [NOW DO INTENDED TRANSFER 465K ... BRN PD11 4688 ...) 46=R ...PD10 LDCT 0 #400 46*G STO 0 SWFIX(2) [FIX MESSAGE REQUIRED 46T6 LDX 0 PDLINK(2) 47#Q EXIT 0 1 [NORMAL EXIT 47SB PD2 LDX 1 JLPSBS+1(2) [GET REPLY 48#2 SRL 1 18 48RL BNZ 1 PD6 [REAL FAIL 49?= PD4 LDX 0 SWFIX(2) 49QW BNZ 0 PD3 [ACTION REQUIRED ON FIX 4==G PD7 LDCT 0 #400 [NONE NEEDED 4=Q6 STO 0 SWFIX(2) [RESET SWITCH 4?9Q STO 0 PDINOP(2) [NOTE UNIT INOP FOR SEARCH ROUTINES 4?PB PD9 LDX 0 PDLINK(2) 4#92 EXIT 0 0 4#NL PD3 LDN 1 JLFIXM(2) 4*8= CALL 0 JLGEOG [CONSTRUCT MESSAGE 4*MW CALL 6 JLOUT [& OUTPUT IT 4B7G LDX 3 JLPSBS(2) [RESTORE DL PTR 4BM6 PD8 JDISENG 3,PD8 [WAIT FOR FIX 4BNN ...#SKI G4 4BQ= ... BRN PD5 [TRY AGAIN 4BRS ...#SKI G3 4BTB ...( 4BWY ... LDX 0 JLSWBUF(2) 4BYG ... BZE 0 PD5 [SGLE BFFRG - TRY AGAIN 4C24 ... LDX 0 FIXDB(2) 4C3L ... BNZ 0 PD5 [REPEATED FIX 4C58 ... LDCT 0 #400 4C6Q ... STO 0 FIXDB(2) [SET FOR FIX BUFFER 4C8# ...PD11 LDX 0 JLTDOUBUF(2) 4C9W ... LDX 6 512 4C?D ... BZE 0 PD12 [FROM JLBUFF TO JLBUFF+512 4C*2 ... SBX 6 1024 [SET MINUS 4CBJ ...PD12 ADS 6 ICTSA(3) 4CD6 ... LDN 0 #1000 4CFN ... ERS 0 JLTDOUBUF(2) [SWITCH JLTDOUBUF 4CH= ... BRN PD5 [TRY AGAIN 4CJS ...) 4CLB PD6 LDN 1 JLFAILM(2) 4D62 CALL 0 JLGEOG [CONSTRUCT A FAIL MESSAGE 4DKL LDX 0 SWFIX(2) [GET SWITCH 4F5= LDCT 6 #400 4FJW STO 6 SWFIX(2) [RESET SW 4G4G BNZ 0 JLER [ACTION REQUIRED 4GJ6 CALL 6 JLOUT [OUTPUT MESS 4H3Q LDX 3 JLPSBS(2) [RESTORE DL PTR 4HHB BRN PD9 [ & DO NO MORE 4J32 # 4JGL # 4K2= # S/R TO CONVERT WD-ADDR IN X1 TO HARDWARE ADDRESS IN X0. 4KFW # DEVICE SUBTYPE EXPECTED IN JLBSUB. 4K^G # NO.BLKS/CYL EXPECTED IN NOBPERC. 4LF6 # START CYLNO OF SU EXPECTED IN JLSTART. 4LYQ # LEAVES WORD PART IN WDPART. 4MDB # CALLED VIA X6. 4MY2 # 4NCL JLCONV 4NX= XCONV LDN 0 0 4PBW SLL 01 17 4PWG SRL 1 17 4QB6 STO 1 WDPART(2) 4QTQ LDX 1 0 4QX^ ...# 4R28 ...# [X1]=HARDWARE BLOCK ADDRESS 4R4C ...# 4R6L ...JLCONV2 4R8T ...XCONV2 4R?4 ... 4R*B DVS 0 NOBPERC(2) [/BLKSPERCYL 4RT2 # 4S#L # [X0]=BLKNO & [X1]=CYLNO 4SS= # 4T?W JLCONV1 [ENTRY HERE FOR READING SCA'S 4TRG XCONV1 4W?6 ADX 1 JLSTART(2) [+BASE OF SU 4WQQ SMO JLBSUB(2) 4X=B BRN £ [BRANCH TO RELEVANT ROUTINE 4XQ2 X 4Y9L #TRA X+EDS 4YP= BRN XCEDS 4^8W #TRA X+EMDS 4^NG BRN XCEMDS 5286 ...#TRA EDS>EMDS+X+1 54=5 ...XCEDS 54*J ... JNENVX NOEMU,MEEP,7 [J IF NOT EMULATING 54F3 ... LDX 7 1 54JG ... MPA 7 NOBPERC(2) [CONVERT BACK TO BLOCKS 54M^ ... LDCT 1 #400 54RD ... ADX 0 1 54WX ... EXIT 6 0 54^9 ...NOEMU 553H ... LDN 7 0 555W SLL 70 21 55KG SLL 7 3 5656 SLL 70 3 56JQ SLL 01 20 574B SLL 0 2 57J2 SLL 01 16 583L ORX 0 7 58H= EXIT 6 0 5BWB # 5CB2 ...# EDS30 ADDRESSES. 5CTL # 5DSW XCEMDS 5F#G SLL 0 12 5FS6 SRC 01 12 5G?Q EXIT 6 0 5GRB # 5H?2 # 5HQL # S/R TO SEARCH SPECIFIED DISC (BY DL) FOR GIVEN FILE 5J== # EXPECTS X3-> DL FOR A DISC, JLBSUB TO CONTAIN SUBTYPE OF 5JPW # DISC & FINAME TO CONTAIN NAME OF FILE TO BE FOUND. 5K9G # CALLED VIA X0. ON RETURN X3-> DL STILL. 5KP6 # EXITS 0 IF FILE NOT FOUND ELSE EXITS 1 HAVING SET 5L8Q # X1->FAC FOR THE FILE, & HAVING FILLED IN BLDISC, BLADDR, 5LNB # BLSER, & BLSTART AT K18-K42, & NOBPERC. 5M82 # SWFIX IS RENEWED BEFORE EACH CALL OF PERIDISC 5MML # TO ENSURE CORRECT ACTION OVER FIXED/FAILING DISCS. 5N7= # IF DISC WAS INOP, ITS GEOGNO IS PLACED IN STRINOP. 5NLW # 5P6G SEARCHDISC 5PL6 STO 0 SLINK(2) [STORE LINK 5Q5Q LDX 0 SWFIX(2) 5QKB STO 0 SDSWFIX(2) [SAVE SWFIX 5R52 LDN 4 0 [SU 0 5RJL LDX 7 JLBSUB(2) [SUBTYPE OF DISC TO BE SEARCHED 5S4= STUBASEX 4,6,7 [GET BASE OF SU(4) 5SHW STO 6 JLSTART(2) [FOR XCONV 5T3G SMO JLCOMM(2) 5TH6 STO 6 BLSTART [& FOR LOADER 5W2Q LDN 1 0 [CYLNO 0 5WGB LDN 0 1 [BLKNO 1 FOR SCA 5X22 CALL 6 XCONV1 [ HA -> X0 5XFL LDN 1 SDISCA(2) 5X^= STO 0 3(1) [DTSA FOR SCA 5YDW STOZ 0(1) [READ MODE 5YYG LDX 0 SDSWFIX(2) 5^D6 STO 0 SWFIX(2) 5^XQ CALL 0 PERIDISC [READ SCA 62CB BRN SDINOPFL [INOP/FAIL SO NOT FOUND 62JJ ... CALL 0 CHECKDISC 62PQ ... BRN SDINOPFL 62YN ... SMO OSCA(2) 637L ... LDX 0 13 [GET NO. OF BLKS/CYL 63BL STO 0 NOBPERC(2) 63P3 ... SMO OSCA(2) 643D ... LDX 0 5 [GET USN 64*W SLL 0 6 64TG SRL 0 6 [ISOLATE & 65*6 SMO JLCOMM(2) 65SQ STO 0 BLSER [STORE FOR LOADER 6677 ... LDX 1 OSCA(2) 66FJ ... ADN 1 19 [FIRST FIC 66S2 LDN 5 147 [BS ADDR OF IT, BLK 1 WD 19 67?L # 67R= SD5 LDX 4 0(1) 68=W BNG 4 SDNO [LAST CELL JUST GONE 68QG SD1 LDX 0 2(1) 69=6 LDX 6 3(1) 69PQ LDX 7 4(1) [GET FILENAME FROM FIC 6=9B TXU 0 FINAME(2) 6=P2 TXU 6 FINAME+1(2) 6?8L TXU 7 FINAME+2(2) [& COMPARE WITH THAT REQUIRED 6?N= BCC SD3 [THIS IS IT 6#7W SD6 TXU 4 PLAST(2) 6#MG BCC SDNO [LAST CELL 6*76 BNZ 4 SD4 [NEXT CELL IN DIFFERENT BLK 6*LQ ADN 1 17 [UPDATE CORE &... 6B6B ADN 5 17 [BS ADDRESSES 6BL2 BRN SD5 [TRY AGAIN 6C5L # 6CK= SD4 STO 4 1 [X1=PTR TO NEXT FIC FOR XCONV 6D4W STO 4 5 [DESTINED FOR BLADDR 6DJG CALL 6 XCONV [GET HA OF FIC 6F46 LDN 1 SDISCB(2) 6FHQ STO 0 3(1) [DTSA 6G3B STOZ 0(1) [READ MODE 6GH2 LDX 0 SDSWFIX(2) 6H2L STO 0 SWFIX(2) 6HG= CALL 0 PERIDISC [GET NEXT FIC 6H^W BRN SDINOPFL [INOP/FAIL SO NOT FOUND 6JFG ... LDX 1 OSCAFAC(2) [POINT TO IT IN CORE 6J^6 ... ADX 1 WDPART(2) 6KDQ BRN SD5 [& HAVE A LOOK AT IT 6KYB # 6LD2 SD3 LDX 0 6(1) [HAVE FOUND FIC 6LXL SRL 0 12 6MC= BNZ 0 SD6 [MUST HAVE GENNO=0 6MWW SMO JLCOMM(2) 6NBG LDN 2 BLDISC 6NW6 MOVE 1 17 [MOVE FIC TO K18-K42 6P*Q LDX 2 G3DOL 6PTB SMO JLCOMM(2) 6Q*2 STO 5 BLADDR [WD.ADDR OF FAC 6QSL LDX 1 1(1) [WD.ADDR OF FAC 6R#= CALL 6 XCONV [HA ADDR -> X0 6RRW LDN 1 SDISCB(2) 6S?G STO 0 3(1) [DTSA 6SR6 STOZ 0(1) [READ MODE 6T=Q LDX 0 SDSWFIX(2) 6TQB STO 0 SWFIX(2) 6W=2 CALL 0 PERIDISC [READ DOWN BLK CONTAINING FAC 6WPL BRN SDINOPFL [INOP[FAIL SO NOT FOUND 6X9= ... LDX 0 OSCAFAC(2) 6XNW ... ADX 0 WDPART(2) 6Y8G SMO JLCOMM(2) 6YN6 LDN 1 BLFAC 6^7Q LDX 6 3(1) [GET SERIAL NUMBER OF FA UNIT 6^MB SLL 6 6 7272 SRL 6 6 72LL BZE 6 SD7 736= SMO JLCOMM(2) [& COMPARE WITH THAT OF HOME UNIT 73KW TXU 6 BLSER 745G BCS SDNO [ON ANOTHER UNIT SO IGNORE 74K6 SD7 754Q MOVE 0 5 [MOVE FAC FOR LOADER 7553 ...# THIS CODE IS FOR THE FULL 755# ...# IMPLEMENTATION OF SHARE 755M ... JENVNOT N2CME,CME 756J ... JNCMESH 3,N2CME 7572 ...# THE BRN SHOULD BE REMOVED 757D ...# WHEN (IF) FULL SHARE IS IMPLEMENTED 757W ... BRN N2CME 758B ... LDX 0 XSHARE(2) 759? ... LDN 1 JLCOMM(2) 75=8 ... ADX 0 BLSER(1) 75?5 ... LDX 1 BLADDR(1) 75#2 ... SHOPEN ,,SD71 75#X ... BRN N2CME 75*S ...SD71 LDN 5 FINAME(2) 75BP ... LDN 6 XEM6+4(2) 75CL ... MOVE 5 3 75DH ... LDN 1 XEM6(2) 75FD ... BRN JLER 75G* ...N2CME SMO JLCOMM(2) 75H= ... LDN 1 BLFAC 75JB LDX 0 SLINK(2) 7642 EXIT 0 1 [FILE FOUND 76HL # 773= SDINOPFL 77GW LDX 0 PDINOP(2) 782G BZE 0 SDNO [IT FAILED 78G6 SMO NUMINOP(2) [INOP; ADD GEOGNO TO LIST 78^Q LDN 1 STRINOP(2) [LOCATE FREE WD. -2 IN MESSAGE 79FB CALL 0 JLGEOG [INSERT GEOGNO 79^2 LDN 0 1 7=DL ADS 0 NUMINOP(2) [UPDATE COUNT FO GEOGNOS 7=Y= SLL 0 2 7?CW ADS 0 STRINOP(2) [UPDATE MESSAGE COUNT 7?XG SDNO LDX 0 SLINK(2) 7#C6 EXIT 0 0 [FILE NOT FOUND 7#WQ # 7*BB # 7*W2 # 7B*L # S/R TO SEARCH ALL DISCS FOR SU WHOSE SERIAL NUMBER IS IN LOCATION 7BT= # SERIALNUM. CALLED VIA X0 7C#W # IF FOUND EXIT 0 1 HAVING LEFT DL PTR IN JLPSBS, & RELEVANT 7CSG # BLOCK 1 OF DISC AT SCA, & DEVICE SUBTYPE IN X7,& JLBSUB 7D#6 # ALSO NOBPERC FILLED IN. ELSE EXIT 0 0 7DRQ # IF DISC WAS INOP, ITS GEOGNO IS PLACED IN STRINOP. 7F?B # 7FR2 SEARCHBYSN 7G=L STO 0 SNLINK(2) 7GQ= LDN 0 6 7H9W LDN 7 EDS [EDS SEARCHED FIRST 7HPG SN1 STO 0 JLBS(2) 7J96 STO 7 JLBSUB(2) [FOR XCONV 7JNQ FINDPEREC 3,APFOTY,JLBS(2),SN2 7K8B BNG 3 SN3 [NO MORE UNITS OF THIS TYPE 7KN2 LDX 7 JLBS(2) 7PK2 SN6 LDN 0 0 [*** TEMPORARY *** 7Q4L STUBASEX 0,6,JLBSUB(2) 7QJ= STO 6 JLSTART(2) [STORE START ADDRESS 7R3W LDN 1 0 [CL 0 7RHG LDN 0 1 [BLKNO 1 FOR SCA 7S36 CALL 6 XCONV1 7SGQ LDN 1 SDISCA(2) [CONVERT TO HA 7T2B STO 0 3(1) [& PLACE IN CA 7TG2 STOZ 0(1) [READ MODE 7T^L STOZ SWFIX(2) 7WF= CALL 0 PERIDISC [READ CONTROL HEADER 7WP4 ... BRN SN7 7WYW ... CALL 0 CHECKDISC 7X8N ... BRN SN2 7XDG ... SMO OSCA(2) 7XN# ... LDX 0 5 [GET USN 7XY6 SLL 0 6 7YCQ SRL 0 6 [ISOLATE IT 7YXB TXU 0 SERIALNUM(2) [THAT REQUIRED? 7^C2 BCS SN2 [NO, TRY NEXT UNIT 7^PC ... SMO OSCA(2) 823S ... LDX 0 13 [NO. BLKS/CYL 82B= STO 0 NOBPERC(2) 82TW STO 3 JLPSBS(2) [YES 83*G LDX 0 SNLINK(2) 83T6 EXIT 0 1 84#Q # 84SB SN3 LDX 0 JLBS(2) [WASN'T FOUND ON THAT SUBTYPE 85#2 SBN 0 6 8992 BNZ 0 SN5 [NOT FOUND ANYWHERE 89NL LDN 0 26 [TRY EDS30'S. 8=8= LDN 7 EMDS 8=MW BRN SN1 8?7G # 8?M6 # DEVICE WAS INOP OR FAILED. WHICH? 8#6Q SN7 LDX 0 PDINOP(2) 8#LB BZE 0 SN2 [DEVICE WAS OPERABLE & FAILED 8*62 SMO NUMINOP(2) 8*KL LDN 1 STRINOP(2) 8B5= CALL 0 JLGEOG [INSERT GEOGNO IN LIST 8BJW LDN 0 1 8C4G ADS 0 NUMINOP(2) [UPDATE COUN OF GEOGNOS 8CJ6 SLL 0 2 8D3Q ADS 0 STRINOP(2) [UPDATE MESS. CHAR COUNT 8DHB BRN SN2 [TRY NEXT UNIT 8DKK ...SN63 LDN 1 XEM2(2) 8DMS ... STO 3 XDEVICE(2) 8DQ3 ... CALL 0 JLGEOG 8DS= ... CALL 6 JLOUT 8DWF ... LDX 3 XDEVICE(2) 8DYN ... BRN SN2 8F32 # 8FGL SN5 LDX 0 SNLINK(2) [NOT FOUND EXIT 8G2= EXIT 0 0 8GFW # 8G^G # 8HF6 # MT LOADER COMES HERE ON RECEIPT OF ED/FD/DA COMMAND. 8HYQ # THEY ARE TREATED AS DA. 8JDB # SEARCH IS EDS -> FDS -> EDS30. 8JY2 # SERIAL NUMBER IS OPTIONAL 1ST PARAMETER, 8KCL ...# E.G. DA *777777,FILENAME (* AND , OPTIONAL). 8KX= # IF FILE IS NOT FOUND & SOME DISCS WERE INOP, 8LBW # THE INOP DISC STRING IS OUTPUT, SIMILARLY IF A SERIAL 8LWG # NO. WAS SPECIFIED & DISC WAS NOT FOUND. 8MB6 JLDA 8MTQ CALL 0 JLSWAPCH [CHECK SWAPFILE DECLARED 8N*B CALL 0 JLPOINT 8NT2 LDCH 0 0(1) [GET 1ST CHAR 8P4S ... SBN 0 #10 [OCTAL 8P#L ... BNG 0 TDA15 [SERIAL NO. SPECIFIED 8PJD ... SBN 0 #22 [#32=* 8PS= BZE 0 TDA5 [SERIAL NO. SPECIFIED 8Q?W CALL 0 JLFNAME [EXTRACT FILENAME 8QRG LDN 0 6 8R?6 STO 0 JLBS(2) [EDS SEARCHED 1ST 8RQQ LDN 0 EDS 8S=B STO 0 JLBSUB(2) [EDS SUBTYPE FOR STUBASEX IN SEARCHDI 8SQ2 TDA2 FINDPEREC 3,APFOTY,JLBS(2),TDA1 8T9L BNG 3 TDA3 [NO MORE UNITS OF THIS TYPE 8TP= LDX 0 JLBS(2) 925W TDA10 STOZ SWFIX(2) 92KG CALL 0 SEARCHDISC 9356 BRN TDA1 [NOT THERE 93?B ...TDAEM 93FL ...#SKI G3 93MW ... JENV K1LOADEREM,MEEP [FOUND IT - EMULATION 93W6 ... BRN K2LOADERMT [FOUND IT - REAL 1900 944B # 94J2 TDA3 LDX 0 JLBS(2) 953L SBN 0 6 98F2 BNZ 0 TDA12 [NOT FOUND ANYWHERE 98YL LDN 0 26 99D= STO 0 JLBS(2) 99XW LDN 0 EMDS 9=CG STO 0 JLBSUB(2) 9=X6 BRN TDA2 [TRY EDS30'S 9?BQ # 9?P7 ...TDA5 BCHX 1 £ [* GIVEN 9#3J ...TDA15 LDN 7 0 [NO * 9#B2 LDN 6 7 9#KS ... BRN TDA16 9#TL TDA6 BCHX 1 £ 9**= ...TDA16 LDCH 5 0(1) 9*SW TXL 5 OCT8(2) 9B#G BCS TDA7 [OCTAL CHAR 9BS6 SBN 6 7 9C?Q BZE 6 TDA14 [NULL SN 9CRB SBN 5 #20 [SPACE? 9D?2 BZE 5 TDA8 [YES, FOUND SN 9DQL SBN 5 #14 [COMMA? 9F== BZE 5 TDA8 [YES 9FPW SERIALBAD 9G9G TDA14 LDN 1 JLSERBAD(2) [BAD SN. 9GP6 BRN JLER 9H8Q TDA7 BCT 6 TDA9 9HNB BRN TDA14 [TOO MANY DIGITS 9J82 TDA9 SLL 7 3 9JML ADX 7 5 [ADD IN DIGIT 9K7= BRN TDA6 [GET NEXT 9KLW TDA8 STO 7 SERIALNUM(2) [NOW HAVE SN 9L6G BCHX 1 £ [STEP OVER COMMA/SPACE 9LL6 CALL 0 JLFNAME [EXTRACT FILENAME 9M5Q CALL 0 SEARCHBYSN [SEARCH FOR DISC 9MKB BRN TDA13 [NOT FOUND 9N52 CALL 0 SEARCHDISC [SEARCH SPECIFIED DISC 9NJL BRN JLNOFILE [FILE NOT FOUND 9P4= ... BRN TDAEM [FOUND IT 9PHW # 9Q3G TDA12 CALL 5 STRINGOUT 9QH6 BRN JLNOFILE 9R2Q TDA13 CALL 5 STRINGOUT 9RGB BRN XERR1 9S22 # 9SFL # S/R TO OUTPUT 'UNITS INOP' MESSAGE. 9S^= # CALLED VIA X5, USES ALL ACCS. 9TDW STRINGOUT 9TYG STO 5 STRGLINK(2) [STORE LINK 9WD6 LDX 7 STRGMK(2) [REPORTING REQUIRED? 9WXQ BNG 7 STR2 [NO 9XCB LDX 7 NUMINOP(2) 9XX2 BZE 7 STR1 [ALL UNITS WERE OPERABLE 9YBL LDX 6 NUMINOP(2) 9YW= BZE 6 STR1 9^*W ADN 6 STRINOP+3(2) 9^TG LDN 5 STRREST(2) [MOVE 'INOPERABLE^*' TO =2*6 MOVE 5 4 [BACK OF MESSAGE =2SQ LDN 0 16 =3#B ADS 0 STRINOP(2) =3S2 SBN 7 1 =4?L BNZ 7 STR1 =4R= LDN 0 #6420 =5=W DSA 0 STRINOP+2(2) [REMOVE 'S' =5QG STR1 LDN 1 NEWLINE(2) =6=6 CALL 6 JLOUT [TROW TO NEXT LINE =6PQ LDN 1 STRINOP(2) =79B CALL 6 JLOUT [OUTPUT MESSAGE =7P2 STR2 LDN 0 8 =88L STO 0 STRINOP(2) [RECONSTRUCT MESSAGE =8N= LDX 0 SPACES(2) =97W STO 0 STRINOP+3(2) =9MG LDN 3 STRINOP+3(2) ==76 LDN 4 1(3) ==LQ MOVE 3 24 [CLEAR OUT LINE =?6B LDN 0 #6463 =?L2 DSA 0 STRINOP+2(2) [RESET 'S' =#5L LDX 5 STRGLINK(2) [RELOAD LINK =#K= EXIT 5 0 =M*2 # =MSL # =N#= # MT LOADER COMES HERE ON RECEIPT OF CT COMMAND =NRW # =P?G # CHECK FOR VALID MNEMONIC AS 1ST PARAM =PR6 JLCT LDCT 0 #400 =Q=Q ORS 0 PHLAGS(2) [ENSURE F0 SET =QQB W06 CALL 0 JLPOINT =R=2 LDN 2 0 =RPL MVCH 1 3 =S9= LDX 2 G3DOL =SNW SRL 0 6 =T8G SBX 0 WDAC(2) [ = DA, ? =TN6 BNZ 0 JLWRC [NO! =W7Q # EXTRACT SERIAL NO. - 2ND PARAMETER =WMB W01 LDN 7 0 [CLEAR RESULT ACC. =X72 LDN 6 7 [DIGIT CHECK COUNT =XLL W04 LDCH 5 0(1) =Y6= TXL 5 OCT8(2) =YKW BCS W02 [OCTAL CHAR =^5G SBN 6 7 =^K6 BZE 6 SERIALBAD [NULL SN. ?24Q TXU 5 SPACE(2) ?2JB BCC W05 [END OF USN ?342 BRN SERIALBAD [NOT A SPACE OR OCTAL ?3HL W02 BCT 6 W03 [CHECK NO.OF DIGITS ?43= BRN SERIALBAD [TOO MANY ?4GW W03 SLL 7 3 ?52G ADX 7 5 [ADD IN THIS DIGIT ?5G6 BCHX 1 £ ?5^Q BRN W04 [GO FOR ANOTHER CHAR ?6FB W05 STO 7 SERIALNUM(2) [STORE CONVERTED RESULT ?6^2 CALL 0 SEARCHBYSN [SEARCH FOR DISC HOLDING SU ?7DL BRN W16 [NOT FOUND ?7Y= STO 7 TYPEDISC(2) ?8CW # UNIT HAS BEEN LOCATED & DL POINTER IS IN JLPSBS, SUBTYPE IN X7. ?8XG # THE 1ST 128 WDS OF THE CONTROL HEADER BEGIN AT SCA. ?##W LDX 3 JLPSBS(2) ?#SG # ?*#6 # NOW HAVE FOLLOWING DETAILS OF DISC: ?*RQ # SERIALNUMBER IN SERIALNUM ?B?B # SUBTYPE IN X7 & JLBSUB ?BR2 # DL POINTER IN JLPSBS & X3 ?C=L # BLKS/CYL IN NOBPERC ?CQ= # NO.OF CYLS IN MAZSIZE ?D9W # ?DPG # MUST CHECK DISC TO BE INITIALISED : ?F96 # ?FNQ # *** BLOCK 1 *** ?G8B # ?GN2 # WDS 0-4 RED TAPE. ?H7L # 5-18 CONTROL HEADER. ?HM= # 19-54 2 FILE INDEX CELLS (FOR SYFLE & ICLSCAFILE). ?J6W # 55-72 UNASSIGNED FIC. ?JLG # ?K66 # *** BLOCK 2 *** ?KKQ # ?L5B # WDS 0-4 RED TAPE ?LK2 # 5-14 FACS FOR SYFLE & ICLSCAFILE ?M4L # 16-20 FIRST CELL IN CHAIN FOR UNALLOCATED AREAS ?MJ= # ?N3W # ?NHG # FIRST GET UNALLOC CHAIN HEAD: ?P36 # ?P*H ... SMO OSCA(2) ?PMY ... LDX 1 10(2) [GET POINTR FROM SCA ?Q2B BZE 1 XERR3 [NO UNALLOC AREAS ?QG2 CALL 6 XCONV [CONVERT TO HA ?Q^L STO 0 SDISCB+3(2) [INTO CA ?RF= LDN 1 SDISCB(2) ?RYW STOZ SDISCB(2) ?SDG CALL 0 PERIDISC [READ DOWN CHAIN ?SY6 NULL ?TCQ # ?TXB # BLOCK CONTAINING START OF CHAIN OF FAC'S FOR UNALLOC AREAS ?WC2 # NOW AT SCAFAC. CHAIN STARTS [WDPART] WDS FROM SCAFAC. ?WWL # WE LOOK FOR LAST CELL IN CHAIN WHICH SHOULD DESCRIBE ?XB= # ALMOST ALL OF THE DISC AS UNALLOCATED. ?XTW # ?Y*G ... LDX 1 OSCAFAC(2) ?YT6 W15 SMO WDPART(2) ?^#Q LDX 0 0(1) [GET FPTR ?^SB BZE 0 W14 [END OF CHAIN #2#2 ANDN 0 #177 [EXTRACT NEW PTR #2RL STO 0 WDPART(2) #3?= BRN W15 [TRY AGAIN #3KM ...W14 SMO OSCA(2) #3Y4 ... LDX 0 14 [NO. OF CYS ON DISC #4=G STO 0 MAXSIZE(2) [FOR DS COMMAND #4Q6 # #59Q # NO FOREIGN FILES ARE PERMITTED SO... #5PB # #63R ... SMO OSCA(2) #6B8 ... LDX 0 11 #6NL BNZ 0 XERR3 [NOT INITIALISED #78= # #7MW # THERE SHOULD BE FICS FOR SYFLE & ICLSCAFILE ONLY #87G # I.E. WD 53 OF SCA SHOULD BE #400:0 #8M6 # #96Q LDCT 0 #400 #9F7 ... SMO OSCA(2) #9RJ ... SBX 0 53 #=62 BNZ 0 XERR3 [NOT INITIALISED #=KL # #?5= # EVERYTHING SEEMS OK #?JW # ##4G LDCT 5 #300 ##J6 STO 5 PHLAGS(2) [F0=0,F2=F1=1 #*3Q STOZ XFILES(2) [CLEAR COUNT OF DS'S #*HB STO 3 SDISCDL(2) #B32 BRN JLXOK #BGL # #C2= W16 CALL 5 STRINGOUT [OUPUT ANY INOP UNITS #CFW BRN XERR1 #C^G # #DF6 # #DYQ # #FDB # MT LOADER COMES HERE IF A DS COMMAND IS RECEIVED. #FY2 # THE COMMAND IS VALIDATED & CONTENTS PLACED IN TABLE #GCL # XFILES; 5WD ENTRIES AFTER WD 0. #GX= # WD0 OF XFILES CONTAINS NO. OF CORRECT DS COMMANDS #HBW # SO FAR RECEIVED & THEN: #HWG # WDS0-2 FILENAME #JB6 # WD3 START CYLNO OF FILE #JTQ # WD4 END CYLNO OF FILE #K*B # #KT2 JLDS LDX 0 PHLAGS(2) #L#L BNG 0 XERR4 [WRONG CONTEXT #LS= SLL 0 2 #M?W BZE 0 XERR4 [WRONG CONTEXT #MRG LDN 0 1 #N?6 ADX 0 XFILES(2) #NQQ SBN 0 4 #P=B BPZ 0 XERR4 [ALREADY HAVE 3 GOOD DS COMMANDS #PQ2 CALL 0 JLPOINT #Q9L LDX 6 XFILES(2) #QP= MPY 6 XFIVE(2) #R8W ADN 7 XFILES+1(2) #RNG # EXTRACT FIRST PARAMETER [X7]-> VACANT WD IN FILE LIST #S86 CALL 0 JLFNAMEC [GET FILENAME #SMQ # #T7B # MUST CHECK THAT FILENAME HAS NOT APPEARED IN A PREVIOUS DS #TM2 # #W6L LDX 0 XFILES(2) #WL= BZE 0 ZDS9 [THIS DS #1 #X5W LDN 3 XFILES+1(2) #XKG LDX 4 FINAME(2) #Y56 LDX 5 FINAME+1(2) #YJQ LDX 6 FINAME+2(2) #^4B ZDS10 TXU 4 0(3) #^J2 TXU 5 1(3) *23L TXU 6 2(3) *2H= BCC XERR7 [= NAMES *32W ADN 3 5 [ELSE LOOK AT REST *3GG BCT 0 ZDS10 [IF ANY *426 ZDS9 *4FQ LDN 6 FINAME(2) *4^B MOVE 6 3 [PUT IN LIST *5F2 SMO 7 *5YL LDN 3 3 [POINTER THIS ENTRY IN XFILES, WD 3 *6D= ZDS8 LDN 4 2 [2 NUMBERS TO CONVERT *6XW ZDS5 BCHX 1 £ [LOOK AT NEXT OPERAND *7CG LDN 6 0 [CLEAR X *7X6 LDN 7 0 [CLEAR X* *8BQ ZDS6 CDB 6 0(1) *8WB BCS ZDS7 [NON-NUMERIC CHAR *9B2 BCHX 1 £ [GO FOR NEXT *9TL BRN ZDS6 *=*= ZDS7 BNZ 6 XERR5 [HUGE OPERAND *=SW BZE 7 XERR5 [SUMMAT WRONG *?#G LDCH 5 0(1) *?S6 TXU 4 ONE(2) *#?Q TXU 5 SPACE(2) *#RB BCC ZDS3 [SPACE AT END OF 3RD PARAM **?2 TXU 4 TWO(2) **QL TXU 5 COMMA(2) *B== BCS XERR5 [ERROR SOMEWHERE *BPW ZDS3 TXL 7 MAXSIZE(2) [COMPARE WITH MAX *C9G BCC XERR5 [CYLNO TOO BIG *CP6 STO 7 0(3) [INSERT STARTCYLNO *D8Q ADN 3 1 [ *DNB BCT 4 ZDS2 [GO FOR ANOTHER PARAM *F82 NGX 5 STOR(2) [X5]= -START CYLNO *FML ADX 5 7 [X5]= END - START *G7= BNG 5 XERR5 [INVALID *GLW LDX 0 XFILES(2) *H6G BZE 0 ZDS1 [FINISHED SINCE 1ST DS *HL6 SBN 3 6 [POINT TO LAST EC *J5Q LDX 6 0(3) [GET IT *JKB SBX 6 4(3) [- THIS SC *K52 ADN 6 1 [+1 *KJL BNZ 6 XERR5 [NOT CONTIGUOUS FILES *L4= BRN ZDS1 *LHW # *M3G ZDS2 STO 7 STOR(2) [STORE FIRST BIN VALUE *MH6 LDX 0 XFILES(2) *N2Q BNZ 0 ZDS5 [NOT 1ST DS *NGB # *P22 # FILES ARE TO START ON 1ST AVAILABLE CYLINDER *PFL # *P^= LDX 6 7 *QDW MPY 6 NOBPERC(2) [START BLKNO ASKED FOR *QQ= ... LDX 5 OSCAFAC(2) *R3L ... ADN 5 1 *R*2 ... SMO 5 *RLB ... TXU 7 WDPART(2) *RXQ BCS XERR5 [NOT THE SAME *SCB BRN ZDS5 *SX2 # *TBL ZDS1 LDN 0 1 *TW= ADS 0 XFILES(2) [UPDATE CORRECT DS COUNT *W*W LDCT 0 #500 *WTG ANDS 0 PHLAGS(2) [ENSURE F1=0 *X*6 BRN JLXOK *XSQ # *Y#B # *YS2 # *^?L # MT LOADER COMES HERE ON RECEIPT OF AN EF COMMAND. *^R= # WE NOW SET ABOUT ALLOCATING THE REQUESTED FILES. B2=W # B2QG # B3=6 JLEF LDX 0 PHLAGS(2) B3PQ SLL 0 1 B49B BNG 0 XERR4 [WRONG CONTEXT B4P2 SLL 0 1 B58L BZE 0 XERR4 [WRONG CONTEXT B5N= # B67W # FAC FORMAT: B6MG # B776 # WD 0 = 0-> END OF CHAIN B7LQ # 1 = BLK ADDR OF 1ST BLK IN FILE AREA B86B # 2 = BLK ADDR OF LAST BLK+1 IN FILE AREA B8L2 # 3 = SERIAL NO. B95L # 4 = BLKS/CYL OF UNIT B9K= # B=4W # DATA: B=JG # B?46 # SERIALNUM - SERIAL NO OF UNIT B?HQ # SDISCDL - PTR TO DL FOR DISC B#3B # TYPEDISC - DISC SUBTYPE B#H2 # XFILES - NO.OF FILES B*2L # XFILES+1->15 - DETAILS OF FILES B*G= # B*^W # BBFG LDN 5 0 [FIC POINTER BB^6 LDX 0 NOBPERC(2) BCDQ LDX 4 XFILES(2) [NO.OF FILES TO BE ALLOCATED. BCYB SMO WDPART(2) BD=R ... LDX 1 OSCAFAC(2) BDK8 ... ADN 1 5 [START OF VACENT FAC CHAIN BDXL LDN 3 XFILES+1(2) [START OF FILE INFO. BF=3 ...QEF1 SMO OSCA(2) BFJD ... LDX 6 12 [POINTER TO FAC WHICH IS... BFWW STO 6 TEMPLATE+1(2) [TO BE USED FOR THIS FILE. BGBG LDX 6 0(1) [UPDATE FREE FAC... BGNX ... SMO OSCA(2) BH3# ... STO 6 12 [CHAIN POINTER. BH*Q STOZ 0(1) [MARK FAC AS LAST. BHTB LDX 6 3(3) [START CYLNO OF FILE... BJ*2 MPY 6 0 [*NO.BLKS/CYL... BJSL STO 7 1(1) [GIVES START BLKNO OF FILE. BK#= LDX 6 4(3) [GET END CYLNO. BKRW ADN 6 1 BL?G MPY 6 0 BLR6 STO 7 2(1) [END BLKNO+1 BM=Q LDX 6 SERIALNUM(2) BMQB STO 6 3(1) [STORE SERIALNUM IN FAC BN=2 STO 0 4(1) [STORE BLKS/CYL IN FAC BNPL LDN 6 0(3) [->FILENAME BP9= LDN 7 TEMPLATE+2(2) BPNW MOVE 6 3 [->FIC & MOVE IN FN BQ8G LDN 6 TEMPLATE(2) BQN6 SMO 5 BR2H ... LDX 7 OSCA(2) BR#Y ... ADN 7 53 BRMB MOVE 6 17 [MOVE FIC ENTRY TO BUFFER BS72 # BSLL ADN 1 5 [POINT TO NEXT VACANT FAC BT6= ADN 3 5 BTKW ADN 5 17 BW5G BCT 4 QEF1 BWK6 # BX4Q # MUST UPDATE FAC FOR UNALLOCATED AREA. FILES HAVE BEEN BXJB # CLOSEPACKED SO NO NEW CELLS ARE NEEDED. BY42 # [X1]-3 IS ADDRESS OF WORD CONTAINING END BLKNO+1 OF LAST BYHL # FILE ALLOCATED, I.E. START BLKNO OF UNALLOCATED AREA B^3= # B^GW SBN 1 3 C22G LDX 6 0(1) C2?W ...QEF2 LDX 1 OSCAFAC(2) C2K= ... ADN 1 1 C2WL ... SMO WDPART(2) C382 ... STO 6 0(1) C3FB # C3^2 QEF4 C4DL # C4Y= # INSERT NEW CHECKSUMS C5CW # C5XG ... LDX 1 OSCA(2) C6C6 SUM 0 128 C6Q? ... SMO OSCA(2) C75D ... SBS 0 1 [BLOCK 1 C7DK ... LDX 1 OSCAFAC(2) C7RQ ... SUM 0 128 C86X ... SMO OSCAFAC(2) C8G4 ... SBS 0 1 [BLK CONTAINING FAC'S C8T= # C9#W # REWRITE BUFFERS C9SG # C=#6 LDN 1 SDISCA(2) [FOR SCA C=RQ LDN 7 1 C??B STO 7 0(1) [WRITE MODE C?R2 STO 7 SDISCB(2) [WRITE MODE C#=L LDX 3 SDISCDL(2) [DL PTR C#Q= CALL 0 PERIDISC [REWRITE SCA C*9W NULL C*PG LDN 1 SDISCB(2) [FOR FAC BLK CB96 CALL 0 PERIDISC [REWRITE FAC BLK CBNQ NULL CC8B LDCT 6 #200 CCN2 STO 6 PHLAGS(2) [F0=0,F1=1,F2=0 CD7L BRN JLXOK CDM= # CF6W # CFLG # CG66 # CGKQ # ERROR PATHS FOR CT,DS,EF DIRECTIVES CH5B # CHK2 XERR1 LDN 1 XEM1(2) CJ4L BRN JLER CKHG XERR3 LDN 1 XEM3(2) CL36 BRN JLER CLGQ XERR4 LDN 1 XEM4(2) CM2B BRN JLER CMG2 XERR5 LDN 1 XEM5(2) CM^L BRN JLER CNF= XERR6 BRN JLWRC CNYW XERR7 BRN JLUSED CPDG # CPY6 # DDWG ) DFB6 # DFTQ # DG5J ...#GAP 1023-0? DG*B #END ^^^^ ...260311030001