home *** CD-ROM | disk | FTP | other *** search
- OPT OSVERSION=37
-
- ENUM T_VOID,T_PTR_TO_CHAR,T_PTR_TO_TagItem
-
- PROC main()
- DEF myargs:PTR TO LONG,rdargs,dest[256]:STRING,src[256]:STRING
- myargs:=[NIL]
- IF rdargs:=ReadArgs('SOURCE/A',myargs,NIL)
- StringF(src,'\s.fd',myargs[0])
- StringF(dest,'\s.m',myargs[0])
- xConvert(src,dest)
- FreeArgs(rdargs)
- ELSE
- PrintFault(IoErr(),'fd2m')
- ENDIF
- ENDPROC
-
- PROC xConvert(src:PTR TO CHAR,dst:PTR TO CHAR)
- DEF s,d,m,l
- IF s:=Open(src,OLDFILE)
- IF d:=Open(dst,NEWFILE)
- IF m:=New(l:=FileLength(src))
- Read(s,m,l)
- xProcess(d,m,l)
- Dispose(m)
- ENDIF
- Close(d)
- ELSE
- PrintFault(IoErr(),'fd2m')
- ENDIF
- Close(s)
- ELSE
- PrintFault(IoErr(),'fd2m')
- ENDIF
- ENDPROC
-
- PROC xProcess(o,src:PTR TO CHAR,length)
- DEF pos=0,offset,public,name[256]:STRING,l,next,nofirst
- DEF argtype[16]:ARRAY OF CHAR,p,q
- WHILE pos<length
- IF src[pos]="*"
- pos:=xNextLine(src,pos,length)
- ELSEIF And(src[pos]="#",src[pos+1]="#")
- WriteF('##\d\n',pos)
- pos:=pos+2
- IF StrCmp(src+pos,'base',4)
- VfPrintf(o,'LIBRARY ',NIL)
- nofirst:=FALSE
- Flush(o)
- Write(o,src+pos+6,xWordLength(src,pos+6,length))
- pos:=xNextLine(src,pos,length)
- ELSEIF StrCmp(src+pos,'bias',4)
- offset:=Val(src+pos+5)
- pos:=xNextLine(src,pos,length)
- ELSEIF StrCmp(src+pos,'public',6)
- public:=TRUE
- pos:=xNextLine(src,pos,length)
- ELSEIF StrCmp(src+pos,'private',7)
- public:=FALSE
- pos:=xNextLine(src,pos,length)
- ELSEIF StrCmp(src+pos,'end',3)
- RETURN
- ENDIF
- ELSE
- -> WriteF('\d\n',pos)
- IF public
- StrCopy(name,src+pos,l:=xWordLength(src,pos,length))
- pos++ -> skip "("
- IF nofirst THEN VfPrintf(o,',',NIL)
- nofirst:=TRUE
- VfPrintf(o,'\n\t\s(',[name])
- p:=0
- WHILE src[pos]<>")"
- argtype[p]:=T_VOID
- IF StrCmp(src+pos,'title',STRLEN)
- argtype[p]:=T_PTR_TO_CHAR
- q:=5
- ELSEIF StrCmp(src+pos,'name',STRLEN)
- argtype[p]:=T_PTR_TO_CHAR
- q:=4
- ELSEIF StrCmp(src+pos,'text',STRLEN)
- argtype[p]:=T_PTR_TO_CHAR
- q:=4
- ELSEIF StrCmp(src+pos,'tags',STRLEN)
- argtype[p]:=T_PTR_TO_TagItem
- q:=4
- ELSEIF StrCmp(src+pos,'taglist',STRLEN)
- q:=7
- argtype[p]:=T_PTR_TO_TagItem
- ELSE
- REPEAT
- pos++
- UNTIL Or(src[pos]=",",src[pos]=")")
- q:=0
- ENDIF
- pos:=pos+q
- IF src[pos]=","
- pos++ -> skip ","
- ENDIF
- p++
- IF CtrlC() THEN RETURN
- ENDWHILE
- pos++ -> skip ")"
- pos++ -> skip "("
- IF src[pos]<>")"
- next:=TRUE
- p:=0
- WHILE next
- IF Or(src[pos]="a",src[pos]="A") THEN VfPrintf(o,'a',NIL)
- IF Or(src[pos]="d",src[pos]="D") THEN VfPrintf(o,'d',NIL)
- IF And(Or(src[pos]="f",src[pos]="F"),Or(src[pos]="p",src[pos]="P")) THEN VfPrintf(o,'fp',NIL)
- pos++
- IF And(src[pos]>="0",src[pos]<="7") THEN VfPrintf(o,'\d',[Char(src+pos)-"0"])
- pos++
- q:=argtype[p]
- SELECT q
- CASE T_PTR_TO_CHAR ; VfPrintf(o,':PTR TO CHAR',NIL)
- CASE T_PTR_TO_TagItem ; VfPrintf(o,':PTR TO TagItem',NIL)
- ENDSELECT
- next:=IF Or(src[pos]=",",src[pos]="/") THEN TRUE ELSE FALSE
- IF next THEN VfPrintf(o,',',NIL)
- pos++
- p++
- IF CtrlC() THEN RETURN
- -> WriteF('\d\n',pos)
- ENDWHILE
- ENDIF
- VfPrintf(o,')(d0)=-\d',[offset])
- offset:=offset+6
- ENDIF
- pos:=xNextLine(src,pos,length)
- ENDIF
- IF CtrlC() THEN RETURN
- ENDWHILE
- VfPrintf(o,'\n',NIL)
- ENDPROC
-
- PROC xNextLine(src:PTR TO CHAR,pos,length)
- WHILE src[pos]<>"\n"
- pos++
- EXIT pos>length
- IF CtrlC() THEN RETURN
- ENDWHILE
- ENDPROC pos+1 -> skip "\n"
-
- PROC xWordLength(src:PTR TO CHAR,pos,length)
- DEF l=0
- WHILE xIsAlpha(src[pos])
- l++
- pos++
- EXIT pos>length
- IF CtrlC() THEN RETURN
- ENDWHILE
- ENDPROC l
-
- PROC xIsAlpha(c) IS IF Or(Or(Or(And(c>="A",c<="Z"),And(c>="a",c<="z")),And(c>="0",c<="9")),c="_") THEN TRUE ELSE FALSE
-