pi package ; was our parent a package? jnz sbdc1 ; lhld subsav lxi d,-2 storset labl ; yes, set label so call will use package'd name ; sbdc1: lhld subsav ; reset current tree pointer to father shld tree ; so others can't see inside ; pop psw ; recover # of undefined subprograms inr a sta subdec ; resave ; pop h shld varlit ; restore outer subprogram's varlit number ; pop h shld subsav ; restore old subprogram pointer ; pop psw sta retfnd ; restore outer subprogram's boolean flag ; pop h shld father ; make the granfather the father again ; lxi h,nest dcr m ; exit from a level of nesting ; pop psw sta pkgdec ; recover # undefined package bodies ; mvi a,0ffh ; tell caller we actually processed a declaration ret ; ******************************************************************* * exception_handler ::= * * WHEN exception_choice {| exception_choice} => * * sequence_of_statements * * * exception_choice ::= exception_simple_name | OTHERS * ******************************************************************* ; except$hand: call load$exc$link ; load exception link address mvi a,LEL call emit call emit$to$eos db '$EXC',eos ; load main exception address mvi a,INW call emit ; load raised exception pointer mvi a,ST2 call emit ; store into exception link ; mvi a,LEL call emit call emit$to$eos db '$EXC',eos ; load main exception address mvi a,LIT call emit lxi h,0 call emithl mvi a,ST2 ; reset to null call emit ; call insymbol cpi 63 ; WHEN? jz exc$hnd0 call perror db 126 ; at least one WHEN expected ret ; exchnd0:lhld nxtlbl ; push h ; save a label to the next when clause inx h ; shld nxtlbl ; ; process list of when clauses ; exchnd2:lda token cpi 63 ; WHEN? jnz end$exc ; mvi a,LBL call emit ; label pop h call emithl ; [to next when clause] ; lhld nxtlbl push h inx h ; save for next when clause shld nxtlbl ; xra a