perm filename RECSER[S,AIL]2 blob
sn#100430 filedate 1974-05-04 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00005 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 FANCY SMALL SPACE SERVICE
C00010 00003 SPECIAL FIXED SIZE BLOCK HANDLERS: $FXGET, $FXDEL
C00020 00004 SAIREC -- SYSTEM RECORD HANDLER ROUTINES
C00033 00005 SAIREC -- FLDKIL ROUTINE
C00039 ENDMK
C⊗;
;; FANCY SMALL SPACE SERVICE
COMPIL(SPC,,,,,,DUMMYFORGDSCISS)
DEFINE SPCINS <$FUNLK,$FXBLD,$FXGET,$FXG,$FXDEL,$FXD>
COMPXX(SPC,<$GETB,$GET1B,$DELB,$DEL1B,$FSADD,$FSINS,$FSINI,SPCINS>
,<GOGTAB,X22,X33,CORGET,CORREL>
,<SMALL SPACE SERVICE ROUTINES>,,HIIFPOSIB)
BEGIN SPCSER -- SMALL FREE BLOCK SERVICE
DSCR $GETB,$DELB,$GET1B,$DEL1B,$FSADD,$FSINS,$FUNLK
These routines are generally useful for handling allocation of small
blocks of storage. Essentially, there is a linked list (homed at
$FSLIS(<gogtab>) ) of blocks, each of which specifies a "space".
<prev on chain>,,<next on chain>
<addr of "allocate" routine>
<addr of "deallocate" routine>
< ... miscellaneous info ... >
:
< ... miscellaneous info ... >
Each allocate routine is assumed to take as parameters:
A -- pointer to the space descriptor block
C -- size of request
results:
skip return -- B points to a fresh block of the correct size
no skip return -- failure
Each deallocate routine is assumed to take as parameters:
A -- pointer to the space descriptor block
B -- pointer to block to be released
results:
skip return -- the block release was successful
no skip return -- block release was unsuccessful
Except as stated above, the routines are assumed to have no side effects.
(except possibly to load USER with GOGTAB).
$GET1B acts just like an allocate routine, except that it takes (in A)
a pointer to the first block in a whole list of routines
and returns as its value (in A) a pointer to the descriptor
block of the last allocate routine called.
$DEL1B acts like a deallocate routine except that it takes (in A)
a pointer to the first block in a whole list of routines
and returns as its value (in A) a pointer to the descriptor
block of the last deallocate routine called.
SAIL calling sequence routines that cdr down $FRELIS:
<block>←$GETB(size) ;returns 0 if lose
<result>←$DELB(blockid) ;returns 0 if lose, space id if win
$FSLIS service routines (munch USER,TEMP,LPSA):
$FSADD(<dcsr block>) ; adds named block to $FSLIS
$FSINS(@<list owner>,<block addr>) ;adds named block to named list (at head)
$FUNLK(<dscr block>) ; removes named block from any list
⊗
%GPROC ←← 1 ;GETTING PROC
%DPROC ←← 2 ;DELETING PROC
%FFRXX ←← 3 ;INDEX OF FIRST FREE LOCATION
HEREFK($GETB,$GETB.)
MOVE C,-1(P) ;GET SIZE
MOVE USER,GOGTAB ;
SKIPE A,$FSLIS(USER)
PUSHJ P,$GET1B ;CDR DOWN LIST
TDZA A,A ;NO JOY
MOVE A,B ;THE RESULT
RET22: SUB P,X22
JRST @2(P) ;RETURN
HEREFK($DELB,$DELB.)
MOVE B,-1(P) ;THE BLOCK
MOVE USER,GOGTAB
SKIPE A,$FSLIS(USER)
PUSHJ P,$DEL1B
MOVEI A,0
JRST RET22
GET1B1: HRRZ A,(A) ;PART OF THE $GET1B LOOP
HEREFK($GET1B,$GET1.)
JUMPE A,CPOPJ ;CHECK NULLITUDE
PUSHJ P,@%GPROC(A) ;CALL THE ROUTINE
JRST GET1B1 ;LOOP ON TO NEXT, THIS ONE LOST
CPOPJ1: AOS (P) ;SKIP RETURN IF WIN
CPOPJ: POPJ P, ;RETURN
DEL1B1: HRRZ A,(A) ;SAME KLUGE
HEREFK($DEL1B,$DEL1.)
JUMPE A,CPOPJ ;
PUSHJ P,@%DPROC(A) ;ALLOCATE ROUTINE
JRST DEL1B1 ;LOST, TRY NEXT
JRST CPOPJ1 ;WIN
HEREFK($FSADD,$FSAD.) ;LINKS IN ONE BLOCK
MOVE USER,GOGTAB
MOVEI LPSA,$FSLIS(USER)
PUSH P,LPSA ;THIS IS THE OWNER
PUSH P,-2(P) ;THE RECORD TO ADD
PUSHJ P,$FSINS ;CALL INSERT ROUTINE
JRST RET22 ;GO RETURN
HEREFK($FUNLK,$FUNL.)
MOVE LPSA,-1(P) ;THE BLOCK WE ARE TO UNLINK
MOVE TEMP,(LPSA) ;THE LEFT,,RIGHT
TRNE TEMP,-1 ;IF HAVE A RIGHT HAND
HLLM TEMP,(TEMP) ;LET HIM HOLD MY LEFT
MOVSS TEMP ;SWAP HALVES
HLRM TEMP,(TEMP) ;LET HIM HOLD MY RIGHT
JRST RET22 ;DONE
HEREFK($FSINS,$FSIN.) ;
HRRZ TEMP,-1(P) ;THE THING TO INSERT
HRRZ LPSA,-2(P) ;ADDRESS OF OWNER CELL
HRLM LPSA,(TEMP) ;REMEMBER AS BACK POINTER
EXCH LPSA,(LPSA) ;LPSA IS NOW FWD PTR
TRNE LPSA,-1 ;WAS THE CHAIN NULL?
HRLM TEMP,(LPSA) ;NO HE GETS A BACK PTR TOO
HRRM LPSA,(TEMP) ;OLD HEAD IS NEW RIGHT BROTHER
RET33: SUB P,X33 ;RETURN
JRST @3(P) ;
NOLOW <
NOUP <
REN <
USE
>;REN
FSI: 0
$FSINI
0
LINK %INLNK,FSI
REN <
USE HIGHS
>;REN
>;NOUP
>;NOLOW
HEREFK($FSINI,$FSI..)
SKIPN USER,GOGTAB
ERR <$FSINI CALLED W/O GOGTAB INITIALIZED>
SKIPE $FSLIS(USER)
ERR <$FSINI CALLED WITH THINGS ON $FSLIS>,1
MOVEI C,3 ;JUST A LITTLE BLOCK
PUSHJ P,CORGET
ERR <CORGET DIDN'T GIVE ME ANY>,1
HRRZM B,$FSLIS(USER)
HRLZI C,$FSLIS(USER)
MOVEM C,(B)
MOVEI C,CORGET
MOVEM C,%GPROC(B)
MOVEI C,[PUSHJ P,CORREL
AOS(P)
POPJ P,
]
MOVEM C,%DPROC(B)
POPJ P,
;; SPECIAL FIXED SIZE BLOCK HANDLERS: $FXGET, $FXDEL
DSCR $FXG,$FXD,$FXGET,$FXDEL,$FXSPC,$FXBLD
DES These routines operate on space descriptor blocks of the form:
word 0: left,,right
$FXG
$FXD
blksiz: block size
minsiz: minimum size request to honor
blkcnt: number of blocks per space
usecnt: number of blocks allocated from this space
maxadr: address of last record in this space
frelis: free list of blocks
sublis: a list header word for other blocks with this format
firblk: ... first "data word" in the space ...
:
< blkcnt*blksiz +firblk words of corget space >
:
Note: the "top" such block (Ie the one on the $FSLIS) will usually
contain the routines $FXGET & $FXREL & will have actually no
blocks (ie frelis=0). They will mapcar down their subordinates
looking for customers. The subordinates ($FXG & $FXD) will
work by having brothers. If a $FXG block gets bloated, it
will just fail. If one goes empty, it will just go away.
If all of a $FXGET block's subordinates lose, it just adds a
new one as the left subchild.
A space descriptor block ($FXGET style) may be built by the runtime routine
<block> ← $FXSPC(<block size>,<min size>,<block count>)
Thus a new space for allocating blocks of size 9 to 16 could be
defined & added to $FSLIS by the statement
$FXADD($FXSPC(16,9,32)); ! 32 blocks per buffer;
The routine $FXBLD(@<chain header>,<template block>) makes a fresh
block patterned after the template & puts it on the named chain.
⊗
%FXIX ←← %FFRXX ;FIRST LEGAL FIELD
DEFINE $FXFLD(ID) <
ID ←← %FXIX
%FXIX ←← %FXIX+1
>
$FXFLD %BLKSIZ ;BLOCK SIZE
$FXFLD %MINSIZ ;MIN ACCEPTABLE SIZE
$FXFLD %BLKCNT ;NUMBER OF BLOCKS PER SPACE
$FXFLD %USECNT ;NUMBER OF BLOCKS ALLOCATED FROM THIS SPACE
$FXFLD %MAXADR ;MAX ADDRESS OF A BLOCK IN THIS SPACE
$FXFLD %FRELIS ;FREE LIST
$FXFLD %SUBLIS ;SUBLIST OF SIMILAR BLOCKS
$FXFLD %FIRBLK ;FIRST DATA WORD
HEREFK($FXGET,$FXGE.)
CAMG C,%BLKSIZ(A) ;WOULD IT FIT
CAMGE C,%MINSIZ(A) ;
POPJ P, ;NO
PUSH P,A ;YEP GO DOWN KINDERN
FGTRY: SKIPE A,%SUBLIS(A) ;IF ANY
PUSHJ P,$GET1B ;
JRST ADDAB ;ADD A BLOCK
FGWIN: POP P,A ;I AM SUCH A WINNER
JRST CPOPJ1 ;& GO WIN
;# # RHT ! I HAD LEFT OUT THE RESTORE OF A
ADDAB: MOVE A,(P) ;SINCE A IS ZERO AT THIS POINT
MOVEI B,%SUBLIS(A) ;OWNER OF NEW LIST
PUSH P,B ;BUILD CALL TO $FXBLD
PUSH P,-1(P) ;PUSH A COPY OF A
PUSHJ P,$FXBLD ;MAKES A NEW SPACE FOR $FXG
MOVE A,(P) ;WHERE WE HAD SAVED IT
JRST FGTRY ;GO TRY AGAIN -- EXPECT TO WIN
HEREFK($FXG,$FXG.)
CAMG C,%BLKSIZ(A) ;WOULD IT FIT?
CAMGE C,%MINSIZ(A) ;
POPJ P, ;NO WAY
SKIPN B,%FRELIS(A) ;ONE ON FREE LIST
POPJ P, ;NO SUCH LUCK
AOS %USECNT(A) ;ONE LESS FREE NOW
PUSH P,(B) ;KLUGY WAY TO COPY FREE LIST
POP P,%FRELIS(A) ;PUTS BACK THE NEXT ONE
JRST CPOPJ1 ;GO SKIP RETURN -- WE WIN
HEREFK($FXDEL,$FXDE.)
PUSH P,A ;IN THIS CASE, JUST GO DOWN CHILDREN
SKIPE A,%SUBLIS(A) ;
PUSHJ P,$DEL1B ;LIKE SO
SOS -1(P) ;WILL NA SKIP RETURN
POP P,A ;GET OWN NAME BACK
JRST CPOPJ1 ;I AM A WINNER
HEREFK($FXD,$FXD.)
CAMG B,%MAXADR(A) ;IN RANGE?
CAIG B,(A) ;A IS MY OWN POINTER,REMEMBER
POPJ P, ;NOPE
SOSG %USECNT(A) ;IF THIS WAS THE LAST
JRST BIGKIL ;THEN THE WHOLE BLOCK GOES AWAY
PUSH P,B ;MUST PRESERVE
HRRZS B ;JUST BE SURE RHS ONLY IS ON
EXCH B,%FRELIS(A) ;SAVE AWAY NEW LIST
MOVEM B,@%FRELIS(A) ;& LINK IT TO OLD
POP P,B ;GET BACK
JRST CPOPJ1 ;WHAT WINNAGE!
BIGKIL: PUSH P,LPSA ;SAVE A COUPLE
PUSH P,TEMP ;
PUSH P,B
PUSH P,A ;GO UNLINK THIS BLOCK
PUSHJ P,$FUNLK ;LIKE SO
MOVE B,A ;GO CLOBBER THE WHOLE BLOCK
PUSHJ P,CORREL ;LIKE SO
POP P,B ;A PITY CANNOT JUST ZERO OUT B
POP P,TEMP ;GET ACS BACK
POP P,LPSA ;
JRST CPOPJ1 ;RETURN
HEREFK($FXSPC,$FXSP.)
MOVEI C,%FIRBLK ;HOW BIG IT NEEDS TO BE
PUSHJ P,CORGET ;USE CORGET SPACE FOR THIS (DONT REALLY HAVE TO
ERR <NO CORE TO BE HAD>,1 ; BUT MAY WANT TO DO THIS AT FUNNY TIMES)
MOVE A,B ;WHERE WE WILL RETURN VALUE
HRL B,B ;CLEANSE IT
HRRI B,1(B)
SETZM (B)
BLT B,%FIRBLK-1(A)
MOVEI B,$FXGET ;
MOVEM B,%GPROC(A)
MOVEI B,$FXDEL
MOVEM B,%DPROC(A)
POP P,B
POP P,%BLKCNT(A)
POP P,%MINSIZ(A)
POP P,%BLKSIZ(A)
JRST (B)
HEREFK($FXBLD,$FXBL.)
MOVE A,-1(P) ;MUST ADD A BLOCK
PUSH P,C ;SAVE THIS SIZE REQUEST
PUSH P,TEMP ;SAVE A COUPLE ACS
PUSH P,LPSA ;WHICH WE PROMISSED NOT TO MUNGE
PUSH P,B
SKIPN C,%BLKCNT(A) ;
ERR <IT DOESN'T HELP YOU MUCH TO ALLOCATE ZERO MORE BLOCKS>,1,L1DON
IMUL C,%BLKSIZ(A) ;B ← NOMINAL BLOCK SIZE * COUNT + OVERHEAD
ADDI C,%FIRBLK ;
PUSHJ P,CORGET ;A BLOCK OF THIS GREAT SIZE
ERR <COULDN'T GET ANY MORE SPACE FROM CORGET>,1
MOVEI TEMP,%FIRBLK(A) ;NOW CHAIN ALL SUB-BLOCKS TOGETHER
MOVEI LPSA,0 ;
MOVE C,%BLKCNT(A) ;SO WE WILL COUNT DOWN
MOVEM C,%BLKCNT(B) ;ALSO, THE BLOCK COUNT FOR THIS
L1B: MOVEM LPSA,(TEMP) ;POINT TO NEXT
MOVE LPSA,TEMP ;REMEMBER THE BACK POINTER
ADD TEMP,%BLKSIZ(A) ;NEXT BLOCK
SOJG C,L1B ;COUNT DOWN TO ZERO
L1DON: MOVEM LPSA,%FRELIS(B) ;THIS IS THE FIRST FREE
MOVEM LPSA,%MAXADR(B) ;ALSO THE MAX ADDRESS BLOCK IN THIS SPACE
SETZM %USECNT(B) ;USE COUNT IS ZERO
SETZM %SUBLIS(B) ;THE SUBLIST IS ZERO
MOVE LPSA,%MINSIZ(A) ;COPY THESE, TOO (HRROI POP IS FASTER
MOVEM LPSA,%MINSIZ(B) ;BUT THIS ALLOWS EASIER REARRANGEMENT)
MOVE LPSA,%BLKSIZ(A) ;
MOVEM LPSA,%BLKSIZ(B) ;
MOVEI LPSA,$FXG ;THE HANDLERS FOR THESE
MOVEM LPSA,%GPROC(B) ;REMEMBER THE HANDLER
MOVEI LPSA,$FXD
MOVEM LPSA,%DPROC(B) ;
PUSH P,-6(P) ;GO LINK ONTO THIS ADDRESS
PUSH P,B ;THE BLOCKID
PUSHJ P,$FSINS ;USING THE STANDARD INSERTER
POP P,B
POP P,LPSA ;GET ACS BACK
POP P,TEMP ;
POP P,C ;
SUB P,X33
JRST @3(P) ;RETURN
BEND SPCSER
ENDCOM (SPC)
;; SAIREC -- SYSTEM RECORD HANDLER ROUTINES
COMPIL(REC,<$REC$,FLDKIL,$RERR>
,<RECQQ,ALLFOR,ARYEL,CORGET,CORREL,X11,GOGTAB,$DEL1B,$GET1B>
,<SAIL RECORD HANDLER>,<$RDREF,$RALLO>);
REGL2:
BEGIN RECORD
;;$REC$ CALLED VIA PUSH P,[OP]
; PUSH P,ARG1
; PUSH P,ARG2
; PUSHJ P,$REC$ ;(OR @<RECORD HEADER>)
; IS ASSUMED TO WIPE OUT THE ACS
$RDISP: JRST $RDREF ;DEREFERENCE ARG1
JRST $RALLO ;ALLOCATE RECORD WITH CLASS ARG1
$RMAX ←← (.-$RDISP)-1
HEREFK($REC$,$REC$.)
POP P,C ;RET ADR
POP P,B
POP P,A
EXCH C,(P) ; NOW C=OP, A=ARG1, B=ARG2
CAILE C,$RMAX
POPJ P,
JUMPN C,@$RDISP(C) ; OBEY COMMAND
↑↑$RDREF:
SKIPE A ; HAVE ONE?
SOSLE -1(A) ; YEP, DECREMENT COUNT
POPJ P, ; RETURN
PUSH P,A ; SO CAN LATER CALL CORREL
HRRZ C,(A) ; CLASS ADDRESS
ADDI A,1 ; FIRST DATA ELEMENT
SUBI C,(A) ; CORRECTION FACTOR
HRLI C,(<POINT =13,(A),=12>); DESCRIPTOR TO GET BITS
PUSH P,C
GETFLD: LDB C,(P) ; GET FIELD
JUMPE C,NOMORE ; NO MORE FIELDS LEFT
DPB C,[POINT =13,A,=12] ; PUT DESCRIPTOR BITS IN PLACE
PUSHJ P,FLDKIL ; GO KILL THIS FIELD
AOJA A,GETFLD ; GO ON TO NEXT
NOMORE: SUB P,X11 ; JUST POP ONE OFF
POP P,B ; THE CORREL POINTER
SUBI B,1 ; NOW IT IS (THE REF CNT WORD, REMEMBER)
MOVE USER,GOGTAB ; FREE THE SPACE UP
MOVE A,$FSLIS(USER) ; BY CALLING THE FREER-UPPER
PUSHJ P,$DEL1B ;
ERR <CONFUSION IN FREEING A BLOCK>,1
POPJ P,
↑↑$RALLO:
LDB C,[POINT =13,(A),=12] ; A = RECORD CLASS ID. GET THE WORD COUNT
ADDI C,1 ; C = NUMBER OF WORDS+1 FOR REFCNT
HRLI A,20 ; INDIREC BIT
PUSH P,A ; EVENTUALLY, BECOMES THE RECID POINTER
MOVE USER,GOGTAB ; GET THE SYSTEM FREE LIST
MOVE A,$FSLIS(USER) ;
PUSHJ P,$GET1B ; MAY WANT MORE EFFICIENCY LATER
ERR <NO CORE FOR RECORD ALLOCATION>,1,ZPOPJ
MOVEI A,1(B) ;THE POINTER WE WILL ACTUALLY RETURN
ADDI C,(B) ;STOPPING PLACE
SETZM (B); ;ZERO OUT (ALSO REF CNT ← 0)
HRL B,B ;BUILD BLT PTR
HRRI B,1(B)
BLT B,(C) ;BLT THEM AWAY
AOS -1(A) ;BUMP REF CNT
POP P,(A) ;THE RECID POINTER
POPJ P, ;RETURN
ZPOPJ: MOVEI A,0
POPJ P,
HEREFK($RERR,$RERR.)
ERR <ACCESS TO A SUBFIELD OF A NULL RECORD>,1
POPJ P,
;; SAIREC -- FLDKIL ROUTINE
HEREFK(FLDKIL,.FLDKI)
;CALLED WITH REFITEM TYPE DESCRIPTOR IN A
;WILL TAKE ALL APPROPTIATE ACTION
;IF TMPB IS ON IN A, THEN ASSUMES THAT CALLED FROM LEAP
; -- THUS, IF TMPB AND NOT REFB, WILL DO THE RIGHT THING
; ABOUT ONE & TWO WORD FREES
;PRESERVES A BUT ALL OTHERS MAY BE MUNGED
TLNN A,REFB ; IF REFB ON, THEN NO DELETION REQUIRED
SKIPN @A ; NOTHING TO DO IF A NULL
POPJ P,
TLNE A,ARY2B ;ITEMVAR ARRAY ??
JRST ARYKIL ;YEP
TLNN A,ITEMB ;NOTHING TO DO IF ITEM
TLNE A,PROCB ;OR PROCEDURE
POPJ P,
LDB TEMP,[POINT 6,A,=12] ; SIX BIT TYPE
CAIL TEMP,INVTYP ;VERIFY VALID
ERR <DRYROT -- INVALID REFERENCE TYPE IN FLDKIL>,5,RPOPJ
CAIG TEMP,MXSTYP ;IS THIS A LEGAL ARRAY TYPE ??
JRST @FKDISP(TEMP) ;NOPE DO WHATEVER YOU MUST
MOVEI TEMP,@FKDISP-ARRTYP(TEMP) ;FIND OUT WHAT SORT OF ARRAY YOU HAVE
CAIN TEMP,WZAPR ;A DONOTHING ??
JRST ARYKIL ;YEP
PUSH P,A ;HERE MUST CALL SELF RECURSIVELY TO
MOVEI A,@A ;PROCESS EACH ARRAY ELEMENT
PUSH P,TEMP ;ROUTINE TO CALL
HRRZ TEMP,-1(A) ;COUNT
JUMPE TEMP,NOELS ;NONE
PUSH P,TEMP ;SAVE COUNT
DEL1EL: SKIPE (A) ;HAVE ONE
PUSHJ P,@-1(P) ;CALL THE ROUTINE
SOSG (P) ;DECREMENT THE COUNT
AOJA A,DEL1EL ;DELETE ONE ELEMENT
POP P,TEMP ;GET THIS OFF
NOELS: POP P,TEMP ;GET THIS OFF, TOO.
JRST .+2 ;MAY AS WELL LEAVE A ON THE STACK
ARYKIL: PUSH P,A ;SINCE ARYEL CLOBBERS IT
PUSH P,@A ;CALL TO ARYEL
SETZM @A ;ZAP IT
PUSHJ P,ARYEL ;KILL THE ARRAY
POP P,A ;OH WELL, GET A BACK
POPJ P, ;RETURN FROM KILLING THE ARRAY
FKDISP: WZAPR ;ACTUALLY A NOTHING
WZAPR ;1 UNTYPED
WZAPR ;2 BTRIP
WZAPR ;3 STRING
WZAPR ;4 REAL
WZAPR ;5 INTEGER
WSLKL ;6 SET
WSLKL ;7 LIST
WZAPR ;8 PROCEDURE ITEM
WZAPR ;9 PROCESS ITEM
WZAPR ;10 EVENT TYPE
WCTXTK ;11 CONTEXT
WZAPR ;12 REFITEM
WRDRF ;13 RECORD DEREFERENCING
WSLKL: SKIPN B,@A ;DO WE HAVE ONE
JRST WZAPR ;NOPE JUST WORRY ABOUT FREES
PUSH P,A ;WHO KNOWS WHAT EVIL LURKS IN THE HEART OF LEAP
SETZM @A ;CLEAR IT OUT
MOVE A,B ;
MOVEI 5,0 ;ALL SET UP
PUSHJ P,RECQQ ;RELEASE THE SET OR LIST
POP P,A ;GET A BACK
JRST WZAPR
WCTXTK: SKIPN B,@A ;HAVE ONE
POPJ P, ;YEP
SETZM @A ;
PUSH P,A ;KILLING A CONTEXT
PUSH P,B
PUSHJ P,ALLFOR ;FORGET IT
POP P,A ;GET BACK A
JRST WZAPR
WRDRF: PUSH P,A ;SAVE
MOVE A,@A ; DO DEREFERENCE
PUSHJ P,$RDREF ;CALL DEREFERENCER
POP P,A ;GET A BACK
;FALL INTO WZAPR
WZAPR: TLNN A,TMPB ;CALLING FROM LEAP ???
RPOPJ: POPJ P, ;
;MUST WORRY ABOUT LEAPISHNESS
ERR <FLDKIL NOT YET READY FOR CALL FOR REFITEMS>,1,RPOPJ
BEND RECORD
ENDCOM(REC)