プチコンは、プログラムが終了しても、変数がクリアされません。そのため、大抵の場合は初期化のために "CLEAR" を最初の方で呼びます。
これを逆手にとって "CLEAR" しないと、他のプログラムで前のプログラムが使用した結果の変数を使うことができます。たとえばこんな感じです。
PRG1 がこんなのだったとします。
A=1
B=5
EXEC "PRG2"
そして PRG2 はこんなのだとします。
C=A+B
EXEC "PRG3"
最後に PRG3 はこうしときます。
PRINT C
PRG1 を LOAD して RUN すると、結果は 6 と表示され、終了時は PRG3 がロードされています。
さて、ここで、PRG3 で結果を表示するのではなく、元の PRG1 で表示させれば、PRG2 はサブルーチンとみることができます。これを実現するには PRG1 をこうします。
IF FLAG THEN @P
A=1
B=5
EXEC "PRG2"
@P
PRINT C
そして、PRG2 はこうします。
C=A+B
FLAG=TRUE
EXEC "PRG1"
PRG1 で初めて呼ばれたのか、2回目以上なのかを判断して、表示処理に飛んでいます。
これを一歩進めて、汎用性を持たせてみました。関数のように使えて、再帰もできます。要は、スタックとプログラムカウンタを自前で管理するようなものです。
- PRG:MAIN
REM
REM PRG:MAIN
REM
'
REM
REM Check it is first time or not.
REM
' In case pop up
IF _ST_POP THEN GOTO _RLBL$
' Here comes only first time.
IF _ST_INIT THEN @INIT_END
REM
REM Initialize
REM
@INIT
CLEAR
_ST_SIZE=20 ' STACK SIZE
_ST_ARGS=10 ' MAX ARGMENT NUM
DIM _ST_ARGC(_ST_SIZE) ' ARGUMENTS COUNT
DIM _ST_ARGV(_ST_SIZE,_ST_ARGS) ' ARGUMENTS
DIM _ST_RETV(_ST_SIZE) ' RETURN VALUE
DIM _ST_CPRG$(_ST_SIZE) ' PROGRAM TO CALL
DIM _ST_RPRG$(_ST_SIZE) ' PROGRAM TO BACK
DIM _ST_RLBL$(_ST_SIZE) ' LABEL FOR BACK
_ST_POP=FALSE ' POP=TRUE / PUSH=FALSE
_ST_CNT=-1 ' STACK DEPTH
_ST_INIT=TRUE ' FLAG
' FOR TEMPORARY USE
DIM _AV(_ST_ARGS) ' ARGUMENTS
_AC=0 ' LOCAL ARGUMENTS COUNT
_CALL$="" ' PROGRAM TO CALL
_RPRG$="" ' PROGRAM TO RETURN
_RLBL$="" ' LABEL TO RETURN
_RET=0
@INIT_ENDREM
REM Call ADD program
REM
_AC=2
_AV(0)=4
_AV(1)=6
_CALL$="ADD"
_RLBL$="@ADD_R"
GOTO @_PUSH
@ADD_R
PRINT _AV(0);" + ";_AV(1);" = ";_RETREM Call FACT program
_AC=1
_AV(0)=5
_CALL$="FACT"
_RLBL$="@FACT_R"
GOTO @_PUSH
@FACT_R
PRINT _AV(0);"! =";_RET
END'------------------------------
@_PUSH
_ST_CNT=_ST_CNT+1
_ST_ARGC(_ST_CNT)=_AC
FOR _I=0 TO _AC-1
_ST_ARGV(_ST_CNT,_I)=_AV(_I)
NEXT _I
_ST_CPRG$(_ST_CNT)=_CALL$
_ST_RLBL$(_ST_CNT)=_RLBL$
_ST_RPRG$(_ST_CNT)=PRGNAME$
_ST_POP=FALSE
EXEC _CALL$@_POP
' GET VALUES
_RET=_ST_RETV(_ST_CNT)
_AC=_ST_ARGC(_ST_CNT)
FOR _I=0 TO _AC-1
_AV(_I)=_ST_ARGV(_ST_CNT,_I)
NEXT _I
_RLBL$=_ST_RLBL$(_ST_CNT)
_RPRG$=_ST_RPRG$(_ST_CNT)
' CLEAR LAST STACK
FOR _I=0 TO _AC-1
_ST_ARGV(_ST_CNT,_I)=0
NEXT _I
_ST_ARGC(_ST_CNT)=0
_ST_RETV(_ST_CNT)=0
_ST_CPRG$(_ST_CNT)=""
_ST_RLBL$(_ST_CNT)=""
_ST_RPRG$(_ST_CNT)=""
' POP UP
IF ST_CNT==-1 THEN GOTO _RLBL$
_ST_CNT=_ST_CNT-1
_ST_POP=TRUE
EXEC _RPRG$
- PRG:ADD
REM ADD
REM Add two numbers.' Get two numbers
_VAL1=_ST_ARGV(_ST_CNT,0)
_VAL2=_ST_ARGV(_ST_CNT,1)' Calc
_RET=_VAL1+_VAL2' Set return value.
_ST_RETV(_ST_CNT)=_RET
PRINT PRGNAME$;": _VAL1=";_VAL1;", _VAL2=";_VAL2
GOTO @_POP'------------------------------
@_PUSH
_ST_CNT=_ST_CNT+1
_ST_ARGC(_ST_CNT)=_AC
FOR _I=0 TO _AC-1
_ST_ARGV(_ST_CNT,_I)=_AV(_I)
NEXT _I
_ST_CPRG$(_ST_CNT)=_CALL$
_ST_RLBL$(_ST_CNT)=_RLBL$
_ST_RPRG$(_ST_CNT)=PRGNAME$
_ST_POP=FALSE
EXEC _CALL$@_POP
' GET VALUES
_RET=_ST_RETV(_ST_CNT)
_AC=_ST_ARGC(_ST_CNT)
FOR _I=0 TO _AC-1
_AV(_I)=_ST_ARGV(_ST_CNT,_I)
NEXT _I
_RLBL$=_ST_RLBL$(_ST_CNT)
_RPRG$=_ST_RPRG$(_ST_CNT)
' CLEAR LAST STACK
FOR _I=0 TO _AC-1
_ST_ARGV(_ST_CNT,_I)=0
NEXT _I
_ST_ARGC(_ST_CNT)=0
_ST_RETV(_ST_CNT)=0
_ST_CPRG$(_ST_CNT)=""
_ST_RLBL$(_ST_CNT)=""
_ST_RPRG$(_ST_CNT)=""
' POP UP
IF ST_CNT==-1 THEN GOTO _RLBL$
_ST_CNT=_ST_CNT-1
_ST_POP=TRUE
EXEC _RPRG$
- PRG:FACT
区切り線以降はどれも共通です。実行結果はこんなふうになります。
REM PRG:FACT
REM Calc factorial recursively' Check called or returned
IF _ST_POP THEN GOTO _RLBL$ ELSE @FACT' Call recursively
@FACT
' Get argment value
_VAL1=_AV(0)
PRINT PRGNAME$;": _ST_CNT=";_ST_CNT;", _VAL1=";_VAL1
' Call recursively until zero
IF _VAL1==1 THEN _ST_RETV(_ST_CNT)=1:PRINT PRGNAME$;": _ST_CNT=";_ST_CNT;", _RET=1":GOTO @_POP
_AC=1
_AV(0)=_VAL1-1
_CALL$="FACT"
_RLBL$="@FACT_R"
GOTO @_PUSH' Return multiplied value with priori
@FACT_R
_ST_RETV(_ST_CNT)=_RET*_ST_ARGV(_ST_CNT,0)
PRINT PRGNAME$;": _ST_CNT=";_ST_CNT;", _RET=";_ST_RETV(_ST_CNT)
GOTO @_POP'------------------------------
@_PUSH
_ST_CNT=_ST_CNT+1
_ST_ARGC(_ST_CNT)=_AC
FOR _I=0 TO _AC-1
_ST_ARGV(_ST_CNT,_I)=_AV(_I)
NEXT _I
_ST_CPRG$(_ST_CNT)=_CALL$
_ST_RLBL$(_ST_CNT)=_RLBL$
_ST_RPRG$(_ST_CNT)=PRGNAME$
_ST_POP=FALSE
EXEC _CALL$@_POP
' GET VALUES
_RET=_ST_RETV(_ST_CNT)
_AC=_ST_ARGC(_ST_CNT)
FOR _I=0 TO _AC-1
_AV(_I)=_ST_ARGV(_ST_CNT,_I)
NEXT _I
_RLBL$=_ST_RLBL$(_ST_CNT)
_RPRG$=_ST_RPRG$(_ST_CNT)
' CLEAR LAST STACK
FOR _I=0 TO _AC-1
_ST_ARGV(_ST_CNT,_I)=0
NEXT _I
_ST_ARGC(_ST_CNT)=0
_ST_RETV(_ST_CNT)=0
_ST_CPRG$(_ST_CNT)=""
_ST_RLBL$(_ST_CNT)=""
_ST_RPRG$(_ST_CNT)=""
' POP UP
IF ST_CNT==-1 THEN GOTO _RLBL$
_ST_CNT=_ST_CNT-1
_ST_POP=TRUE
EXEC _RPRG$
ただし、弱点もありまして、GOSUB で飛んだ途中では使えません。 RETURN without GOSUB になってしまいます。RETURN の前に戻らなければいいのかもしれませんが、GOSUB を呼びっぱなしってのも気持ち悪いので。
