1 /* Originally Written by Mike */ 2 3 main asc_shapes include 4 int parallel shapetype[$]; shape_ 4096,1,1 1,0,0 main ASC_SHAPES ident temp_fxsc STMP$, 48, 0, 0, 16, CS$ entry_ STMP$ temp_flsc SFTMP$, 61, 0, 8, 24, CS$ entry_ SFTMP$ decl_fxsc OUTBF$, 7200, 0, 0, 16, CS$ entry_ OUTBF$ decl_fxpa STACK$, 32, 0, 0, 32, CS$ entry_ STACK$ decl_fxsc host_stack$, 1, 0, 0, 16, CS$ entry_ host_stack$ temp_fxpa IPTMP$, 16, 16, 0, 16, CS$ temp_flpa RPTMP$, 15, 32, 8, 24, CS$ temp_lgpa LPTMP$, 17, 1, 0, 1, CS$ temp_lipa LITMP$, 5, 32, 0, 32, CS$ decl_lgpa TRUE$, 1, 1, 0, 1, CS$ decl_lgpa FALSE$, 1, 1, 0, 1, CS$ decl_lgpa IOMASK, 1, 1, 0, 1, CS$ decl_fxcn C10D$, 1, 10, 0, 16 entry_ C10D$ decl_fxcn C8D$, 1, 8, 0, 16 entry_ C8D$ decl_fxcn C2D$, 1, 2, 0, 16 entry_ C2D$ decl_fxcn C1D$, 1, 1, 0, 16 entry_ C1D$ decl_fxcn C0D$, 1, 0, 0, 16 entry_ C0D$ decl_fxcn C16D$, 1, 16, 0, 16 entry_ C16D$ decl_fxcn C48D$, 1, 48, 0, 16 entry_ C48D$ decl_fxcn C45D$, 1, 45, 0, 16 entry_ C45D$ decl_fxcn C32D$, 1, 32, 0, 16 entry_ C32D$ decl_lgpa THEM, 1, 1, 0, 1, CS$ decl_fxpa LEX$, 1, 96, 0, 96, CS$ decl_fxpa LEX_VAL$, 1, 96, 0, 96, CS$ decl_lgpa LEX_BI$, 1, 1, 0, 1, CS$ decl_lgpa GLOBAL_BI$, 1, 1, 0, 1, CS$ decl_lgpa THEIR, 1, 1, 0, 1, CS$ decl_lgpa ITS, 1, 1, 0, 1, CS$ decl_lgpa THE, 1, 1, 0, 1, CS$ decl_lgpa AN, 1, 1, 0, 1, CS$ decl_lgpa A, 1, 1, 0, 1, CS$ decl_lgpa @, 1, 1, 0, 1, CS$ decl_fxsc PERFORM, 1, 1, 0, 1, CS$ decl_fxsc PA_PERFORM, 1, 1, 0, 1, CS$ decl_fxsc SC_PERFORM, 1, 1, 0, 1, CS$ decl_fxsc HANDLE$, 2, 0, 0, 16, CS$ decl_fxpa SHAPETYPE, 1, 16, 0, 16, CS$ 5 real parallel basepoint_x[$]; decl_flpa BASEPOINT_X, 1, 32, 8, 24, CS$ 6 real parallel basepoint_y[$]; decl_flpa BASEPOINT_Y, 1, 32, 8, 24, CS$ 7 real parallel radius[$]; decl_flpa RADIUS, 1, 32, 8, 24, CS$ 8 real parallel length[$]; decl_flpa LENGTH, 1, 32, 8, 24, CS$ 9 real parallel width[$]; decl_flpa WIDTH, 1, 32, 8, 24, CS$ 10 real parallel base[$]; decl_flpa BASE, 1, 32, 8, 24, CS$ 11 real parallel height[$]; decl_flpa HEIGHT, 1, 32, 8, 24, CS$ 12 real parallel area[$]; decl_flpa AREA, 1, 32, 8, 24, CS$ 13 14 define (CIRCLE, 0); decl_fxcn CIRCLE, 1, 0, 0, 16 entry_ CIRCLE 15 define (RECTANGLE, 1); decl_fxcn RECTANGLE, 1, 1, 0, 16 entry_ RECTANGLE 16 define (TRIANGLE, 2); decl_fxcn TRIANGLE, 1, 2, 0, 16 entry_ TRIANGLE 17 18 logical parallel shapes_db[$]; decl_lgpa SHAPES_DB, 1, 1, 0, 1, CS$ 19 index parallel xx[$]; decl_lgpa XX, 1, 1, 0, 1, CS$ 20 21 associate shapetype[$], basepoint_x[$], basepoint_y[$], radius[$], length[$], width[$], base[$], height[$], area[$] with shapes_db[$]; 22 read shapetype[$], basepoint_x[$], basepoint_y[$], radius[$], length[$], w clr_array alloc_ THE init_stack beg_of_stmt 22, 0 idth[$], base[$], height[$] in shapes_db[$]; 23 24 print shapetype[$] in shapes_db[$]; beg_read SYSOT, SHAPES_DB, SHAPETYPE,BASEPOINT_X,BASEPOINT_Y,RADIUS,LENGTH,WIDTH,BASE,HEIGHT, mvsc_fxsc C0D$, STMP$+0 mvsc_fxsc C0D$, STMP$+1 loop_ PT$S1 read_ln SYSIN, STMP$+1, PT$R1 until_sc STMP$+1, PT$E1 read_fxpa OUTBF$,C0D$, STMP$+0, 16, PT$R1 decl_fxcn C480D$, 1, 480, 0, 16 entry_ C480D$ read_flpa OUTBF$,C480D$, STMP$+0, 32, PT$R1 decl_fxcn C960D$, 1, 960, 0, 16 entry_ C960D$ read_flpa OUTBF$,C960D$, STMP$+0, 32, PT$R1 decl_fxcn C1440D$, 1, 1440, 0, 16 entry_ C1440D$ read_flpa OUTBF$,C1440D$, STMP$+0, 32, PT$R1 decl_fxcn C1920D$, 1, 1920, 0, 16 entry_ C1920D$ read_flpa OUTBF$,C1920D$, STMP$+0, 32, PT$R1 decl_fxcn C2400D$, 1, 2400, 0, 16 entry_ C2400D$ read_flpa OUTBF$,C2400D$, STMP$+0, 32, PT$R1 decl_fxcn C2880D$, 1, 2880, 0, 16 entry_ C2880D$ read_flpa OUTBF$,C2880D$, STMP$+0, 32, PT$R1 decl_fxcn C3360D$, 1, 3360, 0, 16 entry_ C3360D$ read_flpa OUTBF$,C3360D$, STMP$+0, 32, PT$R1 decl_fxcn C3840D$, 1, 3840, 0, 16 entry_ C3840D$ read_flpa OUTBF$,C3840D$, STMP$+0, 32, PT$R1 decl_fxcn C4320D$, 1, 4320, 0, 16 entry_ C4320D$ read_flpa OUTBF$,C4320D$, STMP$+0, 32, PT$R1 decl_fxcn C4800D$, 1, 4800, 0, 16 entry_ C4800D$ read_flpa OUTBF$,C4800D$, STMP$+0, 32, PT$R1 decl_fxcn C5280D$, 1, 5280, 0, 16 entry_ C5280D$ read_flpa OUTBF$,C5280D$, STMP$+0, 32, PT$R1 decl_fxcn C5760D$, 1, 5760, 0, 16 entry_ C5760D$ read_flpa OUTBF$,C5760D$, STMP$+0, 32, PT$R1 decl_fxcn C6240D$, 1, 6240, 0, 16 entry_ C6240D$ read_flpa OUTBF$,C6240D$, STMP$+0, 32, PT$R1 decl_fxcn C6720D$, 1, 6720, 0, 16 entry_ C6720D$ read_flpa OUTBF$,C6720D$, STMP$+0, 32, PT$R1 addfxsc STMP$+0, C1D$, STMP$+0 endloop PT$E1, PT$S1 gtfxsc STMP$+0, C480D$, STMP$+1 if_sc STMP$+1, PT$N1 msg SYSOT, ERROR - I/O BUFFER OVERFLOW ON READ - SOME DATA OVERWRITTEN. else_sc PT$F1, PT$N1 endif_sc PT$F1 ioalloc2 SHAPES_DB, STMP$+0 expandfxpa OUTBF$,C0D$, SHAPETYPE, C16D$ input_fxpa SHAPETYPE, C16D$ expandflpa OUTBF$,C480D$, BASEPOINT_X, C16D$ input_flpa BASEPOINT_X,C0D$, C16D$ expandflpa OUTBF$,C960D$, BASEPOINT_X, C16D$ input_flpa BASEPOINT_X,C16D$, C16D$ expandflpa OUTBF$,C1440D$, BASEPOINT_Y, C16D$ input_flpa BASEPOINT_Y,C0D$, C16D$ expandflpa OUTBF$,C1920D$, BASEPOINT_Y, C16D$ input_flpa BASEPOINT_Y,C16D$, C16D$ expandflpa OUTBF$,C2400D$, RADIUS, C16D$ input_flpa RADIUS,C0D$, C16D$ expandflpa OUTBF$,C2880D$, RADIUS, C16D$ input_flpa RADIUS,C16D$, C16D$ expandflpa OUTBF$,C3360D$, LENGTH, C16D$ input_flpa LENGTH,C0D$, C16D$ expandflpa OUTBF$,C3840D$, LENGTH, C16D$ input_flpa LENGTH,C16D$, C16D$ expandflpa OUTBF$,C4320D$, WIDTH, C16D$ input_flpa WIDTH,C0D$, C16D$ expandflpa OUTBF$,C4800D$, WIDTH, C16D$ input_flpa WIDTH,C16D$, C16D$ expandflpa OUTBF$,C5280D$, BASE, C16D$ input_flpa BASE,C0D$, C16D$ expandflpa OUTBF$,C5760D$, BASE, C16D$ input_flpa BASE,C16D$, C16D$ expandflpa OUTBF$,C6240D$, HEIGHT, C16D$ input_flpa HEIGHT,C0D$, C16D$ expandflpa OUTBF$,C6720D$, HEIGHT, C16D$ input_flpa HEIGHT,C16D$, C16D$ endread_ beg_of_stmt 24, 0 25 26 setscope shapes_db[$] fstout_ SHAPES_DB outpt_fxpa SHAPETYPE, C16D$ colapsefxpa OUTBF$,C0D$, STMP$+0, SHAPETYPE, C16D$ beg_print SYSOT, SHAPES_DB, SHAPETYPE, decl_fxcn C7200D$, 1, 7200, 0, 16 entry_ C7200D$ gtfxsc STMP$+0, C7200D$, STMP$+1 if_sc STMP$+1, PT$N2 msg SYSOT, ERROR - I/O BUFFER OVERFLOW ON PRINT - SOME DATA LOST. else_sc PT$F2, PT$N2 endif_sc PT$F2 mvsc_fxsc C0D$, STMP$+1 loop_ PT$S2 gefxsc STMP$+1, STMP$+0, STMP$+2 until_sc STMP$+2, PT$E2 sprint_fxpa SYSOT, OUTBF$,C0D$, STMP$+1, CS$ print_del SYSOT print_nl SYSOT addfxsc STMP$+1, C1D$, STMP$+1 endloop PT$E2, PT$S2 endprint beg_of_stmt 26, 0 27 28 /* .masc fork */ 29 if shapetype[$] .eq. CIRCLE then mvpa_lgpa SHAPES_DB, THEM stack_scope SHAPES_DB beg_of_stmt 29, 0 begif IF$S1 eq_fxcr SHAPETYPE, CIRCLE, LPTMP$+0 mvpa_lgpa LPTMP$+0, THEM 30 area[$] = 3.14159 * radius[$] * radius[$]; if_pa LPTMP$+0, ELS$1 beg_of_stmt 30, 0 decl_flcn C3.14159F$, 1, 3.14159, 0, 32 entry_ C3.14159F$ mul_flcl C3.14159F$, RADIUS, RPTMP$+0 mul_flpa RPTMP$+0, RADIUS, RPTMP$+32 mvpa_flpa RPTMP$+32, AREA 31 else beg_of_stmt 31, 0 label ELS$1 else_pa IF$E1 32 if shapetype[$] .eq. RECTANGLE then beg_of_stmt 32, 0 begif IF$S2 eq_fxcr SHAPETYPE, RECTANGLE, LPTMP$+0 mvpa_lgpa LPTMP$+0, THEM 33 area[$] = length[$] * width[$]; if_pa LPTMP$+0, ELS$2 beg_of_stmt 33, 0 mul_flpa LENGTH, WIDTH, RPTMP$+0 mvpa_flpa RPTMP$+0, AREA 34 else beg_of_stmt 34, 0 label ELS$2 else_pa IF$E2 35 if shapetype[$] .eq. TRIANGLE then beg_of_stmt 35, 0 begif IF$S3 eq_fxcr SHAPETYPE, TRIANGLE, LPTMP$+0 mvpa_lgpa LPTMP$+0, THEM 36 area[$] = 0.5 * base[$] * height[$]; if_pa LPTMP$+0, ELS$3 beg_of_stmt 36, 0 decl_flcn C0.5F$, 1, 0.5, 0, 32 entry_ C0.5F$ mul_flcl C0.5F$, BASE, RPTMP$+0 mul_flpa RPTMP$+0, HEIGHT, RPTMP$+32 mvpa_flpa RPTMP$+32, AREA 37 endif; beg_of_stmt 37, 0 label ELS$3 endif_pa IF$E3 38 endif; beg_of_stmt 38, 0 endif_pa IF$E2 39 endif; beg_of_stmt 39, 0 endif_pa IF$E1 40 41 endsetscope; beg_of_stmt 41, 0 pop_scope 42 43 print area[$] in shapes_db[$]; beg_of_stmt 43, 0 44 45 end; fstout_ SHAPES_DB outpt_flpa AREA,C0D$, C16D$ colapseflpa OUTBF$,C0D$, STMP$+0, AREA, C16D$ outpt_flpa AREA,C16D$, C16D$ decl_fxcn C3600D$, 1, 3600, 0, 16 entry_ C3600D$ colapseflpa OUTBF$,C3600D$, STMP$+0, AREA, C16D$ beg_print SYSOT, SHAPES_DB, AREA,AREA, gtfxsc STMP$+0, C3600D$, STMP$+1 if_sc STMP$+1, PT$N3 msg SYSOT, ERROR - I/O BUFFER OVERFLOW ON PRINT - SOME DATA LOST. else_sc PT$F3, PT$N3 endif_sc PT$F3 mvsc_fxsc C0D$, STMP$+1 loop_ PT$S3 gefxsc STMP$+1, STMP$+0, STMP$+2 until_sc STMP$+2, PT$E3 sprint_flpa SYSOT, OUTBF$,C0D$, STMP$+1, CS$ sprint_flpa SYSOT, OUTBF$,C3600D$, STMP$+1, CS$ print_del SYSOT print_nl SYSOT addfxsc STMP$+1, C1D$, STMP$+1 endloop PT$E3, PT$S3 endprint beg_of_stmt 45, 0 label_ $EXIT$ stop_ endmain ASC_SHAPES 46 47 ÿ