.TITLE DIRECTIVE PROCESSING .ENABLE DEBUG .SUBTITLE COMMENTS ; ; THIS MODULE ADDED AT V3.28, NO VERSION NUMBERS PUT IN AT ; CREATION-UNMARKED LINES ARE ASSUMED TO BE 3.28. ; ; As directives appear in the same cntext as comments, and ; can appear anywhere includeing in the middle of a continued ; executeable line-handle here in one phase only without ; converting to tokens for a second phase as the non directive ; executeable source is. ; handle all that stuff here. ; .PAGE .SUBTITLE COMPILER DIRECTIVE DATA AREA .PSECT DIRECTIVE_DATA,RD,WRT,NOEXE,NOSHR,CON,GBL,NOVEC,LONG data_line: .blkb 132 descripter: .long 0,0 str_des: .long 0 .address data_line common_name: .blkb 31 var_name: .blkb 31 store_psect_arg:.long 4 .address descripter .address comp_how_used .address line_number ;reffers to global symbol in table .address comp_flags comp_how_used: .long token_eval_psect comp_flags: .long symbol_flag_common_name parallel_used: .long 0 parren_level: .long 0 var_flags: .long 0 store_var_arg: .long 4 .address descripter .address parallel_used .address line_number .address var_flags store_com_arg: .long 4 .address descripter .address parallel_used .address line_number .address comp_flags .page .subtitle compiler directive code-decide type .psect directive_code,rd,nowrt,exe,shr,con,gbl,novec,long .entry eval_directive_compiler,^m ; set up pointers to line to be parsed movc5 #0,null,#0,#132,data_line ;zero out target movl 4(ap),r11 movzwl (r11),r10 ;get size movl 4(r11),r11 ;get address addl2 #5,r11 subl2 #5,r10 ; squeese out the blanks ; r9 is counter ; r8 is sourcepointer ; r7 is dest pointer movl r10,r9 movl r11,r8 movab data_line,r7 1$: cmpb #^a/!/,(r8) bgtr 2$ cmpb #^a/~/,(r8) blss 2$ movb (r8),(r7)+ 2$: incl r8 decl r9 bgtr 1$ subl3 #data_line,r7,r8 ;calc squeesed size movl r8,str_des pushal str_des pushal str_des calls #2,g^str$upcase ; hold size in r8 untill after casel moval directive_compiler_table,r9 movl #number_of_compiler,r7 ; scan for directive type 3$: cmpc3 (r9),@4(r9),data_line bneq 10$ movzwl 2(r9),r9 ;got match-save token value brw 20$ 10$: decl r7 addl2 #8,r9 bgtr 3$ ; if we got here-not a valid directive-just skip it ret 20$: subl3 #7000,r9,r0 incl directive_stat[r0] casel r9,#7000,# 22$: .word dir_ident-22$ .word dir_psect-22$ .word dir_title-22$ .word dir_subtitle-22$ ret .page .subtitle compiler directives-string types dir_ident: moval directive_ident,r8 tstb (r8) beql dir_comp_str ret dir_title:moval directive_title,r8 brb dir_comp_str dir_subtitle: moval directive_subtitle,r8 dir_comp_str: movl 4(ap),r11 ; locate start of string movzwl (r11),r10 movl 4(r11),r11 locc #^A/'/,r10,(r11) bneq 26$ ret 26$: incl r1 ; copy string movl #31,r2 27$: cmpb #^a/'/,(r1) ;is it a "'" bneq 28$ cmpb #^a/'/,1(r1) ;is it a double "''" beql 29$ 31$: clrb (r8)+ ;no-done-clear rest of string decl r2 bgtr 31$ ret 29$: movb (r1)+,(r8)+ ;yes-use one in string incl r1 ;skip second brb 30$ 28$: movb (r1)+,(r8)+ ;copy char 30$: decl r2 ;max is 31 chrs bgtr 27$ ;repeat till done ret .page .subtitle compiler directive-psect dir_psect: movl r8,r10 moval data_line,r11 ; locate start of string locc #^A?/?,r10,(r11) bneq 26$ ;no name-skip ret 26$: incl r1 ;skip to start of common name cmpb #^a?/?,(r1) ;see if blank common beql 1$ ;yes clrl descripter movl #31,r9 moval common_name,r8 movl r8,descripter+4 27$: movb (r1)+,(r8)+ incl descripter cmpb #^a?/?,(r1) beql 28$ decl r9 bgtr 27$ 28$: callg store_psect_arg,store_symbol ret 1$: movzbl blank_common_string,descripter moval blank_common_string+1,descripter+4 callg store_psect_arg,store_symbol ret .page .subtitle parallel directive code-setup .psect directive_code,rd,nowrt,exe,shr,con,gbl,novec,long .entry eval_directive_parallel,^m ; see if parallel switch was used bitl #parallel_flag,flag_word+4 bneq 5$ ret ;no-don't bother with them 5$: movc5 #0,null,#0,#132,data_line ;zero out target clrl parren_level ;init paren level movl 4(ap),r11 movzwl (r11),r10 ;get size movl 4(r11),r11 ;get address addl2 #5,r11 subl2 #5,r10 ; squeese out the blanks and other non printing chars ; r9 is counter ; r8 is sourcepointer ; r7 is dest pointer movl r10,r9 movl r11,r8 movab data_line,r7 1$: cmpb #^a/!/,(r8) bgtr 2$ cmpb #^a/~/,(r8) blss 2$ movb (r8),(r7)+ 2$: incl r8 decl r9 bgtr 1$ subl3 #data_line,r7,r8 ;calc squeesed size movl r8,str_des pushal str_des pushal str_des calls #2,g^str$upcase moval directive_parallel_table,r9 movl #number_of_parallel,r7 ; scan for directive type 3$: cmpc3 (r9),@4(r9),data_line bneq 10$ movzwl (r9),r0 movzwl 2(r9),r9 ;got match-save token value subl2 r0,r8 ;get number of remaining chrs in squeezed line addl3 r0,#data_line,r7;start of rest of line brw 20$ 10$: decl r7 addl2 #8,r9 bgtr 3$ ; if we got here-not a valid directive-just skip it ret ; key registers are ; r8 # of chars remaining to be parsed ; r7 starting loc of rest of squeesed string 20$: subl3 #7000,r9,r0 incl directive_stat[r0] casel r9,#<7000+number_of_compiler>,# 30$: .word par_ctx_shr_all-30$ .word par_ctx_shr-30$ .word par_do_par-30$ .word par_lockon-30$ .word par_lockoff-30$ .word par_shr_all-30$ .word par_shr-30$ .word par_priv_all-30$ .word par_priv-30$ ret ;shouldn't get here .page .subtitle parallel directives with no further processing par_ctx_shr_all: par_shr_all: par_priv_all: ret .page .subtitle lockon/off,do_parallel,context_shared par_lockon: movl #token_eval_lockon,parallel_used brb par_lock par_lockoff: movl #token_eval_lockoff,parallel_used brb par_lock par_do_par: movl #token_eval_do_parallel,parallel_used brb par_lock par_ctx_shr: movl #token_eval_context_shared,parallel_used par_lock: ; scan one var or record with possable vars in parrens 1$: tstl r8 bleq 10$ tstb (r7) beql 10$ cmpb #^a/(/,(r7) bneq 2$ incl r7 decl r8 incl parren_level brb 1$ 2$: cmpb #^a/)/,(r7) bneq 3$ incl r7 decl r8 decl parren_level brb 1$ 3$: cmpb #^a/A/,(r7) bleq 4$ incl r7 decl r8 brb 1$ 4$: cmpb #^a/Z/,(r7) bgeq 5$ incl r7 decl r8 brb 1$ 5$: calls #0,scan_one_var brb 1$ 10$: ret .page .subtitle shared par_shr: movl #token_eval_shared,parallel_used ; scan one common name 1$: tstl r8 bleq 10$ tstb (r7) beql 10$ cmpb #^a/A/,(r7) bleq 4$ incl r7 decl r8 brb 1$ 4$: cmpb #^a/Z/,(r7) bgeq 5$ incl r7 decl r8 brb 1$ 5$: calls #0,scan_one_common brb 1$ 10$: ret .page .subtitle private (mix of var name and common name) par_priv: movl #token_eval_private,parallel_used 1$: tstl r8 ;check for end of line bleq 10$ tstb (r7) beql 10$ cmpb #^a/,/,(r7) ;skip commas bneq 2$ incl r7 decl r8 brb 1$ 2$: cmpb #^a?/?,(r7) ;see if common dec bneq 3$ incl r7 decl r8 beql 10$ calls #0,scan_one_common incl r7 decl r8 ;skip trailing common '/' brb 1$ 3$: calls #0,scan_one_var incl r7 decl r8 ;skip trailing "," if any bgtr 1$ 10$: ret ;done .page .subtitle scan one var and insert as required .entry scan_one_var,^m ; r7,r8 are modified so that after the scan, they point to ; the loc following var scanned clrl descripter moval var_name,descripter+4 moval var_name,r11 ; ; move var name till end of string,or non a-z,0,9,$,_ ; ; r11 target address-nex loc to store ; r8 remaining bytes to scan ; r7 next src char to scan ; ; first char must be a-z cmpb #^a/A/,(r7) bgtr 7$ cmpb #^a/Z/,(r7) bgeq 3$ 7$: ret ;if not-do nothing 1$: cmpb #^a/$/,(r7) beql 3$ cmpb #^a/_/,(r7) beql 3$ cmpb #^a/0/,(r7) bgtr 2$ cmpb #^a/9/,(r7) bgeq 3$ cmpb #^a/A/,(r7) bgtr 2$ cmpb #^a/Z/,(r7) blss 2$ 3$: movb (r7)+,(r11)+ incl descripter decl r8 bleq 2$ cmpl #31,descripter bgtr 1$ ; finshed scan of var name 2$: callg store_var_arg,store_symbol ; next we scan untill delimiter found-incase of record ; end on non a-z,0-9,$,_,"." 4$: tstl r8 ;check for end of line bleq 6$ tstb (r7) beql 6$ cmpb #^a/$/,(r7) beql 5$ cmpb #^a/_/,(r7) beql 5$ cmpb #^a/./,(r7) beql 5$ cmpb #^a/0/,(r7) bgtr 6$ cmpb #^a/9/,(r7) bgeq 5$ cmpb #^a/A/,(r7) bgtr 6$ cmpb #^a/Z/,(r7) blss 6$ 5$: incl r7 decl r8 brb 4$ 6$: ret .page .subtitle scan one common name .entry scan_one_common,^m ; r7,r8 are modified so that after the scan, they point to ; the loc following var scanned clrl descripter moval common_name,descripter+4 moval common_name,r11 ; ; move var name till end of string,or non a-z,0,9,$,_ ; ; r11 target address-nex loc to store ; r8 remaining bytes to scan ; r7 next src char to scan ; ; first char must be a-z cmpb #^a/A/,(r7) bgtr 4$ cmpb #^a/Z/,(r7) bgeq 3$ 4$: cmpb #^a?/?,(r7) ;check for blank common bneq 10$ movzbl blank_common_string,descripter moval blank_common_string+1,descripter+4 callg store_com_arg,store_symbol 10$: ret ;if not-do nothing 1$: cmpb #^a/$/,(r7) beql 3$ cmpb #^a/_/,(r7) beql 3$ cmpb #^a/0/,(r7) bgtr 2$ cmpb #^a/9/,(r7) bgeq 3$ cmpb #^a/A/,(r7) bgtr 2$ cmpb #^a/Z/,(r7) blss 2$ 3$: movb (r7)+,(r11)+ incl descripter decl r8 bleq 2$ cmpl #31,descripter bgtr 1$ ; finshed scan of var name 2$: callg store_com_arg,store_symbol ; assume scan ended ok (common name .le.31 chrs long) ret .end