(George Source)
Macros used: ACROSS, BS, CLOSE, CLOSEABANDON, COMBRKIN, COMERRX, CREATEB, ENDCOM, FJOCA, FPCACA, FSHCODE, FSHENTRY, GEOERR, GETWORD, GETWORDX, HUNT2, LOADNOW, MENDAREA, MHUNT, MHUNTW, MONOUT, NAMETOP, OUTPACK, READY, REPERR, SEGENTRY, SETMODE, SPARAPAS, STEP, TESTLOAD, TESTREP, TESTREP2, TESTRPN2, TRANSBEG, TRANSFIN, USEROPEX, VFREEW, WHATBACK, WORDFIN, WRONG
22FL #LIS K0SAVE>K0ALLGEO>K0COMMAND 22^= ...#SEG SAVE70 [OWEN N JOHN :CENT 23DW 8HSAVE 23YG # 24D6 # THIS SEGMENT SAVES A PROGRAM IN A LOADABLE FORM WITH ITS SUPPLEMENT 24XQ # REQUEST SLIP SUCH THAT THIS SAVED PROGRAM CAN BE LOADED,RESUMED OR 25CB # RESTORED AT A LATER DATE 25X2 # 26BL SEGENTRY K1SAVE,XK1 [COMMAND ENTRY 26LD ... FSHENTRY K2SAVE,WHATBK,,WHATBK [ TO DO 'WHATBACK' FOR M/C 'B' 26W= # 27*W # THIS SUBROUTINE DOES A QUICK STEP APPEND 27TG # IT EXPECTS X4 TO CONTAIN WORD COUNT ON ENTRY LINK X5, 28*6 # 28SQ YWRIT SBX 5 FX1 29#B LDX 1 4 29S2 STEP ,0(1),VBIN [->VBIN IF BREAK IN 2=?L TESTREP2 FILEFULL,ODEAR [J IF NO MORE ROOM 2=R= #SKI BSOL 2?=W TESTREP2 REFUSED,RUNOUT [J IF NO BS LEFT 2?QG STO 4 FRH(3) 2#=6 LDN 0 #41 2#PQ STO 0 FRH+1(3) [STORE PFCC 2*9B ADX 5 FX1 2*P2 EXIT 5 0 2B8L NXTP SBX 7 FX1 [FIND NEXT PARAMETER 2BN= SPARAPAS 2C7W MHUNT 2,CPB,CUNI 2CMG LDX 0 ANUM(2) 2D76 ADX 7 FX1 2DLQ EXIT 7 0 2F6B # 2FL2 PLOAD 4HLOAD 2G5L TYPE #73230000 2GK= TEB #73030003 2H4W TES #73100006 2HJG TURTY #74000 [MAX.RECORD SIZE 30K 2J46 TYPE2 #73020002 [FIRST WORD OF ENTRY BLOCK 2JHQ # 2K3B XK1 [ENTRY POINT 2KH2 CALL 7 NXTP [GET FILENAME PARAMETER 2L2L BNG 0 S1 [ERROR IF ABSENT 2LG= NAMETOP 2,FILE,FNAME 2L^W CREATEB [CREATE FILE OPENING BLOCK 2MFG CALL 7 NXTP [GET NEXT PARAMETER 2M^6 BNG 0 R5 [ASSUME DA IF MISSING 2N8Y ... BZE 0 R5 [ OR NULL 2NDQ LDCH 7 APARA(2) [TEST FOR ASTERISK 2NYB SBN 7 #32 2PD2 BNZ 7 S2 [ERROR IF NOT 2PXL ANDN 0 #7777 [REMOVE TYPE 2QC= BRN R3 2QWW # 2RBG # ROUTINE CONDENSES CHARACTERS FOLLOWING ASTERISK 2RW6 R2 BCHX 2 £ 2S*Q LDCH 6 APARA(2) [LOAD NEXT CHARACTER 2STB SBN 6 #20 2T*2 BZE 6 R3 [IGNORE IF SPACE 2TSL SLL 7 6 2W#= ORX 7 6 2WRW R3 BCT 0 R2 2X?G # TEST IF *CP OR *DA 2XR6 LDN 5 0 2Y=Q SBN 7 #2340 [CP? 2YQB BZE 7 R6 2^=2 SBN 7 #61 [DA? 2^PL BNZ 7 S2 [ ERROR 329= R5 32NW LDN 5 1 [EDS FILE MARKER 338G R6 33N6 # NOW CHECK IF LOADED: TO ENSURE PICK UP MEANINGFUL INFORMATION 347Q LDX 2 FX2 34MB FJOCA 2 [FIND JOBBLOCK 3572 TESTLOAD 2,READY [J IF OOADED 35LL LOADNOW R9,THEND,0 [LOAG IF,LEAVING SO/ 366= READY 36KW LDX 2 FX2 375G MHUNTW 3,FILE,CREATE [FIND CREATE BLOCK 37K6 FPCACA 1,2 384Q #SKI G3 38JB ( 3942 LDX 4 ALIMIT(1) 39HL ADN 4 1024 [ALLOW EXTRA 1K FOR RED TAPE 3=3= SRL 4 9 [NO OF BS BLOCKS REQD 3=77 ... LDN 0 FILESIZE 3=?4 ... TXL 0 4 3=B^ ... BCS WOOPS 3=GW ) 3?2G #SKI G4 3?G6 ( 3?^Q HUNT2 2,BSTB,BSCB,1 3#FB LDX 4 AASIZE(2) [PAGES ACCESSED 3#^2 LDN 0 FILESIZE/2 [MAX SIZE OF FILE IN K 3*DL TXL 0 4 3*Y= BCS WOOPS [J IF TOO BIG 3BCW LDX 6 AMAXSIZE(2) [KEEP SIZE WORD 3BXG ) 3CC6 BNZ 5 R7 3CWQ LDX 0 GSIGN 3DBB ADN 0 #12 [SET AS GRAPHIC 3DFG ... STO 0 CETM(3) 3DJL ...[ 3DMQ ...[ THE FOLLOWING 'BS' WAS INSERTED AT THE REQUEST OF 3DQW ...[ :FILE SECTION SUPPOSEDLY IT STOPS ERRONOUS 3DW2 ...[ 'FILE FULL' MESSAGES WITH WORKFILES 3D^6 ...[ DONE 16.JAN.75 :CENT 3F4= ...[ 3F7B ... BS 3,CESERIAL 3F=G ...[ 3F*L SETMODE 4,CREATE,APPEND,EMPTY 3FT= BRN R8 3G#W # NOW FIND HOW MANY 128 WORD BUCKETS WILL BE REQUIRED AT MOST 3GSG R7 3H#6 #SKIP G4 3HRQ ( 3J?B ADN 4 1 [FIRST 8 BUCKETS 3JR2 SLL 4 1 [ROUND TO BS BLOCKS 3K=L ) 3KQ= STO 4 CEINF3(3) 3L9W LDCT 0 #406 3LPG STO 0 CETM(3) 3M96 LDN 0 1 [BUCKET SIZE 3MNQ STO 0 CEORG(3) 3MQN ...WHATBK 3MSL ... FSHCODE B,NOTIFMCA 3MWJ ...( 3MYG ... TRANSBEG FSHSAVEID,SAVE,2,FILE,CREATE,ACOMMUNE1 3N2D ... BRN WHATBDONE 3N4B ...NOTIFMCA 3N6# ...) 3N8B WHATBACK 0,4 3N=K ...WHATBDONE 3N#S ... FSHCODE A,NOTIFMCB 3NC3 ...( 3NF= ... TRANSFIN ,,ALIEN 3NHF ...NOTIFMCB 3NKN ...) 3NN2 SETMODE 4,CREATE,WRITE,EMPTY 3P7L R8 3PM= USEROPEX R9,4 3Q6W REPERR T1 [OPEN FILE & TEST REPLY 3QLG THEND 3R66 ENDCOM 3RKQ VBIN 3S5B CLOSEABANDON 3SK2 R9 COMBRKIN [BREAK IN USEROPEN 3T4L T1 3TJ= BNZ 5 N0 [BRANCH IF EDS 3W3W P1 3WHG LDN 4 3 3X36 CALL 5 YWRIT [X3 -> POS FOR RECORD 3XGQ LDX 0 PLOAD(1) 3Y2B STO 0 2(3) 3YG2 #SKI G4 3Y^L ( 3^F= # SET ALL ACCESSES 3^YW LDN 5 CHUSED+CHREAD+CHWRITEP+GNOMESS 42DG STO 5 AWORK3(2) 42Y6 ) 43CQ STOZ 5 43XB GETWORD 5,7,READ,AWORK1(2),,VBIN [X7 -> WORD 0 OF F/P 44C2 TESTREP NOCORE,ZERR [BRANCH IF NO CORE IMAGE 44WL TESTREP2 LOADERR,Y8 45B= LDN 4 18 45TW CALL 5 YWRIT 46*G Z8 FPCACA 2,FX2 [FIND PCA 46T6 LDX 4 ARM1(2) 47#Q SRL 4 3 47SB ANDN 4 7 48#2 SMO FX2 48RL STO 4 AWORK2 49?= LDX 4 ALIMIT(2) [REMEMBER CORE SIZE 49QW #SKI G4 4==G ( 4=Q6 SMO FX2 4?9Q STO 4 AWORK4 [KEEP ALIMIT HANDY FOR CHECK LATER 4?PB LDX 4 6 4#92 SLC 4 12 4#NL BPZ 6 UNSP [J IF NOT SPARSE 4*8= SBN 4 #3776 4*MW UNSP SLC 4 7 [X4 HAS CORE WORD FOR RES SLIP 4B7G ) 4BM6 #SKI G3 4C6Q SLC 4 9 4CLB Z7 HUNT2 2,AOBRES,0 [FIND REQUEST SLIP 4D62 LDN 5 A1(2) 4DKL LDN 6 2(3) 4F5= LDX 1 A1(2) 4FJW SRL 1 12 4G4G ANDN 1 #77 [LENGTH OF REQUEST SLIP 4GJ6 MOVE 5 16 4H3Q STO 4 5(3) [PRESENT CORE SIZE 4HHB SUM 5 0(1) [FORM CHECKSUM OF W+1 WDS 4J32 SBS 5 15(3) [... OF W 4JGL SMO FX2 4K2= LDX 6 AWORK2 4KFW LDX 1 FX1 4K^G LDN 0 17 4LF6 TXL 0 ALOGLEN(2) 4LYQ BCS Q1 [JUMP IF SRS 4MDB BZE 6 Q2 4MY2 Q1 LDN 4 10 4NCL CALL 5 YWRIT 4NX= STOZ 2(3) 4PBW LDN 4 2(3) 4PWG LDN 5 3(3) 4QB6 MOVE 4 7 4QTQ LDX 0 TES(1) 4R*B STO 0 2(3) 4RT2 STO 6 3(3) [STORE MODES 4S#L LDN 6 2(3) 4SS= SUM 5 7 [CHECKSUM 4T?W NGS 5 9(3) [STORE CHECKSUM 4TRG Q2 4W?6 LDX 2 FX2 4WQQ STOZ EXTPS+2(2) 4X=B SMO 7 4XQ2 LDX 4 8 [WORD 8 OF OBJECT PROGRAM 4Y9L STO 4 EXTPS+4(2) 4YP= Z6 STOZ EXTPS+3(2) [CLEAR TEMP COUNT 4^8W Z5 4^NG LDX 1 7 [ADDRESS OF WORD 0 OF O/P TO X1 5286 SMO EXTPS+3(2) 52MQ LDN 6 0(1) 537B SUM 5 16 [CHECKSUM 53M2 BNZ 5 Z2 [J IF NOT ALL ZERO 546L LDN 1 16 54L= Z3 SBN 6 1 555W SMO 6 55KG LDX 4 0(1) 5656 ADN 6 1 56JQ BNZ 4 Z2 574B BCT 1 Z3 57J2 BRN Z4 583L Z2 LDN 4 21 58H= CALL 5 YWRIT [X3 -> POS FOR RECORD 592W LDX 0 TYPE(1) 59GG STO 0 2(3) [SET TYPE WORD 5=26 LDX 5 6 [X5 -> RECORD 5=FQ LDN 6 4(3) 5=^B MOVE 5 16 [MOVE IT IN 5?F2 LDX 2 FX2 5?YL LDX 0 EXTPS+2(2) [DESTINATION ADDRESS 5#D= STO 0 3(3) [STORE DESTINATION 5#XW SBN 6 2 5*CG SUM 5 18 5*X6 NGS 5 20(3) [SET CHECKSUM 5BBQ Z4 LDN 5 16 [UPDATE 5BWB ADS 5 EXTPS+2(2) [UPDATE DESTINATION ADDRESS 5CB2 ADS 5 EXTPS+3(2) [UPDATE TEMP COUNT 5CTL LDX 5 EXTPS+3(2) [GET TEMP COUNT 5D*= TXL 5 AWORK1(2) [BRANCH IF NOT 5DSW BCS Z5 [END OF THIS BLK 5F#G #SKI G3 5FS6 GETWORD EXTPS+2(2),7,READ,AWORK1(2) 5G?Q #SKI G4 5GRB ( 5H?2 NTUS 5HQL LDX 0 EXTPS+2(2) 5J== TXL 0 AWORK4(2) 5JPW BCC Z4B [J IF REACHED ALIMIT 5K9G # WE CHECK FOR SPAS BY ASKING FOR ALL MODES OF ACCESS IN GETWORD 5KP6 # TILL RESVIOL REPLY,WHEN WE O/P WARNING & CHANGE TO READ AND 5L8Q # USED ONLY 5LNB # IF SPA FOUND ,WE O/P WARNING MESSAGE & ASK FOR SUBSET 5M82 # FROM THEN ON 5MML XGW GETWORDX EXTPS+2(2),7,AWORK3(2),AWORK1(2) 5N7= TESTRPN2 RESVIOL,NOSPA 5NLW VFREEW ADATA,ERREPLY 5P6G MONOUT HSPASV [WARNING MESSAGE 5PL6 LDN 5 CHUSED+GREAD 5Q5Q STO 5 AWORK3(2) 5QKB BRN XGW 5R52 NOSPA 5RJL ) 5S4= TESTREP2 OK,Z6 [J IF NOT FINISHED 5SHW #SKI G4 5T3G ( 5TH6 TESTRPN2 NOTUSED,Z4B [FINISH IF NOT NOTUSED REP 5W2Q ... VFREEW ADATA,ERREPLY 5WGB LDX 0 AWORK1(2) 5X22 ADS 0 EXTPS+2(2) [UPDATE DEST PTR 5XFL BRN NTUS [RETURN FOR ALIMIT CHECK 5X^= ) 5YDW Z4B 5YYG LDN 4 5 5^D6 CALL 5 YWRIT [GET POINTER 5^XQ LDX 5 TEB(1) 62CB STO 5 2(3) [ENTRY BLOCK TYPE 62X2 LDX 5 EXTPS+4(2) 63BL ANDX 5 BITS22LS 63W= STO 5 3(3) [ENTRY POINT 64*W ADX 5 TEB(1) 64TG NGS 5 4(3) 65*6 Y3 65SQ LDN 6 0 [SET TO OBTAIN FIRS ENTRY 66#B Y4 66S2 FPCACA 2,FX2 67?L HUNT2 3,APERI,APERIRES,2 67R= SMO 6 68=W LDX 4 A1(3) [NEXT PRB ENTRY 68QG BNG 4 Y7 [BRANCH IF NO MORE PERIPHERALS 69=6 OUTPACK 4,1,PERINAME [PERIPHERAL NAME -> OUTPUT BLOCK 69PQ MONOUT JSAVE 6=9B BDX 6 Y4 [BACK FOR NEXT. 6=P2 Y7 WORDFIN [MARK PROGRAM AS SWAPPABLE 6?8L Y8 6?N= CLOSE [CLOSE THE FILE 6#7W ENDCOM [FINISH 6#MG N0 6*76 ACROSS SAVEDA,1 [GO TO SAVE TO DA 6*LQ RUNOUT 6B6B CLOSEABANDON 6BB8 ... WORDFIN 6BL2 CALL 3 WRONG 6C5L +EREXQUOTA 6CK= -1 6D4W S1 CALL 3 WRONG 6DJG +JPARMIS 6F46 +JFNAME 6FHQ S2 CALL 3 WRONG 6G3B +ERRPERC 6GH2 -1 6H2L ODEAR CLOSEABANDON [LEAVE FILE AS IT WAS 6HG= WORDFIN [SIGNAL END OF GETWORDS 6H^W WOOPS CALL 3 WRONG 6JFG +BIGSV 6J^6 -1 6KDQ WRONG COMERRX 0(3),1(3) [O/P ERROR & RETURN TO COM PRO 6KYB ZERR GEOERR 1,NOIMAGE [NO CORE IMAGE 6L9Q ... 6LH6 ...[ 6LSG ... MENDAREA 30,K100SAVE 6M5W ...[ 6MC= #END ^^^^ ...47767313000100000000