10MODE7
   15VDU31,0,18
   20Code=&7C00
   30Patch=&A00
   40TEMP = &80:REM&B0
   50From = TEMP: To = TEMP+2 :REM From OVL TEMP, To OVL CB
   60CB = To: CB_low = CB: CB_high = CB+1
   70Count = CB+2
   80Oldvec = Patch+&100-2
   90HisFSC = Oldvec-2
  100FSCV = &21E
  110FileV = &212
  120Bget = &FFD7
  130OsByte = &FFF4
  140OsCli = &FFF7
  150OsWrch = &FFEE
  160OsAscii = &FFE3
  170PROCassemble
  180*SAVE TSOFT 7C00 +200 FFFF7C00 FFFF7C00
  190MODE7
  200END
  210DEFPROCassemble
  220FOR Pass = 0 TO 2 STEP 2
  230P%=&7C00
  240[OPT Pass
  250JMP Reloc
  260.CodeStart   \ **** FROM HERE ON, MUST BE RELOCATABLE
  270.MyFSC
  280 Cmp #&05
  290 Beq StarCat
  300\ Cmp #2:\ Beq StarRun
  310\ Cmp #4:\ Beq StarRun
  320 Jmp (HisFSC)
  330.StarCat
  340Ldx #(c1-CodeStart+Patch) MOD 256:Ldy #(c1-CodeStart+Patch) DIV 256
  350Jsr OsCli
  360Ldx #(c2-CodeStart+Patch) MOD 256:Ldy #(c2-CodeStart+Patch) DIV 256
  370Jsr OsCli
  380BIT &FF: BMI esc
  390Ldx #(c3-CodeStart+Patch) MOD 256:Ldy #(c3-CodeStart+Patch) DIV 256
  400Jsr OsCli
  401.esc
  410Rts
  440.c1
  441   OPT FNequs("page701")
  450.c2
  451   OPT FNequs("tr.7000")
  460.c3
  461   OPT FNequs("disp.7000")
  470\
  480.StarRun
  490\RTS
  500\
  510\
  520\
  530\
  540\
  550\
  560\
  570\
  580.OurOsfile
  590 Cmp #&FF
  600 Beq LoadFile
  610.realosfile
  620 Jmp (Oldvec)
  630.LoadFile
  640Stx CB_low
  650Sty CB_high
  660\ *LOAD FRED 2000 passes the ENTIRE string as the filename to OSFILE.
  670\ ----- the filename must therefor be stripped off.
  680\ ----- It is not enough just to poke a CR into the space character
  690\ ----- because OSCLI("LOAD FRED") in a basic program would get corrupted
  700\ ----- by the cr being inserted in the middle of the literal text.
  710\ ***** The remedy is to copy the string elsewhere, and tweak the pointer
  720Ldy #0:Lda (CB),Y:Sta From:Iny:Lda (CB),Y: Sta From+1
  730Lda #&00:Tay:Sta Count:Sta (CB),Y:Iny:Tya:Sta Count+1:Sta (CB),Y
  740\ ^ Use stack as workspace. Not nice.
  750Ldy #0
  760.cps Lda (From),Y:Sta (Count),Y:Cmp #33:Bcc ends:Iny:Bne cps:.ends
  770Lda #13:Sta (Count),Y
  780Lda #7: Ldx CB_low: Ldy CB_high
  790Jsr realosfile-CodeStart+Patch \ Open disordered
  800Lda #0:Sta Count:Sta Count+1
  810.loadup
  820   Ldy #14
  830   Jsr Bget
  840   Bcc gotbyte
  850   Cmp #&FE
  860   Beq endoffile
  870   Cmp #&02
  880   Bne skipthis
  890\ End of block. Get new load addr
  900   Lda #5: Ldx CB_low:Ldy CB_high \ Info to get block addr
  910   Jsr realosfile-CodeStart+Patch: Ldy #2:Lda (CB),Y:Sta TEMP:Iny:Lda (CB),Y:Sta TEMP+1
  920  .skipthis
  930   Clc:Bcc loadup
  940  .gotbyte
  950   Ldy #0:Sta (TEMP),Y
  960   Inc TEMP:Bne zz3:Inc TEMP+1:.zz3
  970   Inc Count:Bne zz4:Inc Count+1:.zz4
  980Clc:Bcc loadup
  990.endoffile
 1000Ldy #&0A:Lda (CB),Y:Pha  \**** Push No-exec flag
 1010Lda Count:Sta (CB),Y  \ Y = &A
 1020Lda Count+1:Iny:Sta (CB),Y  \ Y = &B
 1030Lda #0:Iny:Sta (CB),Y:Iny:Sta (CB),Y  \ Y = &C &D  - fill in length
 1040Pla:Iny:Sta (CB),Y   \ **** Put No-exec flag in attributes byte
 1050Rts
 1060.CodeEnd   \******** END OF RELOCATABLE CODE
 1070.Reloc    \ This is execute-once code, so does not need relocating
 1080Lda #&8C:Ldx #12: Jsr OsByte \ Select tape, then Telesoft - to force
 1090Lda #&8F: Ldx #&12: Ldy #6: Jsr OsByte  \ vector re-initialisation
 1100\
 1110Ldy #0
 1120.reloc8 Lda CodeStart,Y: Sta Patch,Y
 1130Iny: Bne reloc8
 1140  Lda FileV:Sta Oldvec
 1150  Lda FileV+1:Sta Oldvec+1
 1160  Lda #(OurOsfile-CodeStart+Patch) MOD 256:Sta FileV
 1170  Lda #(OurOsfile-CodeStart+Patch) DIV 256:Sta FileV+1
 1180  Lda FSCV:Sta HisFSC
 1190  Lda FSCV+1:Sta HisFSC+1
 1200  Lda #(MyFSC-CodeStart+Patch) MOD 256:Sta FSCV
 1210  Lda #(MyFSC-CodeStart+Patch) DIV 256:Sta FSCV+1
 1220  Lda #&10: Sta &1362 \ ADD TXO COMMAND TO TFS TABLES
 1230  Lda #&EF: Sta &13E2
 1240  Lda #&AB: Sta &14E2
 1250  Lda #22:JSR OsWrch:Lda #7:Jmp OsWrch \ Last inst. must be jump
 1260.EndReloc
 1270]
 1280NEXT
 1290ENDPROC
 1300DEFFNequs(S$)
 1310$P%=S$:P%=P%+LEN(S$)+1
 1320=Pass