ReturnSourceCode

FFT.BP 'RETURN.SOURCE.PATH' BASIC 55 lines Level: 3
0001 SUBROUTINE RETURN.SOURCE.PATH(K.GLOBAL.CATDIR,SOURCE.PATH,ERRMSG)
0002 * Return the source path from the end of the GLOBAL.CATDIR opcode
0003 * Will Johnson, March 2013,
0004 * Released under CC-BY-2.0 license
0005 *
0006 * In this next routine, the source location cannot be READ directly
0007 * from the corresponding record in the GLOBAL.CATDIR file if there is
0008 * a ^255 in that record, which truncates the record prematurely.
0009 * Examining the record in the up-arrow mode of the EDitor, we can see
0010 * that the source code location is at the end of the item, and is
0011 * bounded by SEQ(0), but not the last SEQ(0) because they can't make it
0012 * easy can they? So strip off the last two SEQ(0)s, and then get the
0013 * last FIELD and that should be the filepath.
0014 *
0015 * SO in the below code we blockread throwing out any hex FF's (255),
0016 * then retrieve the last attribute of that and then we convert the
0017 * non-printables to periods ("MCP" conversion) and THEN we walk
0018 * backward through it until we just have the last field delimited by two
0019 * non-printables ("."), and that's our filepath. Exhausted yet?
0020 *
0021 EQUATE FALSE TO 0, TRUE TO 1
0022 SOURCE.PATH = ''
0023 ERRMSG = ''
0024 OPENSEQ "GLOBAL.CATDIR",K.GLOBAL.CATDIR TO F.GLOBAL.CATDIR ELSE
0025 ERRMSG = "Can't read this item '":K.GLOBAL.CATDIR:"'"
0026 ERRMSG := " from the GLOBAL.CATDIR file."
0027 RETURN
0028 END
0029 *
0030 DONE = FALSE ; OBJECT.CODE = ''
0031 LOOP
0032 READBLK T.BLOCK FROM F.GLOBAL.CATDIR,1 THEN NULL ELSE
0033 DONE = TRUE
0034 END
0035 UNTIL DONE DO
0036 BEGIN CASE
0037 CASE T.BLOCK = CHAR(255) ; NULL
0038 CASE 1 ; OBJECT.CODE := T.BLOCK
0039 END CASE
0040 REPEAT
0041 S.OBJECT.CODE = DCOUNT(OBJECT.CODE,@AM)
0042 PR.FILE = OCONV(OBJECT.CODE<S.OBJECT.CODE>,"MCP")
0043 *
0044 FILEPATH = '' ; L.PR.FILE = LEN(PR.FILE)
0045 STATE = 0 ; LAST = '' ; I.PR.FILE = L.PR.FILE
0046 LOOP
0047 CH = PR.FILE[I.PR.FILE,1]
0048 FILEPATH = CH:FILEPATH
0049 IF LAST = '.' AND CH = '.' THEN STATE += 1
0050 UNTIL STATE = 2 OR I.PR.FILE = 1 DO
0051 LAST = CH ; I.PR.FILE -= 1
0052 REPEAT
0053 SOURCE.PATH = FILEPATH[3,LEN(FILEPATH)-4]
0054 RETURN
0055 END