********************************************************************** * Name: ->DIR * Stack: ( Meta --> rrp ) * Desc: Convert meta directory to directory * Author: Rick Grevelle * Mika Heiskanen (works from tempob, fixed stack bug) ********************************************************************** ASSEMBLE CON(1) 8 RPL xNAME \8DDIR :: CK1 CKREAL COERCE DEPTH OVER #2* #>?SKIP SETSTACKERR ( * Too few objects * ) CODE GOSBVL =SAVPTR CD1EX D1=C A=DAT1 A D0=A D0=D0+ 5 A=DAT0 A N C=0 A LC(1) 5+3+5 D=C A memory taken so far C=A A R0=C R0[A] = N GONC TDintoloop TDtypeerr LC(5) =SETTYPEERR GOVLNG =GETPTREVALC TDmemerr GOVLNG =GPMEMERR TDloop R1=C A D1=D1+ 5 A=DAT1 A ->name[i] D0=A A=DAT0 A *DETLEF* LC(5) =DOIDNT ?A#C A GOYES TDtypeerr * Must be IDNT * D0=D0+ 5 C=0 A C=DAT0 B ?C=0 B GOYES + C=C+1 A C=C+C A + C=C+CON A,7 D=D+C A GOC TDmemerr D1=D1+ 5 A=DAT1 A ->ob[i] B=A A D0=A GOSBVL =SKIPOB CD0EX C=C-B A D=D+C A GOC TDmemerr C=R1 A TDintoloop C=C-1 A GONC TDloop C=D A R1=C A memory required ST=0 10 TDretry GOSBVL =CREATETEMP GONC TDgotmem ?ST=1 10 GOYES TDmemerr GOSUB + CON(5) =DOCOL CON(5) =GARBAGE CON(5) =COLA CON(5) =DOCODE REL(5) ->EndOfTD ST=1 10 GOSBVL =SAVPTR C=R1 GOTO TDretry + C=RSTK GOVLNG =GETPTREVALC TDgotmem CD0EX R1=C ->rrp output D1=C LC(N) 13 CON(5) =DORRP CON(3) #7FF CON(5) 0 DAT1=C 13 D1=D1+ 13 C=R0 A N ?C#0 A GOYES + A=R1 A GOVLNG =GPOverWrALp ( --> empty rrp ) + D=C A CD1EX D1=C R2=C A R2[A] = ->lastram-word GOSBVL =D0=DSKTOP C=A A C[A] = ->stack GOC TDlpEnt *DETLEF* * D=D-1 A * GOC TDfinish TDloop2 D0=C RSTK=C AD1EX C=R2 A D1=A A=A-C A DAT1=A A D1=D1+ 5 AD1EX R2=A A D1=A D0=D0+ 5 A=DAT0 A D0=A D0=D0+ 5 C=0 A C=DAT0 B ?C=0 B GOYES + RSTK=C C=C+1 A C=C+C A GOSBVL =MOVEDOWN C=RSTK + DAT1=C B D1=D1+ 2 C=RSTK C=C+CON A,10 D0=C RSTK=C A=DAT0 A B=A A D0=A GOSBVL =SKIPOB C=B A CD0EX C=C-B A GOSBVL =MOVEDOWN C=RSTK TDlpEnt D=D-1 A *DETLEF* GONC TDloop2 TDfinish C=R1 C=C+CON A,8 D1=C A=R2 A=A-C A DAT1=A A GOSBVL =GETPTR C=R0 C=C+C A D=D+C A A=C A C=C+C A C=C+C A C=C+A A AD1EX A=A+C A D1=A A=R1 GOVLNG =OverWrALoop ->EndOfTD ENDCODE ; **********************************************************************