@CAT,P 1010-001-001.,F///10000 @ASG,T TEMP.,///10000 @ELT,OI TEMP.1010-001-001,,,127750053241,000 )@@G@@**PF**@@@@XR@@@@@@@@@@@[@]%@@@]FE /^@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@AA )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@#@@@@@@@@@@@@@@@@@@@@@@@@AB )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@AC )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@AD )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@AE )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@AF )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@AG )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@AH )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@[@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@AI )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@AJ )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@AK )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@AL )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@AM )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@E@@#AN )@@G@@AVAIL @@@@@@@@[@@] @ @@@[]@@@@-@@@@W@GE[[^CAVAIL AO )@@G@@@@@@@@@@ @@# @@@@W2@@#@@L@@@@W-GEI[^CAVAIL @@@@@@@@A@@@AP )@@G@@ @F.@E@^@@@@+@@@@W5GES[^C____________________________________AQ )@@G@@________________________________________________________________________AR )@@G@@________________________________________________________________________AS )@@G@@________________________________________________________________________AT )@@G@@________________________________________________________________________AU )@@G@@________________________________________________________________________AV )@@G@@________________________________________________________________________AW )@@G@@________________________________________________________________________AX )@@G@@________________________________________________________________________AY )@@G@@________________________________________________________________________AZ )@@G@@________________________________________________________________________BA )@@G@@________________________________________________________________________BB )@@G@@________________________________________________________________________BC )@@G@@________________________________________________________________________BD )@@G@@________________________________________________________________________BE )@@G@@________________________________________________________________________BF )@@G@@________________________________________________________________________BG )@@G@@________________________________________________________________________BH )@@G@@________________________________________________________________________BI )@@G@@________________________________________________________________________BJ )@@G@@________________________________________________________________________BK )@@G@@________________________@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@BL )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@BM )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@BN )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@BO )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@BP )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@BQ )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@BR )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@BS )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@BT )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@BU )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@BV )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@BW )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@BX )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@BY )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@BZ )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@CA )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@CB )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@CC )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@CD )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@CE )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@CF )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@CG )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@CH )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@CI )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@CJ )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@CK )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@CL )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@CM )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@CN )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@CO )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@CP )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@CQ )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@CR )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@CS )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@CT )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@CU )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@CV )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@CW )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@CX )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@CY )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@CZ )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@DA )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@DB )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@DC )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@DD )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@DE )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@DF )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@DG )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@DH )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@DI )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@DJ )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@DK )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@DL )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@DM )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@DN )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@DO )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@DP )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@DQ )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@DR )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@DS )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@DT )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@DU )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@DV )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@DW )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@DX )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@DY )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@DZ )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@EA )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@EB )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@EC )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ED )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@EE )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@EF )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@EG )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@EH )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@EI )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@EJ )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@EK )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@EL )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@EM )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@EN )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@EO )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@EP )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@EQ )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ER )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ES )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ET )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@EU )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@EV )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@EW )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@EX )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@EY )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@EZ )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@FA )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@FB )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@FC )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@FD )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@FE )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@FF )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@FG )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@FH )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@FI )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@FJ )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@FK )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@FL )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@FM )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@FN )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@FO )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@FP )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@FQ )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@FR )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@FS )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@S @[@@@@. @ @@@@GR0915 PUSH A6 FT )@@G@@ . @ @@@@ ERROR YSYSTM,GR0999 . @ @@@@GR0925 PUSH A6 FU )@@G@@ . @ @@@@GR0930 ERROR YDOMAI,GR0999 . @ @@@@GR0960 ERROR YRANK,GR099FV )@@G@@9 . @ @@@@GR0999 LX X11,GRLINK . @ @@@@ J 0,X11 FW )@@G@@ . @[@@@@. @[@@@@. @#@@@@ CONSTS . @ @@@@SORTAB + FX )@@G@@ HFSORT . @ @@@@ + DFSORT . @[@@@@. @[@@@@FY )@@G@@. @]@@@@. HALF-INT @#@@@@ INSTRS . @ @@@@HFSORT SX X6,HFFZ )@@G@@SAVE . @D@@@@ HFETCH A2,A7,GRRITE . 2ND VALUELEFT IN A7 GA )@@G@@@ @@@@ LA A2,A14 . @C@@@@ ANA A2,WSIXOR . CORGB )@@G@@RECT FOR INDEX-ORG@D@@@@ HFETCH A2,A8,GRRITE . 1ST VALUE LEFT IN AGC )@@G@@8 @D@@@@ TNZ GRFLAG . CHECK FOR SORT-UP OF DOWN @C@@@@GD )@@G@@ DSC A7,36 . DOWN, SWITCH OPERANDS@B@@@@ TG A7,A8GE )@@G@@ . TEST FOR SWITCH@F@@@@HF0005 DSC A13,36 . SHIFT SO INDEXEGF )@@G@@S GO BACK CORRECTLY @D@@@@HF0010 LA A2,A13 . PREPARE TO REVEGG )@@G@@RSE INDICES @A@@@@ LA A6,GRCNT . ADD 1 @A@@@@ AA,U GH )@@G@@ A6,1 . TO @B@@@@ SA A6,GRCNT . SWITCH COUNT GI )@@G@@@D@@@@ LMJ X2,0,X2 . STORE 2ND INDEX, FIRST @G@@@@ GJ )@@G@@ DL A6,X2 . SAVE INDEX REGS SO AS TO ONLY MOVE 1 VALUE @ @@@@GK )@@G@@ LA A2,A14 . @D@@@@ LMJ X2,0,X2 . STORE 1STGL )@@G@@ INDEX, SECOND @C@@@@ DS A6,X2 . RESTORE INDEX REGS GM )@@G@@@ @@@@ LX X6,HFSAVE . @A@@@@ TZ GRTYPE . IF GN )@@G@@DFLOAT@C@@@@ J DR0020 . EXIT FROM THERE @]@@@@HF0020GO )@@G@@ . @A@@@@ LMJ X6,0,X6 . EXIT @ @@@@ J HFSORGP )@@G@@T . @#@@@@ VARBLS . @#@@@@HFSAVE RES 1 . @#@@@@ GQ )@@G@@ INSTRS . @#@@@@. DOUBLE-FLOAT @D@@@@DFSORT DFETCH A2,A7,GRRITE . 2GR )@@G@@ND VALUE LEFT IN A7,A8 @ @@@@ LA A2,A14 . @C@@@@ GS )@@G@@ ANA A2,WSIXOR . CORRECT FOR INDEX-ORG@D@@@@ DFETCH A2,A3,GRRIGT )@@G@@TE . 1ST VLUAE LEFT IN A3,A4 @C@@@@ TZ GRFLAG . TEST IF GGU )@@G@@RAD-DOWN @ @@@@ J DF0010 . NO @C@@@@ DS A3,A5GV )@@G@@ . SHIFT AROUND FOR TEST@B@@@@ DL A3,A7 . A3&A4 TOGW )@@G@@ A7&A8@B@@@@ DS A5,A7 . AND VICE-VERSA@A@@@@DF0010 SX GX )@@G@@ X6,HFSAVE . SAVE LINK@B@@@@ DTG A7,A3 . TEST FOR SWITCHGY )@@G@@@D@@@@ J HF0005 . NO SWITCH, FINISH ROUTINE @B@@@@ GZ )@@G@@ J HF0010 . GO TO SWITCH @A@@@@DR0020 LMJ X6,0,X6 . EXIHA )@@G@@T @ @@@@ J DFSORT . @#@@@@ VARBLS . @^@@@@HB )@@G@@GRLINK RES 1 . LINK @F@@@@GRFLAG RES 1 . FLAG FOR GRADE-UP(NON-ZERHC )@@G@@O), GRADE-DWN(ZERO) @D@@@@GRBLK CBLOCK ZTPTMP,ZMOHFI,ZRANKV,0 0 . DHD )@@G@@UMMY DESCR @B@@@@GRRITE RES 1 . ADDR OF RIGHT ARG ADDR @C@@@@GRANSWHE )@@G@@ RES 1 . ADDR OF DATA ADDT OF ANSWER @A@@@@GRTYPE RES 1 . INDEX IHF )@@G@@NTO SORT-TAB@B@@@@GRDSC RES 1 . RELADDR OF RESULT DESCR @B@@@@GRANRTHG )@@G@@ RES 1 . ANSWER STORE ROUTINE ADDR@D@@@@GRCNT RES 1 . COUNT OF SWITCHHH )@@G@@ES DURING A SORT PASS @ @@@@ END . ___ CONSTHI )@@G@@S . @ @@@@SORTAB + *[S@@@*SDFF*@G@@@@. ****************************HJ )@@G@@***************************************** @G@@@@. STANDARD PROCS - INCLUHK )@@G@@DED BY AN @ADD PRCPKG/APL IN SOURCE DECKS * @G@@@@. HL )@@G@@ * @^@@@@ AXR$ HM )@@G@@ . @C@@@@ CONFIG . DEFINE ASSEMBLY PARAMETERS @G@@@@HN )@@G@@ WSDEF. DEFINE WORKSPACE * HO )@@G@@@G@@@@WORKSP INFO 2 20. SET ASIDE THE SPACE HP )@@G@@ * @G@@@@ RUNCTL. DEFINE RUN CTRL BLOK(S) HQ )@@G@@ * @G@@@@RUNCON INFO 2 22. AND SET ASIDE ITS SPACE HR )@@G@@ * @G@@@@ CBLOCK . DEFINE CONTROL BLOCK HS )@@G@@TYPES * @G@@@@. HT )@@G@@ * @G@@@@. END OF STANDARD PROC BLOCK HU )@@G@@ * @G@@@@. ****************************HV )@@G@@***************************************** @[@@@@. @[@@@@. @B@@@@HW )@@G@@ POPDEF . DEFINE STACK REG SYMBOLS @#@@@@ STATEV . @[@@@@HX )@@G@@. @E@@@@SBLSIZ EQU STKNRG//4 . NO OF WORDS IN W.S. STACK BLOCK HY )@@G@@@G@@@@SBLNEN EQU 2*SBLSIZ . NO OF STACK ENTRIES (I.E. REGS) IN WS BHZ )@@G@@LOK @[@@@@. @#@@@@S PROC . @#@@@@SAVE* NAME . @ @@@@IA )@@G@@ SX X11,STLINK . @#@@@@ UNLIST . @ @@@@ DS IB )@@G@@ A0,STTEMP . @ @@@@ DS A2,STTEMP+2 . @ @@@@ DL IC )@@G@@ A0,R1 . @ @@@@ DS A0,STTEMP+4 . @#@@@@ LIST ID )@@G@@. @]@@@@ END .@[@@@@. @#@@@@R PROC . @#@@@@RESTORIE )@@G@@* NAME . @ @@@@ DL A0,STTEMP+4 . @#@@@@ UNLIST . IF )@@G@@@ @@@@ DS A0,R1 . @ @@@@ DL A2,STTEMP+2 . IG )@@G@@@ @@@@ DL A0,STTEMP . @ @@@@ LX X11,STLINK . IH )@@G@@@#@@@@ LIST . @]@@@@ END .@G@@@@/. EXECUTE TIME STACK RTII )@@G@@NES- FOR CALL SEQS, SEE PROX 'PUSH'AND 'POP' @A@@@@. REGS FULL- PUSH IJ )@@G@@STACK INTO WS @G@@@@. STACK BLOCKS ARE ALWAYS 'SBLSIZ' WORDS, ALIK )@@G@@THOUGH THEY MIGHT NOT BE@G@@@@. FILLED. THE ACTUAL NO OF ENTRIES INIL )@@G@@ A BLOK IS IN Q2 OF THE HEADER@G@@@@. WORD, AND ALTHO A FULL COMPLEMIM )@@G@@ENT OF REGS IS ALWAYS LOADED AND @G@@@@. STORED, THE STACK POINTEIN )@@G@@R, X10 WILL BE PROPERLY ADJUSTED TO POINT @F@@@@. TO THE CORRECT PLAIO )@@G@@CE. DURING EXECUTION, X10 ALWAYS CONTAINS@F@@@@. THE ACTUAL NUMBER IP )@@G@@OF R-REGS WHICH CONTAIN LIVE STACK VALUES.@G@@@@. BECAUSE THESE ROUTIQ )@@G@@INES ARE CALLED FROM PROCS WHICH HAVE ALREADY @D@@@@. UPDATED X10,IR )@@G@@ WE COMPENSATE IT BY 1 INTERNALLY. @[@@@@. @#@@@@ INSTRS . IS )@@G@@@E@@@@. THIS ENTRY TO FLUSH ENTIRE LIVE STACK (USED TO SUSPEND) @#@@@@IT )@@G@@STKFLU* SAVE . @[@@@@. @D@@@@SF0010 LA,U A0,0,X10 . GET NO OFIU )@@G@@ REGS NOW IN USE @B@@@@ JZ A0,ST0200 . IF NONE, EXIT @C@@@@IV )@@G@@ TG,U A0,SBLNEN . MORE THAN ONE BLOCK? @F@@@@ LA,U A0,SBIW )@@G@@LNEN . YES, SET NO TO BE SAVED TO ONE BLOCK @F@@@@ LMJ X11,SIX )@@G@@T0010 . GO SAVE NO OF REGS SPECIFIED IN A0 @ @@@@ J ST030IY )@@G@@0 . @F@@@@ J SF0010 . CONTINUE UNTIL LIVE STACK IIZ )@@G@@S EMPTY @[@@@@. @C@@@@. THIS ENTRY FROM 'PUSH' PROC AT STACK OVJA )@@G@@ERFLOW@[@@@@. @#@@@@STKPSH* SAVE . @F@@@@ JGD X10,$+1 JB )@@G@@ . REPAIR DAMAGE DONE BY TLEM IN PUSH @F@@@@ LA,U A0,SBLNEN JC )@@G@@ . SET NO OF REGS TO SAVE TO ONE FULL BLOK@C@@@@ LMJ X11,ST0010 JD )@@G@@ . GO SAVE THE REGS @^@@@@ J ST0005 . @F@@@@ NOP JE )@@G@@ 0,0,*X10 . SET POINTER AS PUSH WOULD HAVE DONE @B@@@@ J JF )@@G@@ ST0200 . AND RETURN @B@@@@ST0005 NOP 0,0,*X10 . RESTORE XJG )@@G@@10 @ @@@@ J ST0300 . @E@@@@/. THIS IS WHERE THE R-JH )@@G@@REGS ARE ACTUALLY PUSHED INTO THE WS@[@@@@. @G@@@@ST0010 SA A0,STJI )@@G@@NSAV . TEMP SAVE NO OF REGS TO BE PUT INTO BLOCK @C@@@@ SX JJ )@@G@@ X11,STLNK2 . AND RETURN ADDR, TOO @C@@@@ ALLOCT,U SBLSIZ+1 ST007JK )@@G@@0 . GET SPACE @F@@@@ SA,H2 A1,STBLAD . SAVE INDIRECT STACK BJL )@@G@@LOCK POINTER- @D@@@@ AA,U A1,0,WSTAG . ABS ADDR OF STAK BLOKJM )@@G@@ TO A1@ @@@@. INITIALIZE LINK WD, ETC @ @@@@ST0020 LA A0,STSKEL JN )@@G@@ . @ @@@@ SA A0,0,A1 . @C@@@@ LA,H2 A0,WSSTAK JO )@@G@@ . CURRENT STACK POINTER@B@@@@ SA,H2 A0,0,A1 . INTO WORD 1 JP )@@G@@@D@@@@ LA A0,STNSAV . NO OF REGS ACTUALLY SAVED @D@@@@ JQ )@@G@@ SA,Q2 A0,0,A1 . POST IN BLOCK HEADER WORD @C@@@@ LA,H2 A0,STJR )@@G@@BLAD . ADDR OF THIS BLOK @C@@@@ SA,H2 A0,WSSTAK . INTO WS SJS )@@G@@TACK POINTER@C@@@@. NOW PACK AND MOVE FROM R-REGS TO STACK BLOCK @#@@@@JT )@@G@@S PROC . @#@@@@SPACK* NAME . @D@@@@ DL A2,STKLFT+2*JU )@@G@@(K-1) . GET NEXT 2 R-REGS @#@@@@ UNLIST . @B@@@@ LSSL JV )@@G@@A3,18 . PACK INTO ONE WORD @^@@@@ LDSL A2,18 . @A@@@@ JW )@@G@@ SA A2,K,A1 . PUT IN WS BLOK@#@@@@ LIST . @]@@@@ END. JX )@@G@@@]@@@@ST0030 . @C@@@@K DO SBLSIZ , SPACK . MOVE FROM R-REGS TO WS JY )@@G@@@D@@@@. MOVE REMAINING R-REGS TO LOW PORTION, RESET X10. @E@@@@ST0040JZ )@@G@@ LA A0,STNSAV . RECOVER NO OF LIVE REGS SAVED @D@@@@ TNE,UKA )@@G@@ A0,SBLNEN . DID WE SAVE A FULL BLOCK? @E@@@@ J ST0050 KB )@@G@@ . YES, GO MOVE THE UNSAVED REGS @D@@@@ LXM,U X10,0 . NO,KC )@@G@@ SET THE STACK TO EMPTY @A@@@@ J ST0060 . AND EXIT @]@@@@KD )@@G@@ST0050 . @D@@@@K DO STKNRG-SBLNEN , LR STKLFT+K-1,STKLFT+K-1+SBLNEN KE )@@G@@@D@@@@ LNA A0,STNSAV . NEG OF NO OF REGS SAVED @D@@@@ KF )@@G@@ AA,U A0,0,X10 . PLUS NO ORIGINALLY FILLED @E@@@@ LXM,U X10,0KG )@@G@@,A0 . GIVES NO NOW CONTAINING LIVE DATA@A@@@@ST0060 LX X11,STLNK2 KH )@@G@@ . RETURN @ @@@@ J 1,X11 . @ @@@@ST0070 LX X11,SKI )@@G@@TLNK2 . @ @@@@ J 0,X11 . @[@@@@/. @[@@@@. KJ )@@G@@@B@@@@. REGS EMPTY-- REFILL THEM FROM WS--- @[@@@@. @ @@@@STKPOPKK )@@G@@* SAVE . @E@@@@ST0100 LA,H2 A1,WSSTAK . GET CURRENT WS KL )@@G@@STACK POINTER @F@@@@ JZ A1,ST0300 . IF ZERO, STACK EMPTY.KM )@@G@@ TAKE ERROR RETURN@B@@@@ SA,H2 A1,STBLAD . SAVE BLOK ADDR @C@@@@KN )@@G@@ AA,U A1,0,WSTAG . MAKE IT ABSOLUTE @A@@@@. MOVE FROM STACK KO )@@G@@BLOCK TO REGS @#@@@@S PROC . @#@@@@SUNPAK* NAME . @B@@@@KP )@@G@@ LA A2,K,A1 . GET NEXT BLOK ENTRY@#@@@@ UNLIST . @B@@@@KQ )@@G@@ DSL A2,18 . UNPACK TO TWO WORDS@^@@@@ SSL A3,18 . KR )@@G@@@D@@@@ DS A2,STKLFT+2*(K-1) . MOVE TO STACKREG @#@@@@ KS )@@G@@ LIST . @#@@@@ END . @]@@@@ST0110 . @^@@@@K DO SBLSIZ KT )@@G@@, SUNPAK . @B@@@@. NOW RELEASE STACK BLOCK TO FREE STORAGE @E@@@@ST0120KU )@@G@@ LA,H2 A0,0,A1 . GET CHAIN POINTER OF THIS BLOCK @D@@@@ SA,H2KV )@@G@@ A0,WSSTAK . INTO WORKSP STACK POINTER @F@@@@ LXM,Q2 X10,0,A1 KW )@@G@@ . GET NO OF FILLED REGS FROM HEADER WORD @B@@@@ LA,U A0,SBLSIZ+1KX )@@G@@ . SIZE OF BLOCK @B@@@@ LA,H2 A1,STBLAD . ADDR OF BLOCK @B@@@@KY )@@G@@ FREE . RELEASE IT @G@@@@ JGD X10,ST0200 KZ )@@G@@. COMPENSATE POINTER AS 'POP' WOULD HAVE DONE @^@@@@. TAKE NORMAL RETULA )@@G@@RN @B@@@@. SET POINTER TO NEXT EMPTY REG, RETURN @B@@@@ST0200 RESTOLB )@@G@@R . RESET REGS @B@@@@ J 1,X11 . NORMAL RLC )@@G@@ETURN @B@@@@. ERROR RETURN-- WS FULL, OR STACK EMPTY @ @@@@ST0300 RESTOLD )@@G@@R . @ @@@@ J 0,X11 . @[@@@@. @#@@@@LE )@@G@@ VARBLS . @#@@@@STBLAD RES 1 . @#@@@@STLINK RES 1 . @#@@@@LF )@@G@@STTEMP RES 6 . @D@@@@STNSAV RES 1 . NO OF REGS TO BE SAVELG )@@G@@D @E@@@@STLNK2 RES 1 . LINK USED DURING REG SAVE/FLUSH LH )@@G@@@#@@@@ CONSTS . @ @@@@STSKEL CBLOCK ZTPSTA,0,0,0 . @[@@@@. LI )@@G@@@C@@@@. INITIAL SETUP OF STACK TO 'CLEAR' (I.E. EMPTY)@[@@@@. @#@@@@LJ )@@G@@ INSTRS . @F@@@@STCLEA* SZ WSSTAK . THERE ARE NO STACK BLLK )@@G@@OCKS IN CORE... @G@@@@ LX X10,(+1,0) . AND THERE IS NOTHING LL )@@G@@IN THE R-REGS, EITHER @E@@@@ SZ STVSTK . FLAG EMPTY STACLM )@@G@@K IN STATEVECTOR @ @@@@ J 0,X11 . @]@@@@ END .LN )@@G@@___M,U X10,0 . NO, SET THE STACK TO EMPTY @A@@@@ J ST006LO )@@G@@*[S@@@*SDFF*@G@@@@. ****************************************************LP )@@G@@***************** @G@@@@. STANDARD PROCS - INCLUDED BY AN @ADD PRCPKG/APLQ )@@G@@L IN SOURCE DECKS * @G@@@@. LR )@@G@@ * @G@@@@ AXR$ . LS )@@G@@ * @G@@@@ CONFIG . DEFINE ASSLT )@@G@@EMBLY PARAMETERS * @G@@@@ WSDEF. DEFINLU )@@G@@E WORKSPACE * @G@@@@WORKSP INFO 2 20.LV )@@G@@ SET ASIDE THE SPACE * @G@@@@ RUNCTLW )@@G@@L. DEFINE RUN CTRL BLOK(S) * @G@@@@RUNCONLX )@@G@@ INFO 2 22. AND SET ASIDE ITS SPACE * @G@@@@LY )@@G@@ CBLOCK . DEFINE CONTROL BLOCK TYPES * LZ )@@G@@@G@@@@. MA )@@G@@ * @G@@@@. END OF STANDARD PROC BLOCK MB )@@G@@ * @G@@@@. ****************************************************MC )@@G@@***************** @[@@@@. @[@@@@. @D@@@@/. EXECUTE TIME SET/GMD )@@G@@ETVAL OF TRACE/STOP VECTORS @[@@@@. @#@@@@ INSTRS . @G@@@@ME )@@G@@. SET STOPVECTOR MF )@@G@@@E@@@@SETSTP* SZ STINDX . SET TRACE/STOP INDEX TO STOP @^@@@@MG )@@G@@ J ST0010 @G@@@@. MH )@@G@@ SET TRACEVECTOR @D@@@@SETTRC* LA,U A0,1 . GET INDEXMI )@@G@@ VAL FOR TRACE @F@@@@ SA A0,STINDX . POST TRACE/STOP INDEXMJ )@@G@@ING FLAG FOR TRACE@[@@@@. @ @@@@ST0010 SX X11,STLINK . @E@@@@MK )@@G@@ LMJ X11,TSINIT . INITIALIZE POINTERS TO FUNCTABLE @ @@@@ ML )@@G@@ J ST0999 . @D@@@@. BEFORE SETTING NEW BITS, CLEAR ALL THE OMM )@@G@@LD ONES @F@@@@ST0100 LA A0,STINDX . PICK UP INDEX VALUE FOR TRAMN )@@G@@CE/STOP @G@@@@ LA A2,TSTBAS . GET BASE ADDR OF FUNCTBL, WMO )@@G@@ITH INCREMENT @E@[@@ LR R1,TSNLIN . NO OF LINES (EXCLUDINMP )@@G@@G HEADER) @F@@[[ LR R1,TSNLIN . GET TOT NO LINES (INCLMQ )@@G@@ HEADER) @D@@[[ TZ STINDX . DOING STOPVECTOR? MR )@@G@@@F@@[[ JGD R1,$+1 . NO, TRACE. DON'T COUNT LINE ZERO MS )@@G@@@C[@@@ST0110 JNGD R1,ST0200 . IF NO MORE, GET OUT @F@@@@ EX MT )@@G@@ ST0120,A0 . CLEAR APPROPRIATE 6TH WD OF TABLE ENTRY@C@@@@ J MU )@@G@@ ST0110 . AND GO DO NEXT LINE @B@[@@ST0120 SZ,S2 1,*A2 . CLEMV )@@G@@AR STOPBIT @B@[@@ SZ,S3 1,*A2 . CLEAR TRACEBIT @C@@[[ST0120MW )@@G@@ SZ,S2 0,*A2 . CLEAR STOPBIT @F@@[[ SZ,S3 1,*A2 MX )@@G@@ . CLEAR TRACEBIT (BYPASS LINE ZERO) @C]@@@. NOW SET UP TO FETCH RIMY )@@G@@TEARG AND TURN BITS ON @C@@@@ST0200 VERIFY ST0900,,ST0910 . DECODE RITMZ )@@G@@EARG @F@@@@ SA A6,RITDSC . POST ADDR FOR GARBAGE COLLECNA )@@G@@TOR @B@@@@ LA A15,A5 . SET COUNTER @B@@@@ JZ NB )@@G@@ A5,ST0300 . IF NULL, EXIT @F@@@@ JG,U A4,ZRANKV+1 ST0210 .NC )@@G@@ BE SURE RANK IS SCAL OR VECT @A@@@@ ERROR YRANK,ST0999 . ND )@@G@@@E@@@@ST0210 JE,U A3,ZMOHFI ST0220 . IF HALFINT, GO SET UP FETCH @F@@@@NE )@@G@@ JNE,U A3,ZMODFL ST0920 . IF NOT DFL EITHER, DOMAIN ERR @G@@@@NF )@@G@@ LA,U A3,ZMODFI . SET MODE FLAG TO FORCE HALFFINT FETCH NG )@@G@@@D@@@@ST0220 LMJ X11,PIKRIU . INITIALIZE FETCHREGS @A@@@@ NH )@@G@@ J ST0999 . @E@@@@. LOOP OVER RITEARG, SETTING BITS INNI )@@G@@ THE REQUIRED STMNTS @E@@@@ST0230 JNGD A15,ST0300 . WHEN RITEARG EXNJ )@@G@@HAUSTED, GET OUT @D@@@@ LMJ X6,0,X6 . GET NEXT VALUE TO A4,NK )@@G@@A5 @C@@@@ JNZ A4,ST0230 . IF NOT HALFINT, SKIP @E@[@@ NL )@@G@@ DJZ A4,ST0230 . DON'T FLAG FUNC HEADER LINES @B@[@@ TNE NM )@@G@@ A5,TSNLIN . =LAST LINE? @C@[@@ J ST0240 . YES, GO TNN )@@G@@URN BIT ON @D@[@@ TG,U A5,1 . NO, IS LINENO AT LEAST 1? NO )@@G@@@D@@[[ TZ STINDX . SETTING STOPVECTOR? @G@@[[ NP )@@G@@ DJZ A4,ST0230 . NO, DON'T SET TRACE ON FUNC HDR LINE @E@@[[NQ )@@G@@ TG,U A5,0 . IS LINE NO AT LEAST ZERO? @E^@@@ NR )@@G@@ TG A5,TSNLIN . YES, DOES IT EXCEED LAST LINENO @C@@@@ J NS )@@G@@ ST0230 . OUT OF RANGE, SKIP IT@C@@@@ST0240 LA A2,A5 . LINNT )@@G@@ENO TO WORKREG @D@@@@ LA,U A4,1 . SET UP A BIT TO BE STNU )@@G@@ORED @C@@@@ LA A0,STINDX . GET TRACE/STOP INDEX @G@@@@ NV )@@G@@ AA A2,TSLIN0 . LINENO+LINEZERO=ADDR OF ENTRY FOR THIS LINE @C@@@@NW )@@G@@ EX ST0250,A0 . SET BIT ON FROM A4 @C@@@@ J ST023NX )@@G@@0 . GO BACK FOR NEXT LINE@B@@@@ST0250 SA,S2 A4,0,A2 . STOPBIT ONY )@@G@@N @B@@@@ SA,S3 A4,0,A2 . TRACEBIT ON @#@@@@. NORMAL EXINZ )@@G@@T @C@@@@ST0300 LA A6,RITDSC . DESCR OF RITEARG @A@@@@ OA )@@G@@ LMJ X11,DUPE . COPY IT @ @@@@ J ST0999 . @C@@@@OB )@@G@@ PUSH A2 . STACK RESULT OF FUNCT@ @@@@ LX X11,SOC )@@G@@TLINK . @B@@@@ J 1,X11 . NORMAL RETURN @]@@@@. ERROOD )@@G@@RS-- @D@@@@ST0900 ERROR YSYNTA,ST0999 . RITEARG IS STAKMARK @B@@@@OE )@@G@@ST0910 ERROR YVALUE,ST0999 . RITEARG @D@@@@ST0920 ERROR YDOMAI,ST09OF )@@G@@99 . RITEARG NOT NUMERIC @[@@@@. @A@@@@ST0999 LX X11,STLINK OG )@@G@@ . @A@@@@ J 0,X11 . @[@@@@. @#@@@@OH )@@G@@ VARBLS . @ @@@@STINDX EQUF $,,Q1 . @ @@@@STLINK EQUF OI )@@G@@ $,,H2 . @ @@@@ RES 1 . @A@@@@/. GET CURREOJ )@@G@@NT VALUE OF STOP/TRACE @[@@@@. @#@@@@ INSTRS . @E@@@@GETSTPOK )@@G@@* SZ STINDX . SET TRACE/STOP INDEX TO STOP @ @@@@ J OL )@@G@@ GT0010 . @[@@@@. @ @@@@GETTRC* LA,U A0,1 . @C@@@@OM )@@G@@ SA A0,STINDX . SET FLAG TO TRACE @[@@@@. @C@@@@GT0010ON )@@G@@ SX X11,STLINK . SAVE RETURN ADDR @E@@@@ LMJ X11,TSINIT OO )@@G@@ . INITIALIZE FUNCTABLE PARAMETERS @ @@@@ J ST0999 . OP )@@G@@@C@@@@ LA A13,TSNLIN . NO OF LINES IN FUNC @F@@@@ SA,H2OQ )@@G@@ A13,GTDUMY . PUT IN LENGTH FIELD OF DUMMY DESCR @D@@@@. ACQUIRE ENOR )@@G@@OUGH SPACE TO HOLD ALL LINES OF THIS FUNC @C@@@@GT0100 LA,U A0,GTDUMY OS )@@G@@ . DUMMY DESCR ADDR @B@@@@ LA,U A1,ZMOHFI . MODE IS HALFINTOT )@@G@@@D@@@@ LMJ X11,PUTANS . INITIALIZE TO STASH RESULT @ @@@@ OU )@@G@@ J ST0999 . @D@@@@ PUSH A6 . STACK RESULT DEOV )@@G@@SCR ADDR @D@@@@ LX X6,A0 . TEMP SAVE ABSADR OF DESCR OW )@@G@@@D@@@@ LX X7,X3 . AND ADDR OF 1ST DATA WORD @C@@@@ OX )@@G@@ LX X4,STINDX . SET STOP/TRACE INDEX @F@@@@ LX X5,TSLIN0 OY )@@G@@ . SET ADDR OF ENTRY FOR LINE 0 OF FUNC @G@@@@ LXI,U X5,1 OZ )@@G@@ . AND STEP THRU LINE TBL IN 1 WD INCREMENTS @E@@@@ SSL A14,3PA )@@G@@6 . CLEAR CT OF NO LINES WITH BITS ON@C@[@@ LDSL A1,72 PB )@@G@@ . CLEAR LINENO CTR @F@@[[ LNA,U A2,1 . BE SURE LIPC )@@G@@NENUM AFTER BUMP IS ZERO@E[@@@GT0110 JNGD A13,GT0130 . EXIT AFTER SCANPD )@@G@@NING ALL LINES @F@@@@ AA,U A2,1 . BUMP CT OF LINE CURREPE )@@G@@NTLY BEING SCANNED@D@@@@ EX GT0120,X4 . IS BIT ON IN THIS LINPF )@@G@@E? @C@@@@ J GT0110 . NO, GO TO NEXT ONE @C@@@@ PG )@@G@@ LMJ X2,0,X2 . YES-STASH LINE NO @E@@@@ AA,U A14,1 PH )@@G@@ . BUMP CT OF TRUE LENGTH OF VECT @D@@@@ J GT0110 . ANDPI )@@G@@ GO BACK FOR NEXT LINE @B@[@@GT0120 TNZ,S2 1,*X5 . CHECK STOPBIT PJ )@@G@@@B@@][GT0120 TNZ,S2 0,*X5 . CHECK STOPBIT @B@[@@ TNZ,S3 1,*XPK )@@G@@5 . CHECK TRACEBIT @B@@][ TNZ,S3 0,*X5 . CHECK TRACEBIT PL )@@G@@@C]@@@. NOW VECT HAS BEEN CREATED-- FREE UNUSED SPACE @F@@@@GT0130 SA,H2PM )@@G@@ A14,0,X6 . ADJUST LENGTH OF VECT IN ITS DESCR @B@@@@ AA,U PN )@@G@@ A14,1 . ROUND UP LENGTH@C@@@@ SSL A14,1 . AND GET NPO )@@G@@O WORDS USED@D@@@@ LA,U A1,0,X7 . RECOVER FWA OF DATA AREA PP )@@G@@@ @@@@ RELADR A1 . @E@@@@ AA A1,A14 . PLUPQ )@@G@@S NO WDS USED =FWA TO FREE @G@@@@ LA A0,TSNLIN . NO OF ELSPR )@@G@@ IN ORIGINAL RESERVE WAS NO OF LINES@A@@@@ AA,U A0,1 . ROUPS )@@G@@ND @D@@@@ SSL A0,1 . CONVERT TO WDS RESERVED @D@@@@PT )@@G@@ ANA A0,A14 . LESS NO WDS USED=NO TO FREE@C@@@@ JZ PU )@@G@@ A0,GT0140 . IF NONE, GET OUT @D@@@@ FREE . ELSPV )@@G@@E RELEASE THE SPACE @ @@@@GT0140 LX X11,STLINK . @B@@@@ PW )@@G@@ J 1,X11 . NORMAL EXIT @#@@@@ VARCON . @B@@@@GTDUMYPX )@@G@@ CBLOCK ZTPTMP,ZMOHFI,ZRANKV,0 . @G@@@@/. INITIALIZE PARAMETERS TOPY )@@G@@ ACCESS FUNCTBL (NAMEBLOK ADDR IN A2) @#@@@@ INSTRS . @ @@@@PZ )@@G@@TSINIT SX X11,TILINK . @C@@@@ ABSADR A2 . ABSADR OFQA )@@G@@ NAMEBLOK @D@@@@ LA,H2 A0,1,A2 . DESCR POINTER FROM NAMEBLOKQB )@@G@@@G@@@@TS0010 JZ A0,TS0030 . IF NOTHING CHAINED, FUNC DOESN'T EXIST,QC )@@G@@ VALER@E@@@@ ABSADR A0 . GET ADDR OF 'NEXT' DESCRIPTOR QD )@@G@@@E@@@@ LA,U A3,ZTPFUN . GET FUNCTYPE FOR COMPARISONS @D@@@@QE )@@G@@ TNE,S1 A3,0,A0 . IS THIS DESCR A FUNCBLOK? @D@@@@ J QF )@@G@@ TS0020 . YES, GO SET ITS TABLES UP @C@@@@ LA,H2 A0,2,A0 QG )@@G@@ . NO, GET FWD POINTER @D@@@@ J TS0010 . AND GO EXAMINE QH )@@G@@NEXT DESCR @A@@@@. A0=ABSADR OF DESCR FOR THIS FUNC @D@@@@TS0020 LA,H2QI )@@G@@ A1,0,A0 . GET NO LINES FROM DESCR @E@[@@ ANA,U A1,1 QJ )@@G@@ . DON'T COUNT THE FUNC HEADER LINE @A[@@@ SA A1,TSNLIN . TEMQK )@@G@@P SAVE@F@@@@ LA,H2 A2,1,A0 . GET BASE ADDR OF FUNCTBL FROM DESQL )@@G@@CR @G@@@@ LA,U A2,1,A2 . BUMP PAST BLOK HDR TO POINT AT LIQM )@@G@@NE 0 OF TBL @ @@@@ ABSADR A2 . @C@@@@ SA A2,TSQN )@@G@@LIN0 . SAVE BASE ADDR OF TBL@ @[@@ LX,H2 X11,TILINK . @ @@][QO )@@G@@ LX X11,TILINK . @ [@@@ J 1,X11 . @B@@@@QP )@@G@@TS0030 ERROR YDEFN . FUNC NOT FOUND @ @[@@ LX,H2 X11,TILINK QQ )@@G@@ . @ @@][ LX X11,TILINK . @ [@@@ J 0,X11 QR )@@G@@ . @ @@@@ VARBLS . @#@[@@TILINK RES 1 . @B@[@@QS )@@G@@TSNLIN RES 1 . NO LINES (NOT INCL HDR) @A@@[[TILINK EQUF $,,H1 QT )@@G@@ . @F@@[[TSNLIN EQUF $,,H2 . TOT NO LINES (INCLUDINQU )@@G@@G HEADER) @A@@[[ RES 1 . @#]@@@ VARCOQV )@@G@@N . @G@@@@TSTBAS +1,$-$ . INCREMENT FOR LOADING XREG TO STEP THRQW )@@G@@U FUNCTBL @E@@@@TSLIN0 EQUF TSTBAS,,H2 . BASE ADDR (LINE 0 ) OF FUNCQX )@@G@@TABLE @]@@@@ END .___4,0,X6 . ADJUST LENGTH OF VECT IN ITS DESCQY )@@G@@*[S@@@*SDFF*@G@@@@. ****************************************************QZ )@@G@@***************** @G@@@@. STANDARD PROCS - INCLUDED BY AN @ADD PRCPKG/APRA )@@G@@L IN SOURCE DECKS * @G@@@@. RB )@@G@@ * @G@@@@ AXR$ . RC )@@G@@ * @G@@@@ CONFIG . DEFINE ASSRD )@@G@@EMBLY PARAMETERS * @G@@@@ WSDEF. DEFINRE )@@G@@E WORKSPACE * @G@@@@WORKSP INFO 2 20.RF )@@G@@ SET ASIDE THE SPACE * @G@@@@ RUNCTRG )@@G@@L. DEFINE RUN CTRL BLOK(S) * @G@@@@RUNCONRH )@@G@@ INFO 2 22. AND SET ASIDE ITS SPACE * @G@@@@RI )@@G@@ CBLOCK . DEFINE CONTROL BLOCK TYPES * RJ )@@G@@@G@@@@. RK )@@G@@ * @G@@@@. END OF STANDARD PROC BLOCK RL )@@G@@ * @G@@@@. ****************************************************RM )@@G@@***************** @[@@@@. @D@@@@ FILDEF . DEFINE TARN )@@G@@GS FOR FILE SYSTEM@[@@@@. @[@@@@. @F@@@@WSFRAD EQU WSFREE**077RO )@@G@@7777 . REL ADDR OF FREE LIST HEAD POINTER@E@@@@ IODEF RP )@@G@@ . DEFINE LOCN WITH PERMISSION BITS @G@@@@. DEBUGGING PARAMS TO CONRQ )@@G@@TROL CLEARING OF FREED SPACE TO ZEROES @D@@@@ZEROIT EQU 0 RR )@@G@@ . SET 1 TO FORCE CLEARING @ @@@@ZERON PROCSW ZEROIT . @ @@@@RS )@@G@@ZEROFF ENDSW ZEROIT . @G@[@@OLD EQU 0 . CONTROL ART )@@G@@SM OF 'OLD' OR 'NEW' VERSION OF FREE@E[@@@/. PROCS TO SEARCH THRU FREE LRU )@@G@@IST USING ABSOLUTE ADDRESSES @[@@@@. @#@@@@A PROC . @F@@@@RV )@@G@@AFBGE* NAME 1 . FIND BLOK .GE. EXITS: NOHIT GTR = FALLS THRU @#@@@@RW )@@G@@ UNLI$T . @D@@@@ LA,U A1,WSFREE . ABSADR OF HEAD OF FRERX )@@G@@E LIST@D@@@@AF0010 LA A2,A1 . MAKE OLD BLOK NEW ANCESTOR @E@@@@RY )@@G@@ LA,H2 A1,0,A2 . GET FWD POINTER FROM ANCESTOR @D@@@@ RZ )@@G@@ JZ A1,A(1,1),A(1,2) . IF NONE, END OF CHAIN @D@@@@ ABSADR A1 SA )@@G@@ . ELSE PREPARE TO LOOK AT IT @C@@@@ TLE,H1 A0,0,A1 . IS SB )@@G@@BLOK .GT. NEEDED? @D@@@@ J A(2,1),A(2,2) . YES, GO BREAK ITSC )@@G@@ DOWN @E@@@@ TE,H1 A0,0,A1 . IS IT EXACTLY THE RIGHT SIZE? SD )@@G@@@C@@@@ J AF0010 . NO, KEEP LOOKING @#@@@@ LI$T SE )@@G@@ . @]@@@@ END .@B@@@@/. DYNAMIC STORAGE ALLOCATION ROUTINES SF )@@G@@@G@@@@. FREE SPACE IS MAINTAINED AS A SORTED LIST, THE FIRST WD OF SG )@@G@@EACH @F@@@@. FREE BLOCK CONTAINING THE BLKSIZ (H1) AND FWD POINTERSH )@@G@@ (H2) @G@@@@. BLOCKS ARE ALLOCATED OF EXACTLY THE SIZE REQUESTED, BSI )@@G@@Y SPLITTING @G@@@@. LARGER BLOCKS, IF NECESSARY. WHEN BLOX ARE FREESJ )@@G@@D, THEY ARE THEN @D@@@@. RECOMBINED ON THE LEFT AND RIGHT, IF POSSSK )@@G@@IBLE. @[@@@@. @E@[@@F PROC . BLOCK FINDER PROC--STEPS THRU THE SL )@@G@@FREE LIST. @F@[@@FBGE* NAME 1 . FIND BLOK.GE. A0 (FOR ALLOCATION) . NSM )@@G@@OHIT,EQ,GT @F@[@@FBGT* NAME 2 . FIND BLOK.GT. A0 (FOR FREEING) . NSN )@@G@@OHIT,GT @F@[@@FLSIB* NAME 3 . FIND LEFT SIBLING OF 'BROTHR'-- NOHSO )@@G@@IT,LEFT @F@[@@FRSIB* NAME 4 . FIND RIGHT SIBLING OF 'BROTHR'-- NOHSP )@@G@@IT,RIGHT @G@[@@FSIB* NAME 5 . FIND ANY SIBLING OF 'BROTHR' -- NOHSQ )@@G@@IT,LEFT,RIGHT @D@[@@TYPE EQU F(0,0) . SET NAME LINE ENTRY TSR )@@G@@YPE @[@[@@. @D@[@@LOOP LA,H2 A1,*FATHER . PICK UP ADDR OF NEXT SS )@@G@@SON @#@[@@ UNLIST. @C@[@@ JZ A1,F(1,1) . IF NONE, ST )@@G@@END OF SCAN @ @[@@ SA,H2 A1,SON . @G@[@@ DO TYPE>2 , GO SU )@@G@@FB$020 . IF LOOKING FOR SIBLINGS BYPASS THIS CODE @[@[@@. @B@[@@SV )@@G@@. SEARCH FOR INSERTION/DELETION POINT @[@[@@. @E@[@@ TLE,HSW )@@G@@1 A0,*SON . IS CURRENT SON .LE. WHAT WE WANT @F@[@@ J F(1,4SX )@@G@@-TYPE) . NO, GRTR. WE'RE DONE (PARENT IS FATHER)@G@[@@ DO TYPE=2 , GO FBSY )@@G@@$040 . IF ONLY LOOKING FOR GT, DON'T ASSEMBLE = TEST @C@[@@ TNE,HSZ )@@G@@1 A0,*SON . IS IT EXACTLY RIGHT? @C@[@@ J F(1,2) . YESTA )@@G@@-TAKE EQUALS EXIT @B@[@@ GO FB$040 . ASSEMBLE SKIP TO NEXT BLOK @[@[@@TB )@@G@@. @B@[@@. TAKE CARE OF FREEING - TEST FOR SIBLINGS@[@[@@. @#@[@@TC )@@G@@FB$020* NAME . @F@[@@ TG,H1 A0,*SON . IS CURRENT SON .GT. BTD )@@G@@LOCK BEING FREED? @G@[@@ SA,H2 A1,MOTHER . NO, SMALLER. SON PRETE )@@G@@CEDES, MIGHT BE MOTHER @F@[@@ DO TYPE=3 , GO FB$030 . IF ONLY SEEKING LTF )@@G@@EFT, SKIP RIGHT TEST @D@[@@ TNE A1,R1 . IS SON THE RIGHTG )@@G@@T SIB ? @E@[@@ J F(1,TYPE-2) . YES, TAKE RIGHT SIB HIT EXITH )@@G@@T @F@[@@ DO TYPE=4 , GO FB$040 . IF ONLY SEEKING RIGHT, SKIP LEFT TETI )@@G@@ST @D@[@@FB$030* NAME . . ASSEMBLE LEFT SIBLING TEST @D@[@@TJ )@@G@@ AA,H1 A1,*SON . ADD SIZE OF SON TO ITS LOC @F@[@@ TNE,HTK )@@G@@2 A1,FRATER . IS BROTHER TO IMMEDIATE RIGHT OF SON? @D@[@@ J TL )@@G@@ F(1,2) . YES, SON IS LEFT SIBLING @E@[@@ LA,H2 A1,*FATHER TM )@@G@@ . NO, RECOVER RELATIVE ADDR OF SON @#@[@@FB$040* NAME . @C@[@@ TN )@@G@@ SA,H2 A1,FATHER . OLD SON IS NEW FATHER @B@[@@LAST J LOOP TO )@@G@@ . GO TRY AGAIN @]@[@@ LIST.@]@[@@ END. @[@[@@. @#@[@@TP )@@G@@ PROC . @#@[@@UNLINK* NAME . @ @[@@ LA,H2 A1,*SON TQ )@@G@@. @#@[@@ UNLIST. @ @[@@ SA,H2 A1,*FATHER . @]@[@@TR )@@G@@ LIST.@ @[@@ END . @#@[@@L PROC . TS )@@G@@@#@[@@LINK* NAME . @D@[@@ LA,H2 A1,*L(1,1) . GET SUCCESSOR OTT )@@G@@F PARENT @#@[@@ UNLIST. @E@[@@ SA,H2 A1,*FRATER . MAKTU )@@G@@E IT SUCCESSOR OF BROTHER @B@[@@ LA,H2 A1,FRATER . ADDR OF BTV )@@G@@ROTHER@B@[@@ SA,H2 A1,*L(1,1) . PUT INTO PARENT@]@[@@ LIST.TW )@@G@@@ @[@@ END . @B@@[[. ALLOCATE THE LARGEST AVAILABTX )@@G@@LE BLOCK -- @#@@[[ INSTRS . @A@@[[BALARG* SX X11,BALINK TY )@@G@@. @F@@[[ LA,U A1,WSFREE . GET ADDR OF 1ST POINTER TO ETZ )@@G@@XAMINE@F@@[[BL0010 LA,H2 A0,0,A1 . GET FWD LINK FROM CURRENT POUA )@@G@@INTER @G@@[[ JZ A0,BL0020 . IF NONE, A1 POINTS TO LARGESUB )@@G@@T BLOCK @F@@[[ LA A2,A1 . ELSE TEMP SAVE POINTERUC )@@G@@ TO ANCESTOR@D@@[[ AU,U A0,0,WSTAG . MAKE POINTER ABSOLUTE UD )@@G@@@E@@[[ J BL0010 . AND GO EXAMINE NEXT BLOCK @E@@[[UE )@@G@@BL0020 TZ,H2 WSGARB . ANY GARBAGE LAYING AROUND? @C@@[[ UF )@@G@@ LMJ X11,GARBAG . YES, COLLECT IT @D@@[[ LX X11,BALINUG )@@G@@K . RESTORE OUR LINKAGE @F@@[[ SZ WSFFWA . CLEAUH )@@G@@R BOUNDARIES OF UNLIKED BLOCK @A@@[[ SZ WSFLWA . UI )@@G@@@G@@[[ TNZ,H2 WSFREE . IS THERE ANYTHING WHICH CAN BE UNLUJ )@@G@@INKED?@F@@[[ J 0,X11 . NO, EXIT LEAVING POINTERS ZEUK )@@G@@RO @F@@[[ SZ,H2 0,A2 . NO, CLEAR FWD PTR OF ANCESTOUL )@@G@@R @E@@[[ ANU,U A1,0,WSTAG . GET REL ADDR OF TARGET BLOCKUM )@@G@@@F@@[[ SA A2,WSFFWA . POST 1ST WD ADDR OF UNLINKED BLOCKUN )@@G@@@E@@[[ AA,H1 A2,0,A1 . ADD ITS SIZE TO ITS ADDR @E@@[[UO )@@G@@ ANA,U A2,1 . GET TRUE LAST WORD ADDR @B@@[[ UP )@@G@@ SA A2,WSFLWA . POST IT @C@@[[ J 0,X11 UQ )@@G@@. NORMAL EXIT @[@@[[. @G@@[[. GET SIZE OF LARGEST AVAILABLE BLOCUR )@@G@@K-- USED WHEN AN INTERNAL CHOICE OF @G@@[[. ALGORITHMS IS TO BE MADE DEPUS )@@G@@ENDING ON HOW MUCH SPACE IS AVAILABLE @[@@[[. @A@@[[BFLARG* SX UT )@@G@@ X11,BALINK . @E@@[[ TZ,H2 WSGARB . ANY GARBAGUU )@@G@@E TO BE COLLECTD? @C@@[[ LMJ X11,GARBAG . YES, COLLECT IT UV )@@G@@@C@@[[ LX X11,BALINK . RESTORE LINKAGE @D@@[[ LA,UUW )@@G@@ A0,0 . SET INITIAL SIZE ZERO @D@@[[ LA,H2 A1,WSFREEUX )@@G@@ . GET STARTING POINTER @E@@[[BG0010 JZ A1,0,X11 . EXITUY )@@G@@ IF NO MORE POINTERS @F@@[[ ABSADR A1 . ELSE GET AUZ )@@G@@DDR OF TARGET BLOCK @C@@[[ LA,H1 A0,0,A1 . PICK UP ITVA )@@G@@S SIZE@D@@[[ LA,H2 A1,0,A1 . GET ITS FOWARD LINK @F@@[[VB )@@G@@ J BG0010 . AND GO SEE IF ITS THE LAST BLOK @[;@@@VC )@@G@@. @D@@@@. ***** ALLOCATE A BLOK. A0=SIZE, LOC RETURNED IN A1 @[@@@@VD )@@G@@. @#@[@@ INSTRS . @ @[@@BALLOC* SA A2,A2SAVE . @G@@[[VE )@@G@@BALLOG* SA A0,BAGLOF . SET FLAG TO ALLOCATE FROM GLOBAL POOL VF )@@G@@@A@@[[ J BA0005 . @E@@[[BALLOC* SZ BAGLOF VG )@@G@@ . LOWER GLOBAL ALLOCATION FLAG@A@@[[BA0005 SA A2,A2SAVE VH )@@G@@. @E@[@@ AFBGE 0,X11 BA0100 . LOOK FOR BLOK .GE. REQUIRED VI )@@G@@@E@[@@ LR,H2 R1,0,A1 . FOUND IT-- GET ITS FOWARD LINK @E@@[[VJ )@@G@@ AFBGE BA0020 BA0100 . LOOK FOR BLOCK .GE. RQUIRED @C@@[[. A BLVK )@@G@@OCK OF THE EXACT SIZE HAS BEEN FOUND -- @C@@[[BA0010 LR,H2 R1,0,A1 VL )@@G@@ . GET ITS FWD LINK@C^@@@ SR,H2 R1,0,A2 . PUT INTO ITS ANVM )@@G@@CESTOR@F@@@@ RELADR A1 . SET ADDR OF BLOK FOUND TO RELATIVVN )@@G@@E @ @@@@ LA A2,A2SAVE . @B@@@@ J 1,X11 VO )@@G@@ . AND GO HOME @E@@[[. NO BLOCK LARGE ENOUGH EXISTS, TRY TO MCORE$ FOVP )@@G@@R MORE SPACE@D@@[[BA0020 SA A0,BARSIZ . SAVE REQUEST SIZE VQ )@@G@@@F@@[[ SA A2,BALAST . AND ADDR OF LAST BLOK ON CHAIN VR )@@G@@@G@@[[ AA,U A0,4095 . ROUND UP REQUEST SIZE TO AN ALLOCAVS )@@G@@TION @E@@[[ DSL A0,12+36 . CONVERT TO AN INDEX IN A1 VT )@@G@@@E@@[[ LXI A0,A1 . BUILD LEFT HALF OF SIZE WORD@F@@[[VU )@@G@@ LSSL A1,12 . MPY INDEX BY 4096 GIVING WORDS @G@@[[VV )@@G@@ SA A1,BAXSIZ . SAVE NO WDS REQUESTED FOR EXPANSION VW )@@G@@@F@@[[ LXM A0,A1 . COMPLETE OCNSTRUCTION OF SIZE WORDVX )@@G@@@G@@[[ AA A0,WSASIZ . REQUEST PLUS PRESENT SIZE = NEW TOVY )@@G@@TAL @E@@[[ ANU A0,WSMSIZ . LESS MAX EXPANSION ALLOWED VZ )@@G@@@E@@[[ TG,U A1,1 . CAN WE EXPAND THIS MUCH @E@@[[WA )@@G@@ J BA0210 . NO, GO TAKE WSFULL EXIT @A@@[[. EXPAWB )@@G@@NSION IS ALLOWED, TRY TO DO IT@C@@[[BA0030 SX X11,BALINK . SAVEWC )@@G@@ LINKAGE @F@@[[ SA A3,BASVA3 . AND REG WHICH CORGET MWD )@@G@@AY TRASH @F@@[[ SA A0,BASREQ . SAVE PARAM SPECIFYING WE )@@G@@REQUEST SIZE@D@@[[ LMJ X11,CORGET . TRY TO ACQUIRE IT WF )@@G@@@E@@[[ J BA0200 . IF NOGO, TAKE WSFULL EXIT @D@@[[WG )@@G@@. WE'VE GOT THE CORE, SET WS POINTERS ACCORDINGLY @G@@[[BA0040 LA,UWH )@@G@@ A1,WSWORK . GET ADDR OF NOMINAL START OF FRE E SPACE@G@@[[ WI )@@G@@ AA,H2 A1,WSASIZ . PLUS OLD SIZE GIVES LWA+1 = NEW BLOK ADR@E@@[[WJ )@@G@@ LA A0,BAXSIZ . GET NO WDS WE EXPANDED BY @B@@[[ WK )@@G@@ LSSL A0,18 . LINE UP @E@@[[ SA A0,0,A1 WL )@@G@@. CRAM INTO HEADER OF NEW BLOK@F@@[[ LA A2,BALAST . LASTWM )@@G@@ BLOK IS ANCEST OF THIS ONE @D@@[[ RELADR A1 . GET WN )@@G@@RELAD OF THIS BLOK@E@@[[ SA,H2 A1,0,A2 . AND STUFF LINK IWO )@@G@@NTO ANCEST @F@@[[ ABSADR A1 . CHG NEW BLOK ADDR BACKWP )@@G@@ TO ABSOLUTE@D@@[[ LA A0,BASREQ . GET REQUEST SIZE WORD WQ )@@G@@@E@@[[ SA A0,WSASIZ . MAKE IT NEW ACTUAL SIZE @C@@[[WR )@@G@@ LX X11,BALINK . RECOVER LINKAGE @D@@[[ LA A3,WS )@@G@@BASVA3 . AND WORK REGISTER @E@@[[ LA A0,BARSIZ WT )@@G@@. GET SIZE OF ORIGINAL REQUEST@F@@[[ TNE,H1 A0,0,A1 . DID WU )@@G@@WE MCORE$ EXACTLY ENOUGH? @C@@[[ J BA0010 . YES,WV )@@G@@ GO PROCESS @F@@[[ . NO, FALL THRU TO SPLITWW )@@G@@ THE BLOK @D@@@@. FOUND BLOK .GT. NEEDED-- RELEASE UNUSED PORTION WX )@@G@@@E@@@@BA0100 SA A1,R1 . TEMP SAVE ADDR OF FOUND BLOCK @E@@@@WY )@@G@@ ANA,H1 A0,0,A1 . DESIRED SIZE LESS FOUND SIZE @G@@@@ WZ )@@G@@ LMA A0,A0 . GIVES SIZE OF BLOK TO REPLACE ON FREE LIST @D@@@@XA )@@G@@ LA,H2 A1,0,A1 . FWD POINTER FROM FOUND BLOK@G@@@@ SA,H2XB )@@G@@ A1,0,A2 . STUFF INTO ANCESTOR OF BLOK WE JUST FOUND @C@@@@. NOW XC )@@G@@SEARCH FOR INSERTION POINT OF SPLIT BLOK @ @@@@ AFBGE BA0110 BA01XD )@@G@@10 . @G@@[[. NOW ALLOCATE FROM LEFT OR RIGHT SIDE DEPENDING ON GLOBAL/LXE )@@G@@OCAL FLAG @F@@@@BA0110 LA A1,R1 . RECOVER ADDR OF PREVIOUSLY XF )@@G@@FOUND BLOK @G@@[[ AA A1,BAGLOF . IF GLOBAL, MOVE TO RIGXG )@@G@@HT SIDE OF BLOCK @G@@@@ SA,H1 A0,0,A1 . SET SIZE OF NEWLY FREXH )@@G@@ED BLOK IN ITS HDR WD @D@@@@ LR,H2 R1,0,A2 . GET FWD LINK FRXI )@@G@@OM ANCESTOR @E@@@@ SR,H2 R1,0,A1 . SET FWD LINK OF BLOK BEING XJ )@@G@@FREED @E@@@@ RELADR A1 . REL ADDR OF BLOK BEING FREED XK )@@G@@@E@@@@ SA,H2 A1,0,A2 . TO POINTER FIELD OF ANCESTOR @G@[@@XL )@@G@@ AA A1,A0 . ADDR OF ALLOCATED BLOK=FREED PLUS ITS SIZE XM )@@G@@@E@@[[ TZ BAGLOF . IS THIS A LOCAL ALLOCATION? @F@@[[XN )@@G@@ LNA A0,BAGLOF . NO GLOBAL. GET ADDR ADJUSTMENT VAL@G@@[[XO )@@G@@ AA A1,A0 . ADJUST FREBLK ADR GIVING ALLOCATED ADR XP )@@G@@@ [@@@ LA A2,A2SAVE . @B@@@@ J 1,X11 . SO XQ )@@G@@LONG.... @[@[@@. @D@[@@. ***** TO FREE A BLOCK... SET A0=SIZE, A1XR )@@G@@=BLOCK LOC @[@[@@. @#@[@@ PROC . @D@[@@LSIB* NAME . COMXS )@@G@@BINE LEFT SIBLING (SON) WITH BROTHER@D@[@@ UNLINK . REMOVE ITXT )@@G@@ FROM THE FREE LIST @#@[@@ UNLIST. @E@[@@ AA,H1 A0,*SXU )@@G@@ON . ADD SIZE OF SON TO SIZE OF BROTHER @D@[@@ SA,H1 A0,*SON . SXV )@@G@@AVE SIZE OF COMBINED BLOCK @#@[@@ ZERON . @D@[@@ SZ XW )@@G@@ *FRATER . CLEAR CTL WD OF OLD BROTHER@#@[@@ ZEROFF . @G@[@@XX )@@G@@ LA,H2 A1,FATHER . OLD FATHER PRECEDED SON, SO MUST BE SMALLER XY )@@G@@@G@[@@ SA,H2 A1,MOTHER . HENCE IT ALSO PRECEDES THE COMBINED BLOXZ )@@G@@CK @G@[@@ LA,H2 A1,SON . SINCE SON WAS LEFT BLOK, MAKE IT YA )@@G@@BROTHER @^@[@@ SA,H2 A1,FRATER @]@[@@ LIST.@]@[@@ YB )@@G@@ END .@#@[@@ PROC . @E@[@@RSIB* NAME . COMBINE RIGHT SIBLINGYC )@@G@@ (SON) WITH BROTHER @#@[@@ UNLINK . @#@[@@ UNLIST. YD )@@G@@@B@[@@ AA,H1 A0,*SON . ADD SIZE OF SON@E@[@@ SA,H1 A0,*FYE )@@G@@RATER . TO BROTHER, GIVING NEW TOTAL SIZE@G@[@@ LA,H2 A1,FATHER YF )@@G@@ . OLD FATHER PRECEDED SON, SO MUST BE SMALLER @G@[@@ SA,H2 A1,MOYG )@@G@@THER . HENCE IT ALSO PRECEDES THE COMBINED BLOCK @#@[@@ ZERONYH )@@G@@ . @D@[@@ SZ *SON . CLEAR POINTER OF OLD SON @#@[@@YI )@@G@@ ZEROFF . @]@[@@ LIST.@]@[@@ END .@[@[@@. @H@[@@YJ )@@G@@. THE CODE BELOW HAS BEEN IN THIS PROGRAM SINCE DAY 1, AND BECAUSE OF THYK )@@G@@E @G@[@@. INDIRECT ADDRESSING, SHOULD RUN SLOWER THAN CODE WHICH EXEYL )@@G@@CUTED USING @G@[@@. ONLY REGISTERS. FOR REASONS WHICH ARE PRESENTLY A MYM )@@G@@YSTERY, IT SEEMS @F@[@@. THAT IT ACTUALLY RUNS FASTER THAN THE REGISTERYN )@@G@@ VERSION, WHICH IS@G@[@@. PRESERVED FOR HISTORICAL REASONS BELOW. PERHAYO )@@G@@PS THE 'NEW' CODE (WHICH@G@[@@. IS, OF COURSE, PROCCED OUT, HAS SOME EXTYP )@@G@@RA INSTRUCTIONS I CANT FIND @H@[@@. NOW. IN ANY EVENT, WE KEEP BOTH VYQ )@@G@@ERSIONS AROUND, BUT USE THE OLDER ONE @D@[@@. UNTIL WE FIGURE WHY THYR )@@G@@E NEW ONE RUNS SLOWER...... @[@[@@. @ @[@@ ON OLD YS )@@G@@ . @[@[@@. @]@[@@BLFREE* . @E@[@@ SA,H2 A1,FRATER . SAVYT )@@G@@E ADDR OF BLOK BEING RELEASED @E@[@@ TG,U A0,1 . IS AT LEAYU )@@G@@ST 1 WORD TO BE FREED? @G@[@@ TLE,U A1,WSYTBL**0777777 . IS ADYV )@@G@@DR TO BE FREED REASONABLE? @F@[@@ ER ERR$ . NO, TRYINYW )@@G@@G TO FREE PERMANENT STUFF!! @C@[@@ SA,H1 A0,*FRATER . SAVE ITS YX )@@G@@SIZE ALSO @E@[@@ ZERON . NO NEED TO CLEAR UNLESS DEBUYY )@@G@@GGING @C@[@@BR0005 AA A1,WSTAG . GET ABS ADDR OF BLOCK@C@[@@ YZ )@@G@@ LXI,U A1,1 . STEP ONE WD AT A TME @E@[@@ ANA,U A0,1 ZA )@@G@@ . COMPENSATE BLK SIZE FOR HEADER WD@F@[@@ J $+2 . ANDZB )@@G@@ START CLEARING ALL BUT THE HDR @D@[@@ SZ 1,*A1 . CLEZC )@@G@@AR ALL BUT HEADER WORD @ @[@@ JGD A0,$-1 . @E@[@@ ZD )@@G@@ LA,H2 A1,FRATER . RECOVER RELATIVE ADDR OF BLOCK @C@[@@ LA,H1ZE )@@G@@ A0,*FRATER . AND ITS SIZE ALSO @#@[@@ ZEROFF . @D@[@@ ZF )@@G@@ AA A1,A0 . ADD SIZE TO ADDR OF BROTHER@F@[@@ SA A1,R1ZG )@@G@@ . TEMP SAVE ADDR OF RIGHT HAND SIBLING @F@[@@. SCAN FREE LIST FZH )@@G@@OR LEFT/RIGHT SIBLINGS AND POSITION OF THIS BLOK@F@[@@ LA,U A1,WSZI )@@G@@FRAD . START SEARCH AT START OF FREE LIST @^@[@@ SA,H2 A1,FAZJ )@@G@@THER @G@[@@ SA,H2 A1,MOTHER . SAVE MOTHER IN CASE BLOK HAS NO SZK )@@G@@IBLINGS @E@[@@BR0010 FSIB BR0400,BR0100,BR0200 . FIND SIBLINGS, IF ZL )@@G@@ANY @E@[@@. THE LEFT SIBLING HAS BEEN FOUND (IT IS THE CURRENT SON) ZM )@@G@@@E@[@@BR0100 LSIB . COMBINE LEFT SIB AND BROTHER @C@[@@ZN )@@G@@ FRSIB BR0400,BR0110 . FIND RIGHT SIBLING@F@[@@BR0110 RSIB ZO )@@G@@ . COMBINE RIGHT SIBLING WITH BROTHER @G@[@@ J BR030ZP )@@G@@0 . BOTH SIBS FOUND, GO INSERT COMBINED BLOCK @F@[@@. RIGHT SIBLZQ )@@G@@ING FOUND ... COMBINE IT, AND KEEP LOOKING FOR LEFT @F@[@@BR0200 RSIB ZR )@@G@@ . COMBINE RIGHT SIBLING WITH BROTHER @C@[@@ FLSIBZS )@@G@@ BR0400,BR0210 . FIND LEFT SIBLING @E@[@@BR0210 LSIB . COMZT )@@G@@BINE LEFT SIB AND BROTHER @F@[@@. BOTH SIBS FOUND.. INSERT COMBINED ZU )@@G@@BLOCK (BROTHER) IN FREE LIST @E@[@@BR0300 FBGT BR0310,BR0310 . SRCH FOZV )@@G@@R BLOK .GT. THIS, IF ANY@E@[@@BR0310 LINK FATHER . LINK THIS BLOCKZW )@@G@@ AFTER FATHER @#@[@@ J 0,X11@C@[@@. SIBLING SRCH HAS EXHAUZX )@@G@@STED LIST- LINK AND EXIT@F@[@@BR0400 TLE,H1 A0,*FATHER . DOES THIS BLOCKZY )@@G@@ FOLLOW THE CHAIN END+ @C@[@@ J BR0410 . NO, GO INSERT IZZ )@@G@@T @G@[@@ LINK FATHER . YES, ADD THIS BLOK TO EXTREME ENDAA )@@G@@ OF CHAIN @A@[@@ J 0,X11 . AND QUIT @G@[@@BR0410 LINK AB )@@G@@ MOTHER . IMBED BLOK SOMWHERE IN INTERIOR OF CHAIN @ @[@@ AC )@@G@@ J 0,X11 . @[@[@@. @#@[@@ VARCON . @ @[@@FATHERAD )@@G@@ J 0,WSTAG . @ @[@@SON J 0,WSTAG . @ @[@@MOTHERAE )@@G@@ J 0,WSTAG . @ @[@@FRATER J 0,WSTAG . @#@[@@ AF )@@G@@ VARBLS . @ @[@@A2SAVE RES 1 . @#@[@@ OFF . AG )@@G@@@]@@[[. WS FULL --@A@@[[BA0200 LX X11,BALINK . @A@@[[ AH )@@G@@ LA A3,BASVA3 . @A@@[[ LA A0,BASREQ . AI )@@G@@@A@@[[BA0210 LA A2,A2SAVE . @A@@[[ J 0,X11 AJ )@@G@@ . @#@@[[ VARBLS @A@@[[BASVA3 RES 1 AK )@@G@@. @E@@[[BASREQ RES 1 . CTL WD FOR GLOBAL REQUEST AL )@@G@@@D@@[[BAXSIZ EQUF $,,H1 . NO OF WDS OF EXPANSION@D@@[[BARSIZAM )@@G@@ EQUF $,,H2 . ORIGINAL REQUEST SIZE @A@@[[ RES 1 AN )@@G@@ . @A@@[[BALINK EQUF $,,H1 . @A@@[[BALASTAO )@@G@@ EQUF $,,H2 . @A@@[[ RES 1 . AP )@@G@@@G@@[[BAGLOF EQUF $,,XH2 . CAUTION, SIGN EXTENSION IS REQUIREAQ )@@G@@D @A@@[[ RES 1 . @[_@@@/. @G@@@@. THISAR )@@G@@ IS THE RECODED VERSION OF THE FREE ROUTINE WHICH, BY ALL RIGHTS @F@@@@AS )@@G@@. SHOULD RUN FASTER THAN THE CODE ABOVE, BUT IT DON'T. WHAAAA?????@G@@@@AT )@@G@@. (NOTE.. IT IS DEBUGGED, AND DOES THE RIGHT THINGS, IT JUST DOES THEM AU )@@G@@@]@@@@. SLOWLY) @[@@@@. @E@@@@ ON 1-OLD . TURN ON SAV )@@G@@UPPOSEDLY FASTER CODE @[@@@@. @#@@@@B PROC . @G@@@@BSRCH*AW )@@G@@ NAME 0 . SEARCH FREE LIST FOR BUDDIES ON RITE/LEFT @ @@@@AX )@@G@@ UNLI$T . @D@@@@BLEFT EQU B(1,2)+0 . STRIP OFFAY )@@G@@ ASTERISK, IF ANY @ @@@@BRITE EQU B(1,3)+0 . @E@@@@LOOP JZ AZ )@@G@@ A2,B(1,1) . EXIT IF NO MORE BLOCKS TO SCAN @G@@@@ ABSADR A2 BA )@@G@@ . ELSE SET UP TO EXAMINE CURRENT CANDIDATE @D@@@@ DO B(1,*3) BB )@@G@@, JE A2,R1 BRITE . TEST FOR RIGHT BUDDY @E@@@@ DO 1-B(1,*2) , GO BI$01BC )@@G@@0 . SETUP FOR LEFT BUDDY TEST @G@@@@ AU,H1 A2,0,A2 . ADDBD )@@G@@ SIZE OF BLOK TO ITS ADR, GIVING RITE SIDE@E@@@@ JE A3,A1 BLEFTBE )@@G@@ . OUT IF THIS IS LEFT BUDDY @E@@@@BI$010* NAME . STEP TO NEXT BLBF )@@G@@OK, TEST FOR INSERTION POINT @D@@@@ LX X11,A2 . SAVE ADDRBG )@@G@@ FOR FWD SCAN @G@@@@ TG,H1 A0,0,X11 . IS SIZE OF CANDIDATE BH )@@G@@.GT. BLOK BEING FREED? @E@@@@ SX X11,ANCEST . NO, IT PRECEDESBI )@@G@@, SO SAVE ITS ADDR@F@@@@ LA,H2 A2,0,X11 . PICK UP FWD LINK FROMBJ )@@G@@ NEW CANDIDATE @D@@@@ J LOOP . AND CONTINUE SEARCHINBK )@@G@@G @#@@@@ LI$T . @#@@@@ END . @[@@@@. @G@@@@BL )@@G@@ PROC . COMBINE BLOCK WHOSE ADDR IS IN A2 WITH BLOK BEING FREED BM )@@G@@@ @@@@COMB* NAME 0 . @ @@@@ UNLI$T . BN )@@G@@@F@@@@ AA,H1 A0,0,A2 . PUT ITS SIZE INTO CORRENT TOTAL SIZE BO )@@G@@@C@@@@ LA,H2 A2,0,A2 . GET ITS FWD LINK @B@@@@ SA,H2BP )@@G@@ A2,0,X11 . CLOSE THE CHAIN@G@@@@ SX X11,ANCEST . SAVE CURRBQ )@@G@@ENT ANCESTOR FOR INTERIOR IMBEDDING @#@@@@ LI$T . @#@@@@ BR )@@G@@ END . @[@@@@. @ @@@@ INSTRS . @E@@@@BLFREEBS )@@G@@* TG,U A0,1 . IS AT LEAST 1 WD TO BE FREED? @E@@@@ TLE,UBT )@@G@@ A1,WSYTBL**0777777 . IS ITS ADDR REASONABLE?@ @@@@ ER ERR$ BU )@@G@@ . @C@@@@ SX,H2 X11,BFLINK . SAVE RETURN ADDR @D@@@@BV )@@G@@ DS A2,A2SAVE . TEMP SAVE WORKING REGS @E@@@@ ABSADBW )@@G@@R A1 . MAKE ADDR OF BLOK BEING FREED ABS@G@@@@ AU A1,A0BX )@@G@@ . ADD SIZE GIVING ADDR OF BLOK TO ITS RIGHT @E@@@@ SA BY )@@G@@ A2,R1 . TEMP SAVE ADDR OF RIGHT BUDDY @A@@@@. INITIALIZE POINTBZ )@@G@@ERS FOR SEARCH @E@@@@BF0010 LX,U X11,WSFREE . ABS ADDR OF START OF CA )@@G@@FREE LIST @F@@@@ SX X11,ANCEST . MAKE ANCESTOR FOR INTERNAL CB )@@G@@INSERTION @E@@@@ LA,H2 A2,0,X11 . PICK UP ADDR OF BLOK POINTECC )@@G@@D TO @[@@@@. @F@@@@BF0100 BSRCH BF0500,*BF0200,*BF0300 . SEARCHCD )@@G@@ FOR EITHER BUDDY @G@@@@. SCAN HAS DETECTED LEFT BUDDY-- SET LINKS, CONTCE )@@G@@INUE SEARCH FOR RIGHT @F@@@@BF0200 LA A1,A2 . MAKE BUDDY ADDRCF )@@G@@ FWA OF BLOK BEING FREED@F@@@@ COMB . COMBINE ITS SIZCG )@@G@@E, STEP TO NEXT LINK @G@@@@ BSRCH BF0500,,*BF0210 . CONTINUE SCH )@@G@@EARCH FOR RIGHT BUDDY ONLY @F@@@@BF0210 COMB . COMBINE FCI )@@G@@OUND RIGHT BUDDY AND STEP @E@@@@ J BF0400 . GO FWD SCCJ )@@G@@AN FOR INSERTION POINT @G@@@@. SCAN HAS DETECTED RIGHT BUDDY-- LINK ANDCK )@@G@@ CONTINUE SEARCH FOR LEFT ONE @F@@@@BF0300 COMB . COMBINE RCL )@@G@@ITE WITH CURRENT, SCAN NEXT @G@@@@ BSRCH BF0500,*BF0310,0 . TESTCM )@@G@@ CURRENT BLOK FOR LEFT BUDDY ONLY @F@@@@BF0310 LA A1,A2 . LEFCN )@@G@@T BUDDY IS FWA OF BLOK BEING FREED @E@@@@ COMB . FOLCO )@@G@@D INTO FREEBLOK, STEP FWD @E@@@@ J BF0400 . AND GO FWCP )@@G@@D SRCH FOR INSERT POINT @F@@@@. BOTH BUDDIES HIT AND COMBINED-- CONTINUECQ )@@G@@ SCAN TO INSERTION POINT@F@@@@ SA A2,ANCEST . CURRENT BLOK NOCR )@@G@@T GTR, MAKE IT ANCESTOR @ @@@@ LX,H2 A2,0,A2 . @G@@@@BF0400CS )@@G@@ JZ A2,BF0500 . IF NO FWD LINK, USE MOST RECENT ANCESTOR @F@@@@CT )@@G@@ ABSADR A2 . ELSE SET UP TO LOOK AT CURRENT BLOCK @G@@@@CU )@@G@@ TG,H1 A0,0,A2 . IS CURRENT BLOK .GT. THE ONE BEING FREED? CV )@@G@@@C@@@@ J BF0400-2 . NO, KEEP LOOKING @F@@@@. END OF LISCW )@@G@@T HIT DURING BUDDY SEARCH-- INSERT BLOK IN FREE LIST @F@@@@BF0500 LA CX )@@G@@ A2,ANCEST . ADDR OF BLOK WHICH PRECEDES THIS ONE @G@@@@ SA,H1CY )@@G@@ A0,0,A1 . POST SIZE OF NEWLY FREED BLOK IN ITS HEADER @D@@@@ CZ )@@G@@ LA,H2 A0,0,A2 . GET FWD LINK OF ANCESTOR @D@@@@ SA,H2 A0,0,DA )@@G@@A1 . PUT INTO NEWLY FREED BLOCK @D@@@@ RELADR A1 . ADDDB )@@G@@R OF BLOK BEING FREED @B@@@@ SA,H2 A1,0,A2 . TO ANCESTOR DC )@@G@@@C@@@@ DL A2,A2SAVE . RECOVER SAVED REGS @A@@@@ J DD )@@G@@ *BFLINK . AND EXIT @ @@@@ VARBLS . @D@@@@A2SAVEDE )@@G@@ RES 2 . TEMP STORAGE OF A2 AND A3 @G@@@@ANCEST RES 1 DF )@@G@@ . ADDR OF LAST BLOK SMALLER THAN BLOK TO FREE @ @@@@ VARCODG )@@G@@N . @G@@@@BFLINK +0,$-$ . RETURN ADDR (CAUTION-DH )@@G@@- INDIRECTION THRU HERE)@]@@@@ OFF @F@@[[GARBAF* . DUMMY RTNE USEDI )@@G@@D UNTIL NEW GARBAGE COLLECTOR IS TURNED ON@D@@[[GARBAG SZ WSGARB DJ )@@G@@ . CLEAR GARBAGE LIST PTR@A@@[[ J 0,X11 . EXITDK )@@G@@@G@@@@/. CLEAR ALL FREE BLOCKS TO ZERO-- NEEDED IN PRODUCTION VERSIONS ODL )@@G@@F APL @G@@@@. SO THAT )SAVE ROUTINE WILL BE ABLE TO COMPACT IDENTICAL LODM )@@G@@CATIONS @G@@@@. CONTAINING ZEROES. REDUNDANT IN DEBUGGING ASSEMBLIEDN )@@G@@S (UOM NON-ZERO), @G@@@@. AS THEN BLOCKS ARE ZEROED EACH TIME THEY ARE FDO )@@G@@REED (FOR PRETTY DUMPS) @[@@@@. @#@@@@ INSTRS . @E@@@@ZRFREEDP )@@G@@* LA,U A4,0 . GET A ZERO TO BE BROADCASTED @G@@@@ LA,U DQ )@@G@@ A3,A4 . MAKE 'FROM' REG POINT TO THE ZERO WE JUST GOT@D@@@@ DR )@@G@@ LXI,U A2,1 . 'TO' REG INCR IS ONE WORD @G@@@@ LA,U A0,WSDS )@@G@@FREE . SET ADDR OF LAST BLOK HDR = HEAD OF LIST @C@@@@. LOOP OVER DT )@@G@@ALL BLOCKS ON FREE STORAGE LIST @F@@@@ZF0010 LA,H2 A0,0,A0 . RELDU )@@G@@ADR OF NEXT BLOK FROM LAST BLOK @D@@@@ JZ A0,1,X11 . IF DV )@@G@@NO MORE BLOX, GET OUT @E@@@@ ABSADR A0 . HDR WD ADDR OF DW )@@G@@BLOK TO BE CLEARED@D@@@@ LA,H1 A1,0,A0 . GET BLOK SIZE FROM HDDX )@@G@@R WD @D@@@@ JZ A1,ZF0900 . ZERO BLOCK SIZE IS SYSERR @D@@@@DY )@@G@@ TLE,U A1,2 . IS BLOCK AT LEAST 2 WDS? @C@@@@ J DZ )@@G@@ ZF0010 . NO, NOTHING TO CLEAR @E@@@@ ANA,U A1,1 . YESEA )@@G@@, DON'T COUNT HEADER WORD @D@@@@ LR R1,A1 . SET NO OFEB )@@G@@ WDS TO BE CLEARED@E@@@@ LXM,U A2,1,A0 . FWA TO CLEAR IS WORD EC )@@G@@AFTER HEADER@E@@@@ BT A2,0,*A3 . BROADCAST ZEROES FROM A4 TOED )@@G@@ WS @D@@@@ J ZF0010 . GO BACK FOR NEXT BLOCK @F@[@@EE )@@G@@ZF0900 ERROR YSYSTM . FREE LIST BUSTED (ZERO LENGTH BLOCK) @ @[@@EF )@@G@@ J 0,X11 . @[@[@@. @D@@[[ZF0900 EQU 0 EG )@@G@@ . SYSERR IS JUMP TO IGDM@E#@@@/. GLOBAL CORE MGMNT RTNES-- HANDEH )@@G@@LE MCORE$/LCORE$ FOR @G@@@@. MASTER TERMINALS, )COPY CMNDS, )LOADEI )@@G@@ OR )CLEAR OF VARIABLE SIZE WS@G@@[[. THE ONE-WORD COMMON BLOCKS BELOW AEJ )@@G@@RE 'IN'NED IN THE MAP SO AS TO LIE @G@@[[. AT THE START OF THE MASTER CEK )@@G@@ONSOLE AND INITIALIZATION CODE BLOCKS. @G@@[[. THIS GETS US SOME DEFIEL )@@G@@NED TAGS WE CAN USE AS BASE ADDRESSES FOR LCORE$@[@@[[. @#@@[[ EM )@@G@@ MASTER @A@@[[MCORIG '**MC**' . @E@@[[STMAST INFOEN )@@G@@ 2 MCINFO . DEFINE MASTER CONSOLE BLOCK @#@@[[ INITAL . EO )@@G@@@A@@[[INORIG '**IN**' . @E@@[[STINIT INFO 2 ININFO EP )@@G@@ . DEFINE INITIALIZATION BLOCK @[@@@@. @G@@@@. CORE INITIALEQ )@@G@@IZATION-- SET UP FOR DEFAULT SIZE WS, MASTER CONSOLE @G@@[[. THIS CODE ER )@@G@@IS CALLED FROM THE BEGINNING OF XQTSUP (AFTER A SYSERR) AND @F@@[[. FROMES )@@G@@ SETUP (AT INITIAL SIGNON). THE LOWER WS POINTERS HAVE BEEN@F@@[[. ALREET )@@G@@ADY INITIALIZED, AND THE UPPER WORKSPACE IS ALL FREE SPACE @[@@@@. EU )@@G@@@ @@@@ INSTRS . @A@@@@CORINI* SX,H2 X11,COLINK EV )@@G@@. @E@[@@ LA,U A0,WSID . CURRENT SETTING OF BASE OF WS EW )@@G@@@E@[@@ SA A0,RCAFWA . POST FIRST WORD ADDR OF ACTIVE WS@G@[@@EX )@@G@@ LA,U A0,WSLAST . LAST LOCN IN DEFAULT (ASSEMBLY PARAMETER) WS EY )@@G@@@E@[@@ SA A0,RCALWA . SAVE LAST WORD ADDR OF ACTIVE WS @F^@@@EZ )@@G@@ LA,U A0,LASTD$ . LAST LOCATION ASSIGNED BY COLLECTOR @D@@@@FA )@@G@@ SA A0,RCLASD . SAVE FINAL D-BANK ADDR @G@@@@ SZ FB )@@G@@ RCCFWA . CLEAR ORIGIN OF COPY WS(IT DOES NOT EXIST) @A@@@@. CHECFC )@@G@@K FOR MASTER CONSOLE, ETC @G@[@@CI0010 LA,U A0,LSASG . GET BASE FD )@@G@@ADDR TO ZAP INITIALIZATION CODE @G@@][CI0010 LA,U A0,INORIG . GETFE )@@G@@ BASE ADDR TO ZAP INITIALIZATION CODE @D[@@@ TNZ RCMASF FF )@@G@@ . ARE WE A MASTER CONSOLE? @E@[@@ LA,U A0,IBMAST . NO, WE CAFG )@@G@@N ZAP THAT CODE, TOO @E@@][ LA,U A0,MCORIG . NO, WE CAN ZAP FH )@@G@@THAT CODE, TOO @D@[@@ SA A0,X11 . TEMP SAVE NEW WS BASEFI )@@G@@ ADDR @F@[@@ TG,U A0,WSID . ARE WE REALLY MOVING TO A LOWER AFJ )@@G@@DDR? @D@[@@ TNE,U A0,WSID . NO-- IS IT THE SAME PLACE? @C@[@@FK )@@G@@ J $+2 . IF EITHER, WE'RE OK @E@[@@ ER EABT$FL )@@G@@ . ELSE SYSERR (WE CANNOT MOVE UP) @F@@[[ SA A0,RCAFWAFM )@@G@@ . POST NEW START ADDR OF WORKSPACE @DA@@@ LXI,U A0,1 FN )@@G@@ . SET INCREMENT OF TO-ADDR @G@@@@ LXI,U X1,1 . SET INCR FO )@@G@@OF FROM-ADDR (COLLECTED WS ORG) @E@[@@ LA A1,RCALWA . LASFP )@@G@@T LOCN IN CURRENT ACTIVE WS @D@[@@ ANA A1,RCAFWA . LESS ORIGFQ )@@G@@IN=NO WDS LESS 1 @D@[@@ LR,U R1,1,A1 . PLUS 1=NO OF WDS TO MFR )@@G@@OVE @D@[@@ BT A0,0,*X1 . MOVE THE ENTIRE WS DOWN @D@[@@FS )@@G@@ LX,U X1,0,X11 . RESET BASE OF ACTIVE WS @C@[@@ SX FT )@@G@@ X1,RCAFWA . POST FWA OF ACTIVE WS@D@[@@ AA,U A1,0,X1 . ADDFU )@@G@@ FWA TO OLD SIZE-1 @D@[@@ LA,U A0,0,X1 . X1 IS BASE OF AFV )@@G@@CTIVE WS @F@@[[ LA A1,WSFREE . GET WS REL ADDR OF 1STFW )@@G@@ FREE WORD @G@@[[ LR,U R1,1+1+2,A1 . PLUS 1ST WD, LAST WD, FX )@@G@@AND FUDGE FACTOR @F@@[[ BT A0,0,*X1 . MOVE FIXED POINTFY )@@G@@ER AREW OF WS DOWN@G@@[[ LX X1,RCAFWA . NOW ESTABLISH BAFZ )@@G@@SE FOR NEWLY MOVED WS @G@@[[ LA A0,RCAFWA . PUT IT WHEGA )@@G@@RE WE CAN COMPUTE WITH IT @FC@@@ SA A0,RCFFWA . AND ALSO GB )@@G@@1ST WD OF FILE CTL TABLES @ @@@@ ANA,U A0,1 . @D@@@@GC )@@G@@ SA A0,RCFLWA . MARK LAST WORD OF FILES @D@@@@ SZ GD )@@G@@ RCNFIL . CLEAR NO OF ASSIGNED FILES @C@@@@ LA,U A0,FCTSIZ GE )@@G@@ . NO OF WORDS PER FCT @A@@@@ SA A0,RCFSIZ . POST IT @E@[@@GF )@@G@@ J CSHRNK . AND GO TRY TO SHRINK THE D-BANK @G@@[[ GG )@@G@@ LA,U A1,WSWORK . GET ADDR OF NOMINAL START OF FREE SPACE @F@@[[GH )@@G@@ AA A1,WSNSIZ . POUS NOMINAL SIZE IN WDS = LWA+1 @E@@[[GI )@@G@@ ANA,U A1,1 . COMPENSATE TO GET TRUE LWA @G@@[[ GJ )@@G@@ J CSHGRO . GO SEE IF WE SHOULD SHRINK ORG GROW @[[@@@GK )@@G@@. @C@@@@. ***** PROCS TO ADJUST POINTERS FOR MOVED WS'S @[@@@@. GL )@@G@@@C@@@@P PROC . ADJUST BASEREGS FOR MOVED WS @A@@@@XBASEI* NAMEGM )@@G@@ 0 . INCREMENT@A@@@@XBASED* NAME 1 . DECREMENT@ @@@@GN )@@G@@ UNLI$T . @C@@@@ DO P(0,0) ,K DO P(1) , ANX P(1,K),RGO )@@G@@CFSIZ . @C@@@@ DO 1-P(0,0) ,K DO P(1) , AX P(1,K),RCFSIZ . @#@@@@GP )@@G@@ LI$T . @#@@@@ END . @[@@@@. @C@@@@P PROC GQ )@@G@@ . ADJUST POINTERS IN LIVE CORE @ @@@@ARBASI* NAME 0 . GR )@@G@@@ @@@@ARBASD* NAME 1 . @#@@@@ PROC . @#@@@@Q* GS )@@G@@ NAME . @ @@@@ AU A1,P(1,K) . @ @@@@ SA A2,P(GT )@@G@@1,K) . @#@@@@ END . @ @@@@ UNLI$T . GU )@@G@@@A@@@@ DO 1-P(0,0) , LA A1,RCFSIZ . @A@@@@ DO P(0,0) , LNA A1,RCGV )@@G@@FSIZ . @ @@@@K DO P(1) , Q . @#@@@@ LI$T . GW )@@G@@@#@@@@ END . @[@@@@. @D@@@@. ACQUIRE AN FCT BUFFER (DIRECGX )@@G@@TLY BELOW ACTIVE WS) @[@@@@. @ @@@@COGFCT* SX X11,COLINK . GY )@@G@@@D@@@@ LA A0,RCALWA . LWA OF CURRENT ACTIVE WS @D@@@@ GZ )@@G@@ AA A0,RCFSIZ . PLUS NO OF WDS/FCT BUF @D@@@@ LA A5,A0HA )@@G@@ . TEMP SAVE NEW END ADDR @D@@@@ LA,U A0,2,A0 . BOOHB )@@G@@ST IT FOR GOOD LUCK @A@[@@ ER MCORE$ . AND GIMME@E@@[[HC )@@G@@ SZ ERRCOR . CLEAR MCORE$ FAILURE FLAG @B@@[[ HD )@@G@@ ER MCORE$ . AND GIMME @F@@[[ TZ ERRCOR HE )@@G@@. DOD WE GAT AN MCORE$ CONTINGENCY? @C@@[[ J CO0999 HF )@@G@@. YES, GDUNGE @C[@@@. NOW MOVE ACTIVE WS UP OUT OF THE BUF SPACE HG )@@G@@@D@@@@CF0010 LA A2,RCALWA . CURRENT END OF WS IS 'FROM'@E@@@@ HH )@@G@@ ANU A2,RCFLWA . LESS LWA OF SPACE USED FOR FCT'S @E@@@@ LR,U HI )@@G@@ R1,0,A3 . SET UP NO OF WORDS TO BE MOVED @C@@@@ LXI,XU A2,-HJ )@@G@@1 . SET INCR OF 'FROM' @C@@@@ LA A1,A5 . NEW END OHK )@@G@@F WS IS 'TO'@C@@@@ LXI,XU A1,-1 . SET ITS INCREMENT @B@@@@HL )@@G@@ BT A1,0,*A2 . AND PUSH WS UP @A@@@@. ADJUST PTRS TO REFLECTHM )@@G@@ MOVED WS @B@@@@CF0020 LA A1,RCNFIL . NO OF FILES @A@@@@ HN )@@G@@ AA,U A1,1 . BUMP IT @C@@@@ SA A1,RCNFIL . POST UPDAHO )@@G@@TED FILE CT @E@@@@ LA,U A0,0,X1 . BUF LOC IS WHERE WS USED TOHP )@@G@@ BE @F@@@@ XBASEI X1,X3,X5,X7,X9 . BUMP LIVE XREGS FOR NEW WS LHQ )@@G@@OCNS @F@@@@ ARBASI RCAFWA,RCALWA,RCFLWA,LFTDAD,RITDAD,LFTDMD,RITDHR )@@G@@MD @E@@@@ J CORXIT . RETURN LEAVING BUF ADDR IN A0 HS )@@G@@@[@@@@. @B@@@@. FREE AN FCT BUFFER (BUF ADDR IN A0) @[@@@@. HT )@@G@@@ @@@@COFFCT* SX X11,COLINK . @C@@@@ LXI,U A0,1 . SETHU )@@G@@ INCR OF 'TO' CTRL@D@@@@ AU A0,RCFSIZ . BUMP TO GET 'FROM' ADHV )@@G@@DR @E@@@@ LA A2,RCALWA . END OF WS IS LAST LOCN TO MOVE HW )@@G@@@C@@@@ ANA,U A2,0,A1 . LESS 1ST TO MOVE @D@@@@ LR,U HX )@@G@@ R1,1,A2 . SET NO WDS TO BE MOVED @D@@@@ BT A0,0,*A1 HY )@@G@@ . MOVE WS AND TABLE BOTH DOWN@E@@@@ LA A1,RCNFIL . UPDATE NOHZ )@@G@@ OF ALLOCATED FCT'S @ @@@@ ANA,U A1,1 . @ @@@@ IA )@@G@@ SA A1,RCNFIL . @A@@@@. DECREMENT POINTERS INTO THE WS @A@@@@IB )@@G@@ XBASED X1,X3,X5,X7,X9 . @F@@@@ ARBASD RCAFWA,RCALWA,RCIC )@@G@@FLWA,LFTDAD,RITDAD,LFTDMD,RITDMD . @E@@@@ LA A1,RCALWA . GETID )@@G@@ ADDR FOR USE BY SHRINK RTNE @D@[@@ J CSHRNK . AND GO GEIE )@@G@@T RID OF THE CORE @[@[@@. @E@[@@. ESTABLISH A NEW ACTIVE WS OF VARIAIF )@@G@@BLE SIZE (NO WDS IN A0) @C@[@@. (INVOKED BY )CLEAR AND/OR )LOAD IG )@@G@@) @ @[@@CORACT* SX X11,COLINK . @C@[@@ LA A2,RCALWA IH )@@G@@ . CURRENT ENDING ADDR @D@[@@ ANA A2,RCAFWA . LESS START=NO WII )@@G@@DS LESS 1 @E@[@@ TNE,U A0,1,A2 . IS PRESENT SPACE ALLOCATIONIJ )@@G@@ OK? @C@[@@ J CORXIT . YES, NORMAL EXIT @E@[@@ IK )@@G@@ AU,U A0,WSID . NEW NO WDS+CURRENT BASE=LWA+1 @E@[@@ ANA,UIL )@@G@@ A1,1 . COMPUTE ACTUAL LWA FOR NEW WS @D@[@@ TLE,U A0,1,IM )@@G@@A2 . IS OLD WS SMALLER THAN NEW?@E@[@@ J CSHRNK . NO IN )@@G@@GRTR, GO SHRINK TO NEW SIZE @E@[@@ SA A1,RCALWA . POST NEW IO )@@G@@ENDING ADDR OF ACTIVE WS@E@[@@ J CGROW . AND GO MCORE$ TIP )@@G@@O WHAT WE NEED @[@[@@. @C@[@@. ESTABLISH A COPY WS (SIZE IN WORDIQ )@@G@@S IN A0) @[@[@@. @ @[@@CORCPY* SX,H2 X11,COLINK . @D@[@@ IR )@@G@@ TZ RCCFWA . IS THERE ALREADY A COPY WS?@B@[@@ J CO090IS )@@G@@0 . YES, SYSERR @D@[@@ LA A1,RCALWA . LWA OF CURRENT IT )@@G@@ACTIVE WS @F@[@@ AA,U A1,2 . DON'T BE HALF-SAFE--ADD A FIU )@@G@@EW EXTRA WDS@D@[@@ SA A1,RCCFWA . POST BASE ADDR OF COPY WS IV )@@G@@@E@[@@ AA,U A1,0,A0 . PLUS NO WDS NEEDED=LWA PLUS 1 @F@[@@IW )@@G@@ ANA,U A1,1 . DECREASE TO GET ACTUAL LWA OF COPY WS @D@[@@IX )@@G@@ SA A1,RCCLWA . POST LAST WORD OF COPY WS @C@[@@ J IY )@@G@@ CGROW . GO EXPAND THE D-BANK @E@@[[ J CK0010 IZ )@@G@@. AND GO SHRINK DOWN TO IT @E@@[[/. GET CORE FOR 'CURRENT' WORKSPACE-JA )@@G@@- A0=SIZE INDEX WORD @[@@[[. @A@@[[CORGET* SX X11,COLINK JB )@@G@@. @G@@[[ LA,U A0,0,A0 . ISOLATE NOMINAL FREE SPACE IJC )@@G@@N WORDS @G@@[[ AU,U A0,WSWORK-WSID . PLUS WDS OF OVERHEAD =JD )@@G@@ TOT SIZE IN A1 @E@@[[ LA,U A0,WSID . GET BASE ADDR OFJE )@@G@@ CURRENT WS @F@@[[ AA A1,A0 . ADD FWA TO SIZE GIVINGJF )@@G@@ LWA + 1 @E@@[[ ANA,U A1,1 . ADJUST GIVING EXACT LWJG )@@G@@A @F@@[[ TNE A0,RCCFWA . IS WS TO ALLOCATE THE COPY WJH )@@G@@S? @C@@[[ J CS0100 . YES, GO DO IT @E@@[[ JI )@@G@@ TE A0,RCAFWA . NO, IS IT THE ACTIVE WS? @G@@[[ ER JJ )@@G@@ ERR$ . IF NOT, A RANDOM NUMBER GOT INTO A0 @F@@[[ JK )@@G@@ TNZ RCCFWA . YES, DOES A COPY WS ALSO EXIST? @F@@[[ JL )@@G@@ J CSHGRO . NO, GO SET UP FOR ACTIVE WS ONLY @[@@[[. JM )@@G@@@G@@[[. EXPAND ACTIVE WS UNDERNEATH A COPY WS-- NOTE: WHEN COPY WS WAS EJN )@@G@@STAB- @G@@[[. LISHED (SEE BELOW), WE ACQUIRED THE NEEDED EXTRA SPACE IN JO )@@G@@ADVANCE @[@@[[. @G@@[[CS0010 TG A1,RCCFWA . ARE WE TRYJP )@@G@@ING TO EXPAND INTO THE COPY WS@G@@[[ J CO0999 . YES,JQ )@@G@@ CANT DO THAT SO TAKE WSFULL EXIT @F@@[[ SA A1,RCALWA JR )@@G@@. NO, POST NEW LWA FOR ACTIVE WS @D@@[[ J CORXIT JS )@@G@@. AND GRACEFULLY EXIT @[@@[[. @G@@[[. ALLOCATE FOR A COPY WS. IN JT )@@G@@ORDER TO AVOID HAVING TO ATTEMPT TO MOVE @G@@[[. THE COPY WS DURING THEJU )@@G@@ COPY (WITH SUBSEQUENT INVALIDATION OF LIVE @G@@[[. GLOBAL POINTERS JV )@@G@@INTO IT), WE PUT THE START OF THE COPY WS HIGH ENOUGH @G@@[[. SO THAT THJW )@@G@@E ACTIVE WS CAN EXPAND TO ITS MAXIMUM BENEATH IT WITHOUT @F@@[[. SUBSJX )@@G@@EQUENT MCORE$S OR MOVEMENT OF THE COPY WS OUT OT THE WAY. @[@@[[. JY )@@G@@@F@@[[CS0100 SA A1,RCCLWA . SAVE TENTATIVE END ADDR OF COPY WSJZ )@@G@@@E@@[[ LX X1,RCAFWA . RESET BASE TO ACTIVE WS @F@@[[KA )@@G@@ LA,U A0,WSWORK . GET NOMINAL FREE SPACE START ADDR @F@@[[KB )@@G@@ AA,H2 A0,WSMSIZ . PLUS MAX IT CAN EXPAND TO =LWA+1 @F@@[[KC )@@G@@ AA,U A0,2 . FUDGE GIVING NEW FWA FOR COPY WS @E@@[[KD )@@G@@ TLE A0,RCALWA . IS ACTIVE WS ALREADY THERE? @E@@[[ KE )@@G@@ ER ERR$ . YES, A MONUMENTAL FAILURE @F@@[[ ANU KF )@@G@@ A0,RCCFWA . NO, GET NEW START LESS OLD START @E@@[[ AA KG )@@G@@ A1,RCCLWA . PLUS OLD END GIVES NEW END @C@@[[ SA A0,KH )@@G@@RCCFWA . POST NEW FWA @C@@[[ SA A1,RCCLWA . AND KI )@@G@@NEW LWA @F@@[[ LX X1,RCCFWA . REESTABLISH BASEREG FOKJ )@@G@@R COPY WS @E@@[[ J CG0010 . AND GO DO THE ALLOCATIKK )@@G@@ON @D@@[[. SHRINK OR GROW ACTIVE WS TO ENDING ADDR IN A1-- @C@@[[KL )@@G@@CSHGRO SA A1,RCALWA . POST NEW LWA @E@@[[CG0010 TG A1,KM )@@G@@RCLASD . DO WE HAVE MORE THAN ENUF? @D@@[[ J CGROW KN )@@G@@ . NO, BETTER GO GROW @D@@[[ J CK0010 . YES,KO )@@G@@ GO GIVE SOME UP @[W@@@. @A@@@@. GET RID OF THE CURRENT COPY WS KP )@@G@@@[@@@@. @ @@@@CORCEN* SX,H2 X11,COLINK . @F@@@@ TNZ RCCFWKQ )@@G@@A . IS THERE REALLY ONE TO GET RID OF? @B@@@@ J CO090KR )@@G@@0 . NO, SYSERR @E@@@@ SZ RCCFWA . YES, POST THE FKS )@@G@@ACT THAT IT'S GONE@C@@@@ LA A1,RCALWA . GET END OF ACTIVE WS KT )@@G@@@D@[@@ J CSHRNK . AND GO CUT IT DOWN TO SIZE @D@@[[ KU )@@G@@ . FALL THRU TO SHRINK IT@[[@@@. @C@@@@. SHRIKV )@@G@@NK THE D-BANK (LAST ACTIVE WS ADDR IN A1) @[@@@@. @E@@@@CSHRNK SA KW )@@G@@ A1,RCALWA . SAVE NEW LAST ADDR OF ACTIVE WS @E@[@@ LA,U A0,EXKX )@@G@@EC8 . GET CURRENT EXEC8 BASE LEVEL @E@@][CK0010 LA,U A0,EXEC8 KY )@@G@@ . GET CURRENT EXEC8 BASE LEVEL @D[@@@ TLE,U A0,26 . IS KZ )@@G@@IT AT LEAST LEVEL 26? @D@@@@ J CORXIT . NO, DON'T TRY TLA )@@G@@O LCORE @G@@@@ LA,U A0,2,A1 . A BIT EXTRA IN CASE OF DL/DS INLB )@@G@@STRS AT END OF WS @D@@@@ SA A0,RCLASD . POST NEW LAST D-BANK LC )@@G@@LOCN @A@@@@ ER LCORE$ . SHRINK @C@@@@ J CORXILD )@@G@@T . TAKE NORMAL EXIT @[@@@@. @G@@@@. EXPAND THE D-BANK (LASLE )@@G@@T CORE ADDR IN A1-MAY BE ACTIVE OR COPY WS) @[@@@@. @E@@@@CGROW LF )@@G@@LA,U A0,2,A1 . EXTRA SPACE TO BE ON THE SAFE SIDE @C@@@@ SA LG )@@G@@ A0,RCLASD . SAVE NEW LAST-D LOCN @D@[@@ ER MCORE$ . GLOLH )@@G@@MB ONTO THE NEEDED SPACE@F@@[[ SZ ERRCOR . CLEAR MCORLI )@@G@@E$ CONTINGENCY FLAG @C@@[[ ER MCORE$ . GLOMB THE LJ )@@G@@SPACE @C@@[[ TZ ERRCOR . DID WE GET IT? @D@@[[ LK )@@G@@ J CO0999 . NO, TAKE FAILURE EXIT @A[@@@. COMMON EXIT FOR LL )@@G@@ALL CORE FUNCTIONS@ @@@@CORXIT LX,H2 X11,COLINK . @ @@@@ J LM )@@G@@ 1,X11 . @[@@@@. @E@@@@. ERROR EXIT (INCORRECT ATTEMP TO MALN )@@G@@KE/DESTROY COPY WS) @[@@@@. @ @[@@CO0900 ERROR YSYSTM . LO )@@G@@@G@@[[CO0900 EQU 0 . JUMP HERE TO GENERATE SYSERR (I.E.LP )@@G@@ IGDM)@ @[@@ LX,H2 X11,COLINK . @ @@][CO0999 LX,H2 X11,COLINK LQ )@@G@@ . @ ]@@@ J 0,X11 . @ @@@@ VARBLS LR )@@G@@ . @ @@@@COLINK RES 1 . @]@@@@ END. ___NEW END LS )@@G@@@C@@[[ SA A0,RCCFWA . POST NEW FWA @C@@[[ SA LT )@@G@@ A1,RCCLWA . AND *[S@@@*SDFF*@G@@@@. ****************************LU )@@G@@***************************************** @G@@@@. STANDARD PROCS - INCLULV )@@G@@DED BY AN @ADD PRCPKG/APL IN SOURCE DECKS * @G@@@@. LW )@@G@@ * @^@@@@ AXR$ LX )@@G@@ . @C@@@@ CONFIG . DEFINE ASSEMBLY PARAMETERS @G@@@@LY )@@G@@ WSDEF. DEFINE WORKSPACE * LZ )@@G@@@G@@@@WORKSP INFO 2 20. SET ASIDE THE SPACE MA )@@G@@ * @G@@@@ RUNCTL. DEFINE RUN CTRL BLOK(S) MB )@@G@@ * @G@@@@RUNCON INFO 2 22. AND SET ASIDE ITS SPACE MC )@@G@@ * @G@@@@ CBLOCK . DEFINE CONTROL BLOCK MD )@@G@@TYPES * @G@@@@. ME )@@G@@ * @G@@@@. END OF STANDARD PROC BLOCK MF )@@G@@ * @G@@@@. ****************************MG )@@G@@***************************************** @[@@@@. @[@@@@. @C@@@@MH )@@G@@ SKMARX . DEFINE STACK MARKS @G@@@@/. THIS ROUTINE SUMI )@@G@@PERVISES SEQUENCING THRU THE ELEMENTS OF A SUBSCRIPTED@G@@@@. ARRAY-- IMJ )@@G@@T BOTH STORES INTO AND REFERENCES INTO SUBSCRIPTED STUFF @[@@@@. MK )@@G@@@A@@@@. REG USAGE DURING SCAN OF SUBSCRS--@E@@@@. X6,X7 POINTERS TOML )@@G@@ (SEQUENTIALLY SCANNED) SUBSCRIPTAND@F@@@@. X3 POINTER TO ROUTINMM )@@G@@E TO RANDOMLY ACCESS SUBSCRIPTEE @G@@@@. X4,X5 FETCH POINTERS FOMN )@@G@@R MOST RAPIDLY VARYING SUBSCRIPT EXPR @D@@@@. X2 SCANNER ACRMO )@@G@@OSS SUBSCRIPT EXPRESSIONS @[@@@@. @D@@@@. THIS ENTRY TO CREATE AMP )@@G@@ TEMPORARY BY SUBSCRIPTING--- @[@@@@. @#@@@@ INSTRS . @G@@@@MQ )@@G@@SUBTMP* S X11,SULINK . ++2 +2 424 2 7 C 0O-KS MR )@@G@@@E@@@@ LMJ X11,SUBIND . INITIALIZE SUBSCRIPTING POINTERS @ @@@@MS )@@G@@ J SU0999 . @B@@@@SU0010 LMJ X11,SUBMOV . MOVE TO TMT )@@G@@EMP @B@@@@ J SU0999 . ERROR RETURN @B@@@@ J MU )@@G@@ SU0420 . NORMAL EXIT @[@@@@. @C@@@@. THIS ENTRY TO STORE INMV )@@G@@TO A SUBSCRIPTED ARRAY--@[@@@@. @ @@@@SUBSTO* SX X11,SULINK . MW )@@G@@@F@@@@ LMJ X11,SUBIND . POP UP THE ARRAY AND ITS SUBSCRIPTS MX )@@G@@@ @@@@ J SU0999 . @E@@@@ TZ SCRANK+1 . TRYMY )@@G@@ING TO STORE INTO A NULL? @B@@@@ J SU0100 . NO, CONTIMZ )@@G@@NUE @B@@@@ ERROR YLENGT,SU0999 . YES, KILL IT @D@@@@. NOW EXAMINNA )@@G@@E THE RIGHT HAND SIDE OF THE STORE ARROW @D@@@@SU0100 LMJ X11,PIKRIT NB )@@G@@ . INITIALIZE RIGHTARG SCAN @ @@@@ J SU0999 . @D@@@@NC )@@G@@ SA A6,RESDSC . SAVE DESCR FOR PUSH AT EXIT@F@@@@ SA ND )@@G@@ A6,RITDSC . AND SAVE FOR GARBAGE COLLECTOR, TOO @G@@@@ JE,U NE )@@G@@ A5,1 SU0200 . IF OPERAND HAS UNIT LENGTH, SKIP RANK TESTS @D@@@@ NF )@@G@@ SA A3,RITMOD . TEMP SAVE THE RITEARG MODE @E@@@@SU0110 TNE A5,RENG )@@G@@SLNT . DOES LENGTH MATCH SUBSCRIPTS? @A@@@@ J SU0120 NH )@@G@@ . @A@@@@ ERROR YLENGT,SU0999 . @B@@@@SU0120 TE,U NI )@@G@@ A4,ZRANKS . IS IT SCALAR? @C@@@@ TNE,U A4,ZRANKV . NO, HOW ANJ )@@G@@BOUT VECTOR?@E@@@@ J SU0200 . NEITHER- DON'T MATCH DIMVECNK )@@G@@TS @C@@@@. COMPARE DIMS OF SUBSCR EXPR WITH RIGHT ARG @E@@@@SU0130NL )@@G@@ SX X4,SUX4SV . TEMP SAVE LEFTARG PICKUP REGS @ @@@@ SX NM )@@G@@ X5,SUX5SV . @G@@@@ LX X4,GLFTBL+ZMOHFI . AND USE THEM TO NN )@@G@@SCAN DIMS OF SUBSCR EXPR@F@@@@ LX X5,(+1,RESDIM) . WHICH WERENO )@@G@@ SET UP BY RANDAC FOR US@ @@@@ LA A14,RESRNK . @E@@@@ NP )@@G@@ SX X6,SUX6SV . SAVE RITEARG PICKUP REGS , TOO @ @@@@ SX NQ )@@G@@ X7,SUX7SV . @G@@@@ LX X6,GRITBL+ZMOHFI . AND USE THEM TO NR )@@G@@SCAN THE RIGHT ARG DIMS @G@@@@ LX X7,A1 . GETTING ADDR OFNS )@@G@@ DIMS FROM WHERE VERIFY PUT IT@ @@@@ LXI,U X7,1 . @G@@@@NT )@@G@@ LA A15,A4 . WHERE NO OF DIMS IS EQUAL TO RITEARG RANK NU )@@G@@@F@@@@SU0140 JNGD A14,SU0144 . CHECK FOR SUBSCRIPT ARRAY EXHAUSTED NV )@@G@@@E@@@@ LMJ X4,0,X4 . IT AIN'T, GET NEXT SUBSCR VALUE @E@@@@NW )@@G@@ JE,U A2,1 SU0140 . IGNORE DIMENSIONS OF UNIT LENGTH @E@@@@SU0142NX )@@G@@ JNGD A15,SU0146 . TEST FOR ANY DIMS LEFT IN RITEARG@E@@@@ LMJ NY )@@G@@ X6,0,X6 . IF SOMETHING IS LEFT, GET IT @D@@@@ JE,U A5,1 NZ )@@G@@SU0142 . IGNORE IT IF IT'S UNITY @H@@@@ JE A2,A5 SU0140 OA )@@G@@. BE SURE IT MATCHES THE CURRENT SUBSCR DIM @C@@@@ ERROR YRANKOB )@@G@@,SU0999 . ELSE WIPE HIM OUT @F@@@@SU0144 JNGD A15,SU0150 . SUBSCRS EOC )@@G@@XHAUSTED-- ANY MORE RITEARG? @C@@@@ LMJ X6,0,X6 . YES, GET OD )@@G@@NEXT ONE @E@@@@ JE,U A5,1 SU0144 . WHOSE VALUE CAN ONLY BE UNIOE )@@G@@TY @C@@@@ ERROR YRANK,SU0999 . OR ELSE WE BUST @G@@@@SU0146OF )@@G@@ JNGD A14,SU0150 . RITEARG EXHAUSTED-- ANY MORE DIMS IN SUBSCR? @C@@@@OG )@@G@@ LMJ X4,0,X4 . YES, GET NEXT ONE @E@@@@ JE,U A2,1 OH )@@G@@SU0146 . WHICH HAD DAMN SURE BETTER BE ONE@ @@@@ ERROR YRANK,SU099OI )@@G@@9 . @A@@@@. RANKS MATCH-- RESTORE EVERYTHING @ @@@@SU0150 LX X4,SUOJ )@@G@@X4SV . @ @@@@ LX X5,SUX5SV . @ @@@@ LX X6,SUOK )@@G@@X6SV . @ @@@@ LX X7,SUX7SV . @ @@@@ LA A3,RIOL )@@G@@TMOD . @D@@@@. RANKS AND LENGTHS MATCH--NOW CHECK FOR MODE CHANGES OM )@@G@@@C@@@@SU0200 TNE A3,SCTYPE+1 . ARE THEY IDENTICAL? @C@@@@ J ON )@@G@@ SU0300 . YES, GO START MOVING @E@@@@ TNE,U A3,ZMOCHR . NO,OO )@@G@@ IS RIGHT SIDE CHARACTER? @B@@@@ J SU0920 . YES, MODEOP )@@G@@ ERROR@D@@@@ TE,U A3,ZMOHFI . IS RIGHT SIDE HALFINT? @C@@@@OQ )@@G@@ J SU0240 . NO, GO CHECK DOUBLE @E@@@@. MODE CHG, RIGHT OR )@@G@@SIDE=HALFINT, LEFT HAD BETTER BE DOUBLE @D@@@@SU0210 LA A3,SCTYPE+1OS )@@G@@ . GET MODE OF SUBSCRIPTEE @B@@@@ TE,U A3,ZMODFL . IS IT DFLOT )@@G@@OAT? @C@@@@ J SU0920 . NO- ILLEGAL MODE CHG @ @@@@. MOVEOU )@@G@@ HALFINT TO DOUBLE-- @B@@@@SU0220 LA,U A3,ZMOINT . HFINT TO FLOAT OV )@@G@@@C@@@@ LX,H2 X2,RANPUT,A3 . SET UP STORE ROUTINE@ @@@@ LA OW )@@G@@ A14,RESLNT . @D@@@@SU0230 JNGD A14,SU0400 . MORE TO DO ? IF NOT, OX )@@G@@EXIT @F@@@@ LMJ X6,0,X6 . YES, FETCH NEXT FROM RIGHT OPERANOY )@@G@@D @C@@@@ LA A2,A5 . MOVE TO A1 FOR STASH @D@@@@ OZ )@@G@@ LMJ X2,0,X2 . AND STASH IN SUBSCRIPTEE @A@@@@ J SU099PA )@@G@@9 . ERROR @C@@@@ LMJ X11,SUBUMP . BUMP TO NEXT SUBSCR PB )@@G@@@A@@@@ J SU0400 . ALL DONE @A@@@@ J SU0230 PC )@@G@@ . CONTINUE @A@@@@. RIGHT SIDE NOT CHAR OR HALFINT @F@@@@SU0240 JNE,UPD )@@G@@ A3,ZMODFL SU0900 . IF NOT DOUBLE EITHER, BIG TROUBLE @D@@@@ LA PE )@@G@@ A3,SCTYPE+1 . GET MODE OF SUBSCRIPTEE @B@@@@ TE,U A3,ZMOHFI PF )@@G@@ . IS IT HALFINT? @D@@@@ J SU0920 . NO- ILLEGAL MODE CHANPG )@@G@@GE @C@@@@. SUBSCRIPTEE MUST BE CONVERTED TO DOUBLE--- @D@@@@SU0250PH )@@G@@ LA A0,SCRANK+1 . GET LENGTH OF SUBSCRIPTEE @D@@@@ LSSL A0,1 PI )@@G@@ . CONVERT TO DOUBLEWORDS @C@@@@ ALLOCT SU0930 . ACQPJ )@@G@@UIRE NEW SPACE @D@@@@ LA A0,SCDESC . DESCR ADDR OF SUBSCRIPK )@@G@@PTEE @ @@@@ ABSADR A0 . @C@@@@ SA,H2 A1,1, A0 PL )@@G@@ . PLUG NEW DATA ADDR IN@E@@@@ ABSADR A1 . SET UP TO SCAN PM )@@G@@NEW DATA AREA @ @@@@ LXI,U A1,2 . @D@@@@ LA PN )@@G@@ A0,SCDATA . DITTO FOR OLD DATA AREA @ @@@@ LXI,U A0,1 PO )@@G@@ . @B@@@@ LA A14,SCRANK+1 . SET REPEAT CNT@A@@@@. NOW MOVE EPP )@@G@@L BY EL FROM OLD TO NEW@D@@@@SU0260 JNGD A14,SU0270 . MORE TO DO? IF PQ )@@G@@NOT, EXIT @B@@@@ LA,H1 A5,0,A0 . GET FROM OLD @B@@@@ PR )@@G@@ LDSL A4,54 . SIGN EXTEND @ @@@@ DSA A4,54 . PS )@@G@@@A@@@@ DFLOAT A3,A4 . FLOAT @A@@@@ DS A4,0,*A1 PT )@@G@@ . AND STASH@D@@@@ JNGD A14,SU0270 . MORE TO DO? IF NOT, EXIT PU )@@G@@@ @@@@ LA,H2 A5,0,*A0 . @ @@@@ LDSL A4,54 . PV )@@G@@@ @@@@ DSA A4,54 . @ @@@@ DFLOAT A3,A4 . PW )@@G@@@ @@@@ DS A4,0,*A1 . @ @@@@ J SU0260 . PX )@@G@@@E@@@@. WE HAVE FINISHED CONVERTING--NOW RESET THE PARAMETERS @B@@@@PY )@@G@@SU0270 LA A0,SCDESC . DESCR ADDR @A@@@@ ABSADR A0 PZ )@@G@@ . ABS IT @B@@@@ LA,U A1,ZMODFL . NEW MODE FLAG @B@@@@ QA )@@G@@ SA,S2 A1,0,A0 . PUT INTO DESCR @E@@@@ LA,H2 A0,1,A0 . NEWQB )@@G@@ RELATIVE DATA ADDR FROM DESCR@B@@@@ ABSADR A0 . MAKE IT AQC )@@G@@BS @B@@@@ LA A1,SCDATA . OLD DATA ADDR @B@@@@ SA QD )@@G@@ A0,SCDATA . SAVE NEW ONE @C@@@@ LA A0,SCRANK+1 . LENGTH OFQE )@@G@@ SUBSCRIPTEE@B@@@@ AA,U A0,1 . CONVERT TO WDS @ @@@@ QF )@@G@@ SSL A0,1 . @E@@@@ RELADR A1 . MAKE ADDR OF BLOKQG )@@G@@ TO FREE RELATIVE @F@@@@ FREE . RELEASE SPACE FORMERLQH )@@G@@Y USED FOR DATA @A@@@@ LA,U A3,ZMODFL . SET MODE @ @@@@. STORQI )@@G@@E WITHOUT MODE CHANGE-- @D@@@@SU0300 LX,H2 X2,RANPUT,A3 . SET UP STORE RQJ )@@G@@TNE ADDR @C@@@@ LA A14,RESLNT . AND LOOP CT @D@@@@QK )@@G@@SU0310 JNGD A14,SU0400 . MORE TO DO? IF NOT,EXIT @F@@@@ LMJ QL )@@G@@ X6,0,X6 . YES, FETCH FROM RIGHT OPERAND @C@@@@ DL QM )@@G@@ A1,A4 . MOVE TO A1 FOR STASH @A@@@@ LMJ X2,0,X2 . PUTQN )@@G@@ AWAY @B@@@@ J SU0999 . ERROR @C@@@@ LMJ QO )@@G@@ X11,SUBUMP . BUMP SUBSCRIPT ARRAY @B@@@@ J SU0400 . NO QP )@@G@@MORE TO DO @B@@@@ J SU0310 . CONTINUE @D@@@@SU0400QQ )@@G@@ LA A6,RESDSC . GET DESCR ADDR OF RESULT @D@@@@ LMJ X11,DQR )@@G@@UPE . REPRODUCE INTO A TEMPORARY @D@@@@ J SU0999 . ERRQS )@@G@@OR RETURN FROM REPRO @C@@@@ SA A2,RESDSC . STORE REL DBLOKQT )@@G@@ ADDR @D@@@@SU0410 LA A0,RESDSC . GET DESCR ADDR OF RESULT @A@@@@QU )@@G@@ PUSH A0 . STACK IT @E@@@@SU0420 LMJ X11,SUBERS . GO QV )@@G@@ERASE ANY TEMPORARY SUBSCRIPTS@ @@@@ J SU0999 . @ @@@@QW )@@G@@ LX,H2 X11,SULINK . @ @@@@ J 1,X11 . @[@@@@QX )@@G@@. @E@@@@SU0900 ERROR YSYSTM,SU0999 . NOTHING TO RIGHT OF EQUALS QY )@@G@@@D@@@@SU0910 ERROR YSYNTA,SU0999 . REDUCED SUBSCRIPTAND @D@@@@SU0920QZ )@@G@@ ERROR YVALUE,SU0999 . ILLEGAL MODE CHANGE, ETC.@C@@@@SU0930 ERROR YWSFURA )@@G@@L,SU0999 . UNDEFINED MODE @[@@@@. @F@@@@SU0999 LMJ X11,SUBERS RB )@@G@@ . GET RID OF TEMPORARIES USED FOR SUBSCRS@#@@@@ NOP . @ @@@@RC )@@G@@ LX,H2 X11,SULINK . @ @@@@ J 0,X11 . @ @@@@RD )@@G@@ J 0,X11 . @#@@@@ VARBLS . @#@@@@SULINK RES RE )@@G@@ 1 . @#@@@@INLINK RES 1 . @#@@@@SUX4SV RES 1 . @#@@@@SUX5SV RES RF )@@G@@ 1 . @#@@@@SUX6SV RES 1 . @#@@@@SUX7SV RES 1 . @#@@@@ VARCORG )@@G@@N . @D@@@@RESLNT EQUF RESBLK,,H2 . LENGTH OF SUBSCRIPTAND @C@@@@RH )@@G@@RESRNK EQUF RESBLK,,S3 . RANK OF SUBSCRIPTAND @]@@@@ END .___ RI )@@G@@*[S@@@*SDFF*@G@@@@. ****************************************************RJ )@@G@@***************** @G@@@@. STANDARD PROCS - INCLUDED BY AN @ADD PRCPKG/APRK )@@G@@L IN SOURCE DECKS * @G@@@@. RL )@@G@@ * @G@@@@ AXR$ . RM )@@G@@ * @G@@@@ CONFIG . DEFINE ASSRN )@@G@@EMBLY PARAMETERS * @G@@@@ APSYMB. DEFINRO )@@G@@E APL SYMBOL SET * @G@@@@ WSDEF. RP )@@G@@ DEFINE WORKSPACE * @G@@@@WORKSP INFO RQ )@@G@@ 2 20. SET ASIDE THE SPACE * @G@@@@ RR )@@G@@ RUNCTL. DEFINE RUN CTRL BLOK(S) * @G@@@@RS )@@G@@RUNCON INFO 2 22. AND SET ASIDE ITS SPACE * RT )@@G@@@G@@@@ CBLOCK . DEFINE CONTROL BLOCK TYPES RU )@@G@@ * @G@@@@. RV )@@G@@ * @G@@@@. END OF STANDARD PROC BLOCK RW )@@G@@ * @G@@@@. **********************************************RX )@@G@@*********************** @[@@@@. @ @@@@. STRUCTURE OF T-STRING-- RY )@@G@@@[@@@@. @F@@@@. 1ST WD=HEADER-- S1=ZTPTXT, H2=NO WDS (INCLUDINGRZ )@@G@@ HEADER WD) @G@@@@. REMAINING WORDS ARE HALFWORDS (EXCEPT LITS, COMSA )@@G@@MENTS-- SEE BELOW)@[@@@@. @B@@@@. STRUCTURE OF HALFWORD ENTRIES IS--SB )@@G@@----- @G@@@@. ITEM TYPE 1ST OCTAL DIGIT REMAINING SC )@@G@@15 BITS @G@@@@. ....................................................SD )@@G@@..................@G@@@@. PRIMITIVE OPR/SYMBOL LEXOPR SE )@@G@@ APLBCI CODE FOR OPR @G@@@@. FUNC/VBLE NAME LEXNAM SF )@@G@@ LOCN IN SYMBOL TABLE @G@@@@. STOPVECTOR NAME LEXSG )@@G@@STP LOCN IN SYMBOL TABLE @G@@@@. TRACEVECTOR NAME SH )@@G@@ LEXTRC LOCN IN SYMBOL TABLE @G@@@@. LIT CONST FLAGWD SI )@@G@@ LEXLIT NO WDS USED BY LIT @[@@@@. @G@@@@. SJ )@@G@@ LITERAL CONSTANTS HAVE THEIR DESCRIPTORS AND VALUES EMBEDDED @G@@@@SK )@@G@@. DIRECTLY IN THE T-STRING, PRECEDED BY A LIT CONST FLAGWD, AS ABOVE. SL )@@G@@@G@@@@. THE DESCRIPTOR ALWAYS FALLS ON A FULLWORD; IF THE FLAGWD FALLS ISM )@@G@@N H1, @F@@@@. THE REMAINDER OF THAT WORD IS PADDED WITH NULL (ALL ZEROS)SN )@@G@@. @G@@@@. THE END OF THE EXECUTABLE TEXT IS SIGNALED BY EITHER SO )@@G@@AN 'AEOL' @G@@@@. OR 'ALAMP', STORED AS AN OPERATOR. IF A LAMP APPEARSP )@@G@@S, THEN COMMENTS @G@@@@. ARE PACKET IN THE SUCCEEDING QUARTERWORDS, WITSQ )@@G@@H THE END OF THE COMMENT@E@@@@. MARKED BY AN 'AEOL' CHARACTER, STORED ASSR )@@G@@ A QUATRERWD CHAR.@[@@@@. @[@@@@. @E@@@@/. ROUTINES TO STORE T-SSS )@@G@@TRINGS (LEXICALLY ANALYZED TEXT) @#@@@@ INSTRS . @G@@@@. INITST )@@G@@IALIZATION-- ACQUIRE BLOCK INTO WHICH T-STRIMG WILL BE STORED @[@@@@SU )@@G@@. @C@@@@TEXSTO* SX X11,TXLINK . INITIALIZATION ENTRY @E@@@@ SV )@@G@@ UNLNKL . UNLINK THE LARGEST BLOCK IN THE WS @D@@@@ SX SW )@@G@@ X11,TXTOPN . POST A T-STRING IS OPEN @[@@@@. @E@@@@. NOW SAVE LSX )@@G@@IMITS OF BLOK INTO WHICH T-STRING WILL BE STORED@B@@@@TX0010 LA A0,WSSY )@@G@@FLWA . LAST WD OF BLOK@G@@@@ ANA,U A0,2 . CHEAT A BIT SO THERESZ )@@G@@'S ALWAYS ROOM FOR AN EOL @G@@@@ TLE A0,WSFFWA . IS THERE TA )@@G@@ENOUGH ROOM FOR ANYTHING AT ALL? @B@@@@ J TX0140 . NO,TB )@@G@@ WSFULL @F@@@@ ABSADR A0 . YES,GET ABSOLUTE ADDR OF ENTC )@@G@@D OF BLOK @E@@@@ SA A0,TXTLWA . SAVE IT ABS FOR WS FULL CHETD )@@G@@CKING @C@@@@ LA A0,WSFFWA . 1ST ADDR OF BLOK @ @@@@ TE )@@G@@ ABSADR A0 . @C@@@@ SA A0,TXTFWA . SAVE FOR USE ATTF )@@G@@ EXIT @D@@@@ LX,U X7,0,A0 . AND POST AS 1ST STORE ADDR @ @@@@TG )@@G@@ LXI,U X7,1 . @D@@@@ LA A0,(+ZTPTXT*/30) . SKELTH )@@G@@ETON BLOK HDR WD @A@@@@ SA A0,0,*X7 . POST IT @C@@@@ TI )@@G@@ SZ TXMODE . CLEAR OLD MODE FLAG @G@@@@ LA A1,TXHFLG TJ )@@G@@ . GET FLAGWD TO ESTABLISH HALFWORD STORAGE @E@@@@ J TX013TK )@@G@@0 . AND INITIALIZE REGS FOR THIS MODE@[@@@@. @C@@@@. ENTRY POINTL )@@G@@TS TO FORCE STORAGE MODE CHANGE @[@@@@. @ @@@@TEXQWD* LA A1,TXTM )@@G@@QFLG . @ @@@@ J TX0100 . @ @@@@TEXHWD* LA A1,TXTN )@@G@@HFLG . @ @@@@ J TX0100 . @ @@@@TEXFWD* LA A1,TXTO )@@G@@WFLG . @ @@@@ J TX0100 . @ @@@@TEXDWD* LA A1,TXTP )@@G@@DFLG . @[@@@@. @ @@@@TX0100 SX X11,TXLINK . @E@@@@ TQ )@@G@@ LA,U A0,0 . GET NULL IN CASE WE NEED TO PAD @C@@@@ LA TR )@@G@@ A2,TXMODE . GET CURRENT MODE @C@@@@ JE,U A2,2 TX0120 . IF TS )@@G@@HALFWORD, DO 1 PAD@E@@@@ JNE,U A2,4 TX0130 . IF NOT QWD, NO PADDINTT )@@G@@G NEEDED @D@@@@TX0110 LMJ X6,0,X6 . QUARTERWORD GETS 3 PADS TU )@@G@@@D@@@@ J TX0130 . IGNORE WSFULL IF PADDING @ @@@@ TV )@@G@@ LMJ X6,0,X6 . @ @@@@ J TX0130 . @ @@@@TX0120TW )@@G@@ LMJ X6,0,X6 . @]@@@@ NOP @B@@@@. PADDING COMPLETE, ESTATX )@@G@@BLISH NEW MODE @F@@@@TX0130 LX,U X6,0,A1 . ADDR OF NEW FETCHRTNETY )@@G@@ FROM CTLWORD @C@@@@ SSL A1,18 . ALIGN NEW MODE FLAG TZ )@@G@@@A@@@@ SA,Q4 A1,TXMODE . STASH IT @E@@@@ SSL A1,9 UA )@@G@@ . ALIGN REGISTER INCR FOR THIS MODE@B@@@@ LXI,U X7,0,A1 . ANDUB )@@G@@ SET IT @ @@@@ LX X11,TXLINK . @B@@@@ J 1,X11UC )@@G@@ . NORMAL EXIT @ @@@@. NO ROOM TO EVEN START-- @C@@@@TX0140UD )@@G@@ LA,U A0,0 . SET NO WDS USED ZERO @B@@@@ ALOCTB TX0900 UE )@@G@@ . FREE THE BLOK @D@@@@ SZ TXTOPN . TURN OFF T-STRING OPEUF )@@G@@N FLAG@B@@@@ ERROR YWSFUL . SIGNAL ERROR @ @@@@ LX,H2UG )@@G@@ X11,TXLINK . @A@@@@ J 0,X11 . AND QUIT @[@@@@. UH )@@G@@@C@@@@. ENTRIES TO TERMINATE STORAGE OF T-STRINGS @[@@@@. @A@@@@UI )@@G@@TEXCLO* SX X11,TTLINK . TEMP SAVE@G@@@@ LMJ X11,TEXDWD . USEUJ )@@G@@ DOUBLEND INITIALIZATION TO FORCE PADDING @ @@@@ NOP UK )@@G@@ . @E@@@@TX0200 LA A1,TXTFWA . GET ADDR OF 1ST WORD USED UL )@@G@@@G@@@@ LA,U A0,0,X7 . AND ADDR OF NEXT WD TO BE STORED IUM )@@G@@NTO @D@@@@ ANA A0,A1 . DIFF=NO OF WDS USED @E@@@@UN )@@G@@ SA,H2 A0,0,A1 . NO OF WDS USED TO BLOK HDR WORD @G@@@@ UO )@@G@@ ALOCTB TX0900 . POST ALLOCATED BLOK IN OLD-STYLE FREELIST @D@@@@UP )@@G@@ SZ TXTOPN . TURN OFF T-STRING OPEN FLAG@E@@@@ LA UQ )@@G@@ A0,TXTFWA . RECOVER FWA OF THE BLOK WE USED @ @@@@ RELADR A0 UR )@@G@@ . @ @@@@ LX X11,TTLINK . @ @@@@ J 1,X11US )@@G@@ . @[@@@@. @G@@@@. ERASE T-STRING--NOTE THAT THIS SCANS THEUT )@@G@@ STRING TO ERASE NAME REFS @[@@@@. @ @@@@TEXERS* SX X11,TXLINK UU )@@G@@ . @ @@@@ LA A1,WSDBUG . @C@@@@ TEP,U A1,4 UV )@@G@@ . IS ERASING INHIBITED?@B@@@@ J 1,X11 . YES, FORGET IT UW )@@G@@@D@@@@ SA A0,TXTFWA . TEMP SAVE BLOCK HDR ADDR @D@@@@ UX )@@G@@ LA A2,A0 . SET IT UP FOR FETCH ROUTINE@ @@@@ ABSADR A0 UY )@@G@@ . @B@@@@ LA,H2 A1,0,A0 . GET BLOCK SIZE @E@@@@ UZ )@@G@@ JG,U A1,2 TE0120 . IF NO TEXT WAS STORED, GO FREE IT@D@@@@ LMJ VA )@@G@@ X11,LEXGET . INITIALIZE TO FETCH IT @ @@@@ ER ERR$ VB )@@G@@. @D@@@@TE0100 LMJ X4,0,X4 . BRING NEXT LEXITEM TO A0,A1@ @@@@VC )@@G@@ ER ERR$ . @G@@@@ JE,U A1,LEXNAM TE0110 . IF NVD )@@G@@AME, GO DECREMENT REFERENCE COUNT @F@@@@ JNE,U A1,LEXOPR TE0100 VE )@@G@@. IF NOT OPERATOR, KEEP SCANNING @D@@@@ TE,U A0,AEOL . IS VF )@@G@@OPERATOR END OF LINE? @D@@@@ TNE,U A0,ALAMP . OR BEGINNING OFVG )@@G@@ COMMENTS? @C@@@@ J TE0120 . YES, GO CLEAN UP @C@@@@VH )@@G@@ J TE0100 . NO, KEEP SCANNING @E@@@@TE0110 LMJ X11,SVI )@@G@@YMERS . ERASE SYMBOLIC NAME REFERENCE @C@@@@ J TE0100 VJ )@@G@@ . AND KEEP SCANNIMG @E@@@@TE0120 LA A1,TXTFWA . RECOVER RELADR VK )@@G@@OF TEXT BLOCK @#@@@@ ABSADR A1 .@C@@@@ LA,H2 A0,0,A1 VL )@@G@@ . PICK UP SIZE OF BLOCK@E@@@@ LA A1,TXTFWA . RECOVER RELADR VM )@@G@@OF TEXT BLOCK @D@@@@ FREE . PUT ON OLD-STYLE FREEVN )@@G@@ LIST @ @@@@ LX X11,TXLINK . @ @@@@ J 1,X11 VO )@@G@@ . @A@@@@/. ACTUAL STORAGE RTNES ARE HERE--- @[@@@@. @#@@@@ VP )@@G@@ CONSTS . @B@@@@MCHFLG FORM 9,9,18 . STEP,MODE,ADDR @ @@@@TXQFLGVQ )@@G@@ MCHFLG 1,4,TXQUAR . @ @@@@TXHFLG MCHFLG 1,2,TXHALF . @ @@@@TXWFLGVR )@@G@@ MCHFLG 1,1,TXWORD . @ @@@@TXDFLG MCHFLG 2,0,TXDBLE . @[@@@@. VS )@@G@@@#@@@@ INSTRS . @[@@@@. @C@@@@. RTNES USED TO STORE INTO TEXVT )@@G@@STRING AREA-- @[@@@@. @#@@@@W PROC . @C@@@@WFCHEK* NAMEVU )@@G@@ . CHECK FOR WSFULL CONDITION @ @@@@ UNLI$T . VV )@@G@@@D@@@@ LA,U A4,0,X7 . ADDR OF WORD TO BE USED @G@@@@ VW )@@G@@ TG A4,TXTLWA . DOES IT PRECEDE THE LAST AVAILABLE WORD? @D@@@@VX )@@G@@ J TX0840 . NO, GO TAKE WSFULL EXIT @ @@@@ LI$T VY )@@G@@ . @ @@@@ END . @[@@@@. @#@@@@VZ )@@G@@. HALFWORD STORAGE@[@@@@. @#@@@@TX0800 WFCHEK . @ @@@@ SA,H1WA )@@G@@ A0,0,X7 . @ @@@@ LMJ X6,1,X6 . @ @@@@ SA,H2WB )@@G@@ A0,0,*X7 . @ @@@@ LMJ X6,1,X6 . @ @@@@TXHALF J WC )@@G@@ TX0800 . @G@@@@. FORCE AN EOL AS NEXT HALFWD (WHEN WSFULL AT H1WD )@@G@@ WHILE STASHING OPRS) @C@@@@TXHEOL* LA,U A0,AEOL . GET END OF LINEWE )@@G@@ FLAG @G@@@@ SA,H1 A0,0,*X7 . PUT IN SAFETY VALVE WD, STEP CT OWF )@@G@@F WDS USED @ @@@@ J 0,X11 . @[@@@@. @^@@@@. QUARWG )@@G@@TERWORD STORAGE @[@@@@. @E@@@@TX0810 JE,U A0,AEOL TX0815 . EOL'WH )@@G@@S ARE ALWAYS STASHED @D@@@@ WFCHEK . OTHERWISE, CHECWI )@@G@@K FOR WSFULL@ @@@@TX0815 SA,Q1 A0,0,X7 . @ @@@@ LMJ X6,1,WJ )@@G@@X6 . @ @@@@ SA,Q2 A0,0,X7 . @ @@@@ LMJ X6,1,WK )@@G@@X6 . @ @@@@ SA,Q3 A0,0,X7 . @ @@@@ LMJ X6,1,WL )@@G@@X6 . @ @@@@ SA,Q4 A0,0,*X7 . @ @@@@ LMJ X6,1,WM )@@G@@X6 . @ @@@@TXQUAR J TX0810 . @[@@@@. @]@@@@. FULLWN )@@G@@WORDS @[@@@@. @ @@@@TX0820 WFCHEK . @ @@@@ SA WO )@@G@@ A0,0,*X7 . @ @@@@ LMJ X6,1,X6 . @ @@@@TXWORD J WP )@@G@@ TX0820 . @[@@@@. @#@@@@. DOUBLEWORDS @[@@@@. @ @@@@WQ )@@G@@TX0830 WFCHEK . @ @@@@ DS A2,0,*X7 . @ @@@@WR )@@G@@ LMJ X6,1,X6 . @ @@@@TXDBLE J TX0830 . @#@@@@WS )@@G@@. EXIT FOR WSFULLS@C@@@@TX0840 LMJ X6,0,X6 . TAKE WSFULL EXIT WT )@@G@@@G@@@@ LMJ X6,0,X6 . IF HE TRIES TO PAD, GIVE HIM ANOTHER CHWU )@@G@@ANCE @E@@@@ ER ERR$ . BUT DON'T LET THE PROGRAM LOOP WV )@@G@@@[@@@@. @ @@@@TX0900 ERROR YSYSTM . @ @@@@ LX X11,TWW )@@G@@XLINK . @ @@@@ J 0,X11 . @ @@@@ VARBLS WX )@@G@@ . @#@@@@TXMODE RES 1 . @#@@@@TXLINK RES 1 . @#@@@@TXTLWAWY )@@G@@ RES 1 . @#@@@@TXTFWA RES 1 . @#@@@@TTLINK RES 1 . @#@@@@ WZ )@@G@@ VARCON . @C@@@@TXTOPN* +0 . NON-ZERO IF A T-STRING IS OPEN @[@@@@XA )@@G@@. @G@@@@/. COPY A LINE OF TEXT-- USED BY )COPY, OR TO RE-OPEN ANXB )@@G@@ OLD FUNC @F@@@@. ENTER WITH A0=ABSADR OF 'FROM' WS; A1=RELAXC )@@G@@DR OF TEXT @C@@@@. EXIT WITH A0=RELADR OF COPIED LINE @[@@@@XD )@@G@@. @ @@@@ INSTRS . @ @@@@TEXCPY* SX X11,TCLINK XE )@@G@@ . @D@@@@ SA A0,TCBASF . SAVE BASE ADDR OF 'FROM' WS@G@@@@XF )@@G@@ AA,U A1,0,A0 . COMPUTE ABS ADDR OF BEGINNING OF T-STRING XG )@@G@@@C@@@@ SA,H2 A1,TSADDR . SAVE T-STRING ADDRESS@E@@@@. FIRST, ACQXH )@@G@@UIRE SPACE AND MOVE ENTIRE STRING IN ONE WHACK @D@@@@TC0010 LA,H2 A0,0,XI )@@G@@A1 . GET NO WDS FROM BLOK HEADER@C@@@@ ALLOCT TC0900 . ACQXJ )@@G@@UIRE THE SPACE @D@@@@ SA A1,TCNUBL . SAVE RELADR OF NEW BLXK )@@G@@OCK @ @@@@ ABSADR A1 . @B@@@@ LXI,U A1,1 XL )@@G@@ . SET INCR FOR BT@D@@@@ LX X7,A1 . AND INITIALIZE SCANNEXM )@@G@@R, TOO@D@@@@ LXI,U A1,1 . SET UP 'TO' ADDR FOR BT @C@@@@XN )@@G@@ LA A2,TSADDR . AND 'FROM' POINTER @F@@@@ LR,H2 R1,0,XO )@@G@@A2 . GET SIZE FROM HDR WD OF 'FROM' BLOCK @E@@@@ BT A1,0,XP )@@G@@*A2 . COPY BLOCK TO ITS NEW LOCATION @G@@@@. NOW SCAN THE NEWLY COPXQ )@@G@@IED BLOCK AND ADJUST SYMBOL TABLE REFERENCES @ @@@@TC0100 LX,U X6,TCXR )@@G@@SCAN . @C@@@@ LMJ X6,0,X6 . GET FIRST HALFWORD @C@@@@XS )@@G@@TC0110 DSL A0,18-3 . LINE UP TYPE DIGIT @B@@@@ SSL A1,36XT )@@G@@-15 . AND DATA FIELD @G@@@@ COMJMP A0,TC0910 LEXLIT,TC0120 LEXNXU )@@G@@AM,TC0130 LEXTRC,TC0130 ; @E@@@@ LEXSTP,TC01XV )@@G@@30 LEXOPR,TC0140 . @C@@@@. LIT ENCOUNTERED-- BUMP WORDREG TO BYPASSXW )@@G@@ IT @ @@@@TC0120 AX,U X7,0,A1 . @G@@@@ J TC0100 XX )@@G@@ . GO MAKE SURE FETCH STARTS AT H1 OF NEXT WD @C@@@@. NAME ENCOUNTEREDXY )@@G@@-- PUT IT IN SYMBOL TABLE @B@@@@TC0130 SA A0,TCNTYP . SAVE NAMEXZ )@@G@@ TYPE @D@@@@ LA A0,TCBASF . GET ABS ADDR OF 'FROM' WS @C@@@@YA )@@G@@ LMJ X11,SYCOPY . COPY NAME INTO NEW WS@B@@@@ J TC020YB )@@G@@0 . OOPS, TROUBLE @C@@@@ LA A0,TCNTYP . RECOVER NAME TYYC )@@G@@PE @B@@@@ LSSL A1,36-15 . REALIGN NAME @E@@@@ LDSL YD )@@G@@ A0,15 . REPACK NAME POINTER AND TYPE @C@@@@ LMJ X6,0,YE )@@G@@X6 . STORE OLD, FETCH NEXT@C@@@@ J TC0110 . GO ANALYZYF )@@G@@E NEXT ITEM @^@@@@. OPERATOR ENCOUNTERED--@C@@@@TC0140 TE,U A1,AEOL YG )@@G@@ . IF EOL, WE'RE DONE @B@@@@ TNE,U A1,ALAMP . DITTO IF LAMP- YH )@@G@@@B@@@@ J TC0150 . GO CLEAN UP @E@@@@ LMJ X6,1,YI )@@G@@X6 . NOT DONE, SKIP TO NEXT LEX ITEM @C@@@@ J TC0110 YJ )@@G@@ . AND GO DECODE IT @ @@@@. GENERAL CLEANUP AND EXIT @C@@@@TC0150YK )@@G@@ LA A0,TCNUBL . GET ADDR OF BLOCK @ @@@@ LX,H2 X11,TCLINK YL )@@G@@ . @ @@@@ J 1,X11 . @C@@@@. TROUBLE PUTTING A NAMEYM )@@G@@ IN THE SYMBOL TABLE-- @D@@@@TC0200 LA,U A0,+LEXOPR*/30+AEOL . GET EYN )@@G@@ND FLAG @F@@@@ LMJ X6,0,X6 . FORCE IT IN SO ERASER STOPSYO )@@G@@ PROPERLY @C@@@@ LA A0,TCNUBL . GET BLOCK ADDRESS @F@@@@YP )@@G@@ LMJ X11,TEXERS . ERASE AND UN-TABULATE ANY OLD NAMES @ @@@@YQ )@@G@@ ER ERR$ . @B@@@@ J TC0999 . TAKE ERROYR )@@G@@R EXIT@[@@@@. @F@@@@TC0900 ERROR YWSFUL,TC0999 . CAN'T GET SPACE YS )@@G@@FOR THE STRING @ @@@@TC0910 ERROR YSYSTM,TC0999 . @ @@@@TC0999 LX,H2YT )@@G@@ X11,TCLINK . @B@@@@ J 0,X11 . ERROR EXIT @[@@@@YU )@@G@@. @[@@@@. @D@@@@. SCAN ROUTINE TO FETCH WITH BACKTRACKING STORE-YV )@@G@@- @[@@@@. @F@@@@TCSCAN LA,H1 A0,1,*X7 . NOTE-- X7 LAGS BY 1 BYW )@@G@@EFORE THIS INSTR @A@@@@ LMJ X6,0,X6 . RETURN @G@@@@ YX )@@G@@ SA,H1 A0,0,X7 . STORE BACK INTO LAST HALFWORD FETCHED FROM @C@@@@YY )@@G@@ LA,H2 A0,0,X7 . GET NEXT HALFWORD @A@@@@ LMJ X6,0,YZ )@@G@@X6 . RETURN @D@@@@ SA,H2 A0,0,X7 . STORE IN LAST HALFWORZA )@@G@@D @D@@@@ J TCSCAN . AND GO FETCH FROM NEXT WORD@[@@@@ZB )@@G@@. @ @@@@ VARBLS . @ @@@@TCLINK RES 1 ZC )@@G@@ . @E@@@@TCBASF RES 1 . BASE ADDR OF 'FROM' WS (ABSOLUTE)ZD )@@G@@@D@@@@TCNUBL RES 1 . ADDR OF 'NEW' TEXTBLOCK @ @@@@TCNTYPZE )@@G@@ RES 1 . @ @@@@ VARCON . @F@@@@TSADDRZF )@@G@@ +1,$-$ . BT PARAMETER: ABSADR OF 'FROM' T-STRING@C@@@@/. ZG )@@G@@FETCH TEXT FROM BLOX CREATED BY ABOVE-- @[@@@@. @[@@@@. @#@@@@ZH )@@G@@F PROC . @C@@@@FLAGET* NAME . SET REG TO LEXANL TYPE FLAGS ZI )@@G@@@B@@@@ LA,U A1,0 . CLEAR FLAGREG @ @@@@ UNLIST ZJ )@@G@@ . @B@@@@ LDSC A0,21 . FLAGBITS TO A1 @D@@@@ ZK )@@G@@ SSL A0,21 . REALIGN REMAINDER OF WD @C@@@@ LA A2,LGCZL )@@G@@OUN . CURRENT ITEM COUNT @F@@@@ AA,U A2,1 . BUMP IT, ZM )@@G@@LEAVING VAL IN A2 FOR COMPILER@D@@@@ SA A2,LGCOUN . AND STASHZN )@@G@@ IT FOR NEXT TIME @#@@@@ LIST . @#@@@@ END . @[@@@@ZO )@@G@@. @#@@@@G PROC . @#@@@@GOBACK* NAME . @#@@@@ UNLI$ZP )@@G@@T . @F@@@@ DS A0,LGLAST . SAVE EXIT PARAMS IN CASE OF BACKUZQ )@@G@@P @B@@@@ J GETOUT . AND RETURN @E@@@@GETBAK DL ZR )@@G@@ A0,LGLAST . IF BACKING UP, GET OLD STUFF @ @@@@ LA A2,LGZS )@@G@@COUN . @B@@@@GETOUT LMJ X4,1,X4 . NORMAL EXIT @F@@@@BAKCNTZT )@@G@@*(1) EQU $-GETBAK . COUNT USED TO CHANGE X4 FOR BACKUP @#@@@@ ZU )@@G@@ LI$T . @]@@@@ END .@[@@@@. @F@@@@. INITIALIZATION ENTZV )@@G@@RY ( INITIAL BLOK ADDR SHOULD BE IN A2)@[@@@@. @#@@@@ INSTRZW )@@G@@S . @^@@@@LEXGET* SX X11,LGLINK @E@@@@ SZ LGCOUN . CLEZX )@@G@@AR COUNT OF ITEMS SCANNED @C@@@@ JZ A2,LG0900 . IF NO BLOZY )@@G@@CK, ERROR @ @@@@ ABSADR A2 . @F@@@@ LXM,U X5,1,ZZ )@@G@@A2 . SET POINTER TO WORD AFTER BLOCK HEADER @ @@@@ LXI,U X5,1 AA )@@G@@ . @ @@@@ LX,U X4,LGPICK . @B@@@@ J 1,X11AB )@@G@@ . AND ESCAPE @ @@@@. FETCHING IS DONE HERE-- @ @@@@LG0100AC )@@G@@ GOBACK . @C@@@@LGPICK LA,H1 A0,0,X5 . GET NEXT T-ENTRAD )@@G@@Y @C@@@@ JZ A0,LG0110 . IF NULL, SKIP IT @E@@@@ AE )@@G@@ FLAGET . ISOLATE A0=OP, A1=FLAG BITS @C@@@@ TNE,UAF )@@G@@ A1,LEXLIT . IS THIS LITERAL? @H@@@@ JMGI X5,LG0120 . YESAG )@@G@@, SET ADDR POINTER TO 1ST WD AND PROCESS IT @D@@@@ JNE,U A1,LEAH )@@G@@XOPR LG0105 . IF NOT OPR, RETURN @F@@@@ JE,U A0,ALAMP LG0200 AI )@@G@@. IF LAMP, GO SETUP TO GET COMMENTS @ @@@@LG0105 GOBACK . AJ )@@G@@@G@@@@LG0110 LA,H2 A0,0,*X5 . GET NEW SETTING FOR POINTER(AT END OF LAK )@@G@@IT) @B@@@@ JZ A0,LG0100 . SKIP NULLS @B@@@@ FLAGEAL )@@G@@T . DECODE T-ENTRY @E@@@@ JNE,U A1,LEXOPR LG0115 . IF NAM )@@G@@OT OPR, GO CHECK LIT @G@@@@ JE,U A0,ALAMP LG0210 . IF OPR IS AN )@@G@@LAMP, GO SET UP FOR COMMENTS @D@@@@LG0115 JNE,U A1,LEXLIT LG0100 . IF NAO )@@G@@OT LIT, RETURN @E@@@@. THE ITEM IS AN IMBEDDED LITERAL--(A0=NO OF WDSAP )@@G@@ USED BY IT)@C@@@@LG0120 AU,U A0,0,X5 . GET ADDR OF LIT DESCR@E@@@@AQ )@@G@@ LA,U A0,0,X5 . AND NEW POINTER IS AT END OF LIT @E@@@@ AR )@@G@@ RELADR A0 . MAKE IT REL FOR USE BY COMPILER @F@@@@ LXM,UAS )@@G@@ X5,0,A1 . SET NEXT FETCH POINTER TO AFTER LITERAL@D@@@@ LA,U AT )@@G@@ A1,LEXLIT . RESTORE LITERAL COSNT FLAG @F@@@@ J LG0100 AU )@@G@@ . AND SHIP THE POINTER TO THE COMPILER @[@@@@. @A@@@@. PREPARE TOAV )@@G@@ START FETCHING COMMENTS@D@@@@LG0200 GOBACK . LAMP WAS IN H1,AW )@@G@@ RETURN IT @D@@@@ J LG0230 . START COMMENT FETCH AT Q3 AX )@@G@@@D@@@@LG0210 GOBACK . LAMP WAS IN H2--- RETURN IT@ @@@@. STARAY )@@G@@T COMMENT FETCH AT Q1 @ @@@@LG0220 LA,Q1 A0,0,X5 . @C@@@@ AZ )@@G@@ TZ A0 . IF NULL, SKIP IT @ @@@@ LMJ X4,1,X4 BA )@@G@@ . @ @@@@ LA,Q2 A0,0,X5 . @C@@@@ TZ A0 BB )@@G@@ . IF NULL, SKIP IT @ @@@@ LMJ X4,1,X4 . @ @@@@LG0230BC )@@G@@ LA,Q3 A0,0,X5 . @C@@@@ TZ A0 . IF NULL, SKIP IBD )@@G@@T @ @@@@ LMJ X4,1,X4 . @ @@@@ LA,Q4 A0,0,*X5 BE )@@G@@ . @C@@@@ TZ A0 . IF NULL, SKIP IT @ @@@@ BF )@@G@@ LMJ X4,1,X4 . @ @@@@ J LG0220 . @G@@@@LGBACKBG )@@G@@* ANX,U X4,BAKCNT(1) . EXECUTE THIS TO BACK UP THE SCANNER 1 ITEM @[@@@@BH )@@G@@. @ @@@@LG0800 ERROR YSYSTM,LG0890 . @[@@@@. @C@@@@LG0890 J BI )@@G@@ 0,X4 . TOO BAD !!!!!!!!!!! @[@@@@. @ @@@@LG0900 ERROR YSYSTBJ )@@G@@M,LG0990 . @[@@@@. @ @@@@LG0990 LX X11,LGLINK . @ @@@@ BK )@@G@@ J 0,X11 . @#@@@@ VARBLS . @#@@@@LGLINK RES 1 . BL )@@G@@@D@@@@LGLAST RES 2 . TEMP SAVE OF BACKUP PARAMS @G@@@@LGCOUNBM )@@G@@ RES 1 . COUNTER OF LEXITEMS (NEEDED FOR ERROR ECHO) @]@@@@BN )@@G@@ END ___@@@LG0100 GOBACK . @C@@@@LGPICK LA,H1 A0,0,BO )@@G@@*[S@@@*SDFF*@G@@@@. ****************************************************BP )@@G@@***************** @G@@@@. STANDARD PROCS - INCLUDED BY AN @ADD PRCPKG/APBQ )@@G@@L IN SOURCE DECKS * @G@@@@. BR )@@G@@ * @G@@@@ AXR$ . BS )@@G@@ * @G@@@@ CONFIG . DEFINE ASSBT )@@G@@EMBLY PARAMETERS * @G@@@@ APSYMB. DEFINBU )@@G@@E APL SYMBOL SET * @G@@@@ WSDEF. BV )@@G@@ DEFINE WORKSPACE * @G@@@@WORKSP INFO BW )@@G@@ 2 20. SET ASIDE THE SPACE * @G@@@@ BX )@@G@@ RUNCTL. DEFINE RUN CTRL BLOK(S) * @G@@@@BY )@@G@@RUNCON INFO 2 22. AND SET ASIDE ITS SPACE * BZ )@@G@@@G@@@@ CBLOCK . DEFINE CONTROL BLOCK TYPES CA )@@G@@ * @G@@@@. CB )@@G@@ * @G@@@@. END OF STANDARD PROC BLOCK CC )@@G@@ * @G@@@@. **********************************************CD )@@G@@*********************** @[@@@@. @F@@@@IBCOMN EQU 11 . CTR FOR I-BACE )@@G@@NK SHARED CODE (IN ROOT SEGMENT) @[@@@@. @D@@@@ STATEV CF )@@G@@ . DEFINE STATEVECT PARAMETERS@#@@@@ SKMARX . @[@@@@. CG )@@G@@@G@@@@A PROC . ACCEPT NEXT INPUT LINE AND LEXICALLY ANALYZE ICH )@@G@@T @C@@@@ACCEPT* NAME 0 . PARAMS-- SYSCMD,EDCMD ERR EOF @#@@@@ CI )@@G@@ UNLI$T . @E@@@@ SZ STVLXT . CLEAR STORED LEXICAL TEXT FCJ )@@G@@LAG @E@@@@AC0005 LMJ X11,LNFLSH . CLEAR OUTPUT BUF, JUST IN CASE CK )@@G@@@A@@@@ LA,U A3,SIXBLX . SETUP @D@@@@ LA,U A4,7 CL )@@G@@ . EDIT SIX BLANKS AND AN EOL @B@@@@ LMJ X11,EDTLIT . INTO CIOBCM )@@G@@UF @C@@@@ LMJ X11,BUFILL . AND READ NEW DATA @ @@@@ CN )@@G@@ J A(2,2) . EOF EXIT@C@@@@ LMJ X11,LINITL . RESET CIOBUF POCO )@@G@@INTERS@B@@@@ LMJ X11,LEXINI . INITIALIZE @ @@@@ GO CP )@@G@@ A$CP01 . @D@@@@ACCUNQ* NAME 1 . ACCEPT INPUT FOR UNQUCQ )@@G@@OTE @ @@@@ UNLI$T . @D@@@@ LMJ X11,LEXUNQ CR )@@G@@ . INITIALIZE LEX SCANNER @#@@@@A$CP01* NAME . @B@@@@ LMJ CS )@@G@@ X11,LEXANL . SCAN AND STORE @ @@@@ J A(2,1) . @G@@@@CT )@@G@@ COMJMP A1,AC0010 0,AC0030 1,A(1,1) 2,AC0020 3,AC0015 4,AC0005 CU )@@G@@@D@@@@AC0010 ERROR YSYSTM,A(2,1) . ILLEGAL RETURN CODE @F@@@@AC0015CV )@@G@@ ERROR YSYNTA,A(2,1) . ED CMNDS ILLEGAL, NOT IN DEFN MODE@F@@@@ DO A(CW )@@G@@0,0) ,AC0005 EQU AC0015 . MULL LINES CANNOT BE UNQUOTED @F@@@@. LOCKCX )@@G@@ / FUNC -- SINCE WE'RE NOT IN DEFN MODE, NO TEXT MAY PRECEDE@ @@@@AC0020CY )@@G@@ JZ A2,A(1,2) . @D@@@@ SA A2,STVLXT . ELSE POST ADDR CZ )@@G@@FOR ERASURE @B@@@@ ERROR YDEFN,A(2,1) . AND GE T OUT @ @@@@. NORMDA )@@G@@AL EXIT FOR END OFLINE @E@@@@AC0030 JZ A2,AC0005 . BE CAREFUL IF LDB )@@G@@INE WAS EMPTY @D@@@@ SA A2,STVLXT . ELSE SAVE ADDR OF TEXDC )@@G@@T @#@@@@ LI$T . @#@@@@ END . @#@@@@ CONSTDD )@@G@@S @B@@@@SIXBLX +ASPACE,ASPACE,ASPACE,ASPACE . @B@@@@ +ASPDE )@@G@@ACE,ASPACE,AEOL,AEOL . @[@@@@. @D@@@@C PROC . COMPILEDF )@@G@@ STMNT INDICATED IN STATEVECT @A@@@@COMPIL* NAME . PARAMS: ERRXIT DG )@@G@@@#@@@@ UNLI$T . @D@@@@ LA A2,STVLXT . GET ADDR OF LEXDH )@@G@@ICAL TEXT @ @@@@ LMJ X11,COMPIL . @ @@@@ J C(1,1DI )@@G@@) . @F@@@@ SA A0,STVCCL . SAVE LEFT WORD ADDR OF COMPDJ )@@G@@ILED CODE @D@@@@ LA,U A1,1,A0 . ADDR OF 1ST WD AFTER HEADERDK )@@G@@@D@@@@ SA A1,STVICT . STASH IN CURRENT INSTR CTR @ @@@@ DL )@@G@@ LI$T . @ @@@@ END . @[@@@@. DM )@@G@@@E@@@@. EXECUTE STMNT MARKED IN STATEVECT @[@@@@DN )@@G@@. @^@@@@R PROC . @F@@@@RUN* NAME . GOTO,XQTFUN,EDO )@@G@@VALIN,UNQUOT BREAK,ERR,SICLEAR @ @@@@ UNLI$T . DP )@@G@@@ @@@@ LMJ X11,ICLOAD . @ @@@@ J R(2,2) . DQ )@@G@@@B@@@@ LMJ X11,INTERP . EXECUTE STMNT @ @@@@ J R(2,2DR )@@G@@) . @G@@@@ COMJMP A0,RU0010 0,RU0020 1,R(1,1) 2,R(1,2) 3,DS )@@G@@R(1,3) 4,R(1,4) ; @C@@@@ 5,R(2,1) 6,R(2,3) . DT )@@G@@@A@@@@RU0010 ERROR YSYSTM,R(2,2) .@]@@@@RU0020 . @#@@@@ DU )@@G@@ LI$T . @#@@@@ END . @D@@@@/. THE FOLLOWING PROCS FARBLEDV )@@G@@ WITH STACKED RESULTS @[@@@@. @F@@@@A PROC . SUSP OR FUNDW )@@G@@C MODES: PRINT RESULTS LEFT IN STACK@E@@@@ANSPRT* NAME . THEDX )@@G@@ ONLY ARG IS THE ERROR EXIT @#@@@@ UNLI$T . @E@@@@ LMJ DY )@@G@@ X11,APRINT . GO TO THE IMPLIED PRINT ROUTINE @C@@@@ J A(1,1DZ )@@G@@) . BREAK DURING PRINT @#@@@@ LI$T . @]@@@@ END .EA )@@G@@@[@@@@. @[@@@@. @G@@@@A PROC . SHUFFLE ANSWERS IN SEB )@@G@@TAK AFTER QUADIN, FUNC, UNQUOT@^@@@@ANSTAK* NAME . @^@@@@ EC )@@G@@ UNLI$T . @ @@@@ LMJ X11,AN0010 . @ @@@@ +A(1,ED )@@G@@1) . @ @@@@ LI$T . @ @@@@ END EE )@@G@@ . @A@@@@. SUBROUTINE INVOKED BY ABOVE PROC--@#@@@@ EF )@@G@@ INSTRS . @ @@@@AN0010 SX,H2 X11,ANLINK . @C@@@@ POP A6 EG )@@G@@ . GET TOP OF STACK @C@@@@ TG,U A6,0400000 . IS IT A SEH )@@G@@TAKMARK? @C@@@@ J AN0020 . YES, VALUE ERROR @C@@@@EI )@@G@@ LA A0,A6 . DUPE DESCRIPTOR ADDR @ @@@@ ABSADR A0 EJ )@@G@@ . @D@@@@ LA,S1 A1,0,A0 . GET TYPE OF THIS VARIABLE EK )@@G@@@E@@@@ JNE,U A1,ZTPLIT AN0015 . IF NOT A LIT, FORGET IT @G@@@@EL )@@G@@ LMJ X11,DUPE . OTHERWISE MAKE IT TEMP SO LEX WON'T ERASE IT EM )@@G@@@B@@@@ J AN0025 . OOPS, NO ROOM @E@@@@ LA A6,A2EN )@@G@@ . SET UP ADDR OF NEW DESCRIPTOR @D@@@@AN0015 POP A5 EO )@@G@@ . LOOK UNDER THE VALUE WE GOT@C@@@@ TNE,U A5,SKMRHS . END OF STEP )@@G@@MNT MARKER? @B@@@@ J AN0030 . YES, WE'RE OK @B@@@@ EQ )@@G@@ PUSH A5 . NO, REPLACE IT @E@@@@AN0020 PUSH A6 . STUER )@@G@@FF OLD TOP OF STACK BACK IN @C@@@@ ERROR YVALUE . SIGNAL VAES )@@G@@LUE ERROR @ @@@@AN0025 LX,H2 X11,ANLINK . @B@@@@ J *0,X1ET )@@G@@1 . ERROR EXIT @D@@@@AN0030 PUSH A6 . PUSH THE ANSWEREU )@@G@@ BACK IN @F@@@@ SZ STVSTK . CLEAR STACKED RESULT FLAG FEV )@@G@@OR THIS MODE@ @@@@ LX,H2 X11,ANLINK . @B@@@@ J 1,X11EW )@@G@@ . NORMAL EXIT @#@@@@ VARCON . @ @@@@ANLINK +0,$-$ EX )@@G@@ . @[@@@@. @F@@@@. PURGE STACK OF ENTRIES CREATED BY A EY )@@G@@BAD STMNT EXECUTION @[@@@@. @#@@@@P PROC . @#@@@@PURGE*EZ )@@G@@ NAME . @#@@@@ UNLI$T . @E@@@@ TNZ STVSTK . ANYFA )@@G@@THING STACKED IN THIS STATE? @B@@@@ J PU0030 . NO, GET OFB )@@G@@UT @A@@@@PU0010 POP A6 . TOP OF STACK @C@@@@ TG,U A6,04FC )@@G@@00000 . IS IT A DESCRIPTOR? @D@@@@ J PU0020 . NO , GO SFD )@@G@@EE IF WE'RE DONE @E@@@@ LMJ X11,ERASET . YES, GET RID OF THIS FE )@@G@@VARIABLE @ @@@@ J P(1,1) . @E@@@@ J PU001FF )@@G@@0 . AND KEEP LOOKING FOR THE END @D@@@@PU0020 TE,U A6,SKMRHS FG )@@G@@ . IS THIS STAKMARK THE END? @B@@@@ J PU0010 . NO, KEEP FH )@@G@@TRYING@E@@@@ SZ STVSTK . SET FLAG THAT STACK IS EMPTY FI )@@G@@@]@@@@PU0030 . @ @@@@ LI$T . @ @@@@ END FJ )@@G@@ . @D@@@@E PROC . ERASE COMPILED CODE BLOFK )@@G@@CKS @#@@@@ERSCOD* NAME . @ @@@@ UNLI$T . @ @@@@FL )@@G@@ LA A0,STVCCL . @E@@@@ JZ A0,DONE . IF ALREADFM )@@G@@Y ERASED, FORGET IT @ @@@@ LMJ X11,CODERS . @ @@@@ FN )@@G@@ J E(1,1) . @ @@@@ SZ STVCCL . @[@@@@DONE .FO )@@G@@@#@@@@ LI$T . @#@@@@ END . @E@@@@E PROC . FP )@@G@@ ERASE LEXICALLY ANALYZED TEXT BLOX @#@@@@ERSLEX* NAME . @ @@@@FQ )@@G@@ UNLI$T . @ @@@@ LA A0,STVLXT . @E@@@@FR )@@G@@ JZ A0,ERSXIT . IF NOTHING TO ERASE, GET OUT @ @@@@ FS )@@G@@ LMJ X11,TEXERS . @ @@@@ J E(1,1) . @ @@@@ FT )@@G@@ SZ STVLXT . @]@@@@ERSXIT . @#@@@@ LI$T . @#@@@@FU )@@G@@ END . @[@@@@. @ @@@@. CHANGE TO NEW STATE @[@@@@FV )@@G@@. @#@@@@N PROC . @#@@@@NUSTAT* NAME . @ @@@@ UNLI$FW )@@G@@T . @C@@@@ LMJ X11,SUSPEN . PUSH OLD STATE DOWN FX )@@G@@@ @@@@ J N(1,1) . @B@@@@ LA,U A0,N(0,1) . NEWFY )@@G@@ STATE FLAG @D@@@@ SA A0,STVCUR . INTO CURRENT STATE NDICATORFZ )@@G@@@#@@@@ LI$T . @#@@@@ END . @[@@@@. @#@@@@L GA )@@G@@ PROC . @#@@@@LOGERR* NAME . @A@@@@. THIS PROC IS NO LONGER NEEDEGB )@@G@@D @]@@@@ END .@[@@@@. @#@@@@B PROC . @F@@@@BRKCHKGC )@@G@@* NAME 0 . CHECK FOR II KEYINS OR ATTN SIGNALS @F@@@@ATTCHKGD )@@G@@* NAME 1 . CHECK FOR USER ATTN (TTY BREAK) ONLY @ @@@@ GE )@@G@@ UNLI$T . @^@@@@ DO B(0,0) , GO ATN$01 .@F@@@@ LMJ GF )@@G@@ X11,CINSRV . GO CHECK FOR COMMUNICATIONS INTERRUPTS @E@@@@ J GG )@@G@@ B(1,1) . IF MSG WAS POSTED, GO SUSPEND @#@@@@ATN$01* NAME . GH )@@G@@@D@@@@ATTNCK LA A0,CONSBR . GET TTY BREAK KEY FLAG @C@@@@ GI )@@G@@ SZ CONSBR . POST IT SERVICED @E@@@@ JNZ A0,B(1,1) GJ )@@G@@ . AND IF IT WAS ON, GO SUSPEND @#@@@@ LI$T . @]@@@@ GK )@@G@@ END .@[@@@@. @D@@@@E PROC . ECHO STATEMENTS BACK TOGL )@@G@@ USER @F@@@@ECHOL* NAME 0 . SEND LINE NUMBER AND FUNC NAME ONGM )@@G@@LY @D@@@@ECHOS* NAME 1 . ECHO TEXT OF ENTURE LINE @D@@@@GN )@@G@@ECHOLN* NAME 2 . ECHO LINE AND NAME, DON'T FLUSH BUF @#@@@@ UNLI$GO )@@G@@T . @E@@@@ LMJ X11,ECHEAD . PRINT FUNCTION NAME AND LINENO GP )@@G@@@ @@@@ J XQ0890 . @ @@@@ DO E(0,0)=2 , GO ECH010 . GQ )@@G@@@D@@@@ DO E(0,0) , LMJ X11,ECTEXT . PRINT TEXT, IF REQUESTED@ @@@@ DO E(GR )@@G@@0,0) , J XQ0890 . @B@@@@ LMJ X11,LNFLSH . CLEAR BUFFER GS )@@G@@@]@@@@EC0010 . @#@@@@ECH010* NAME . @#@@@@ LI$T . @#@@@@GT )@@G@@ END . @F@@@@/. SUPERVISE COMPILE, INSTRUCTION COUNTER, STATEGU )@@G@@ VECTOR, ETC... @G@@@@. THE CODE BELOW (DESK CALC RECOGNITION OF STMNTGV )@@G@@ TYPE) IS IN BOTH IBANKS@G@@@@. AND MAY BE EXECUTED FROM EITHER. IN THIGW )@@G@@S WAY WE MINIMIZE UNNECESSARY @G@@@@. BANK SWITCHING-- E.G. A SERIES OF GX )@@G@@SYS COMMANDS WILL KEEP US IN THE @F@@@@. SYSCMD I-BANK, SWITCHING ONLGY )@@G@@Y WHEN AN EXECUTABLE STMNT IS HIT @[@@@@. @C@@@@$(IBCOMN) . EGZ )@@G@@STABLISH AS I-BANK COMMON @G@[@@XQTR* LMJ X11,CLOWER . IF SYSERRHA )@@G@@ RECOVERY, CLEAR WS SO LEXCAN GOES @E@[@@XQT* . BUT AT NORMAL ENTRY, HB )@@G@@SETUP HAS ALREADY DONE IT @E@@[[XQT* LMJ X11,CLOWER . INITHC )@@G@@IALIZE LOWER WS POINTERS@G]@@@ LMJ X11,CORINI . INITIALIZE D-BAHD )@@G@@NK CORE LIMITS TO DEFAULT SIZE@ @@@@ ER EABT$ . @G@@@@HE )@@G@@. AT THIS POINT, CALLER HAS LEFT EITHER )CLEAR OR )LOAD CONTINUE IN HF )@@G@@@B@@@@. THE INPUT BUFFER. START PROCESSING IT @ @@@@ LMJ X11,LHG )@@G@@EXINI . @ @@@@ LMJ X11,LEXANL . @D@@@@ ER ERR$ HH )@@G@@ . WE SHOULD NEVER COME HERE @D@@@@ JE,U A1,1 XQ0250 . IF HI )@@G@@SYSTEM COMMAND, GO DO IT@E@@@@ ER ERR$ . OTHERWISE, SOMEHJ )@@G@@THING IS AMISS @[@@@@ . @[@@@@. @G@@@@. DESK CALCULATOR LEVEL-HK )@@G@@- THIS CODE CAN BE EXECUTED FROM EITHER IBANK @[@@@@. @F@@@@XQ0100HL )@@G@@ NUSTAT,STSUSP XQ0190 . ESTABLISH SUSEPNDED STATE @#@@@@. GET HM )@@G@@NEXT LINE @#@[@@XQ0110 WSDUMP . @D@@[[XQ0110 TZ EABFLG HN )@@G@@. IS ABORT FLAG UP? @E@@[[ J XQ0999 . YES, GO FOHO )@@G@@LD UP THE TENT @D@@[[ WSDUMP . NO, DO OPTIONAL HP )@@G@@DUMP @C[@@@ BRKCHK XQ0115 . SERVICE BREAK KEY @F@@@@XQ0115HQ )@@G@@ ACCEPT XQ0250,XQ0200 XQ0195,XQ0720 . READ NEXT LINE @F@@@@. WE HHR )@@G@@AVE A STMNT TO EXECUTE-- BE SURE WE HAVE THE CORRECT IBANK @A@@@@ HS )@@G@@ CALREP,XQTREP X11,XQ0117 .@F@@@@. THIS CODE IS REACHED ONLY WHEN WE'HT )@@G@@RE IN THE EXECUTION IBANK @D@@@@ INSTRS . SO DON'T BOTHER MAKHU )@@G@@ING IT COMMON @C@@@@XQ0117 COMPIL XQ0810 . AND THEN COMPILE IT HV )@@G@@@B@@@@. RUN (OR RESUME RUNNING) CURRENT STMNT . @F@@@@XQ0120 RUN XQ030HW )@@G@@0,XQ0400,XQ0500,XQ0600 XQ0830,XQ0800,XQ0870 @A@@@@. END OF CURRENT SHX )@@G@@TMNT, CLEAN IT UP @E@@@@XQ0130 ANSPRT XQ0820 . PRINT STACKED RESULTSHY )@@G@@, IF ANY @D@@@@ ERSCOD XQ0920 . GET RID OF COMPILED CODE HZ )@@G@@@^@@@@ ERSLEX XQ0920 . @^@@@@ J XQ0110 . @F@@@@. ERROIA )@@G@@RS. BEFORE SERVICING, BE SURE WE HAVE THE CORRECT I-BANK @G@@@@$(IBCOIB )@@G@@MN) . BE SURE TO SET CTR FOR CODE EXECUTED FROM EITHER IBANK @C@@@@IC )@@G@@XQ0190 CALREP,XQTREP X11,XQ0730 . DEPTH ERROR@A@@@@XQ0195 CALREP,XQTRID )@@G@@EP X11,XQ0820 .@[@@@@. @#@@@@. OPEN FUNC-- @[@@@@. @A@@@@IE )@@G@@XQ0200 CALREP,FUNREP X11,FUNDEF .@A@@@@ J XQ0210 . OOPIF )@@G@@S @G@@@@ J XQ0260 . GO CHECK STATE IN CASE )CMND CAUSIG )@@G@@ED EXIT @^@@@@. ERR IN FUNDEF MODE @B@@@@XQ0210 LA,U A0,STSUSP IH )@@G@@ . FOR GOOD LUCK @C@@@@ SA A0,STVCUR . MARK SI AS DESKCALC II )@@G@@@G@@@@ J XQ0110 . BUT STAY IN THIS I-BANK FOR NEXT STATEMIJ )@@G@@ENT @[@@@@. @ @@@@. EXECUTE SYSTEM COMMAND -- @[@@@@. @E@@@@IK )@@G@@XQ0250 CALREP,SYSREP X11,SYSCMD . LOAD BANK AND GO DO IT @A@@@@ IL )@@G@@ J XQ0270 . OOPS @E@@@@. CHECK MODE BECAUSE SYSCMNDS SUCH AIM )@@G@@S )LOAD CAN CHANGE IT @B@@@@XQ0260 LA A0,STVCUR . CURRENT MODE IN )@@G@@@F@@@@ JE,U A0,STSUSP XQ0110 . IF SUSPENDED, STAY IN THIS IBANK IO )@@G@@@F@@@@ CALREP,XQTREP X11,XQ0265 . ELSE RELOAD EXECUTION IBANK IP )@@G@@@F@@@@XQ0265 JE,U A0,STEVAL XQ0510 . EVAL INPUT HAS SPECIAL TREATMENT IQ )@@G@@@B@@@@ ER ERR$ . ELSE CRASH @[@@@@. @#@@@@. ERR IR )@@G@@IN SYS MODE @[@@@@. @#@@@@ INSTRS . @F@@@@XQ0270 CALREP,XQTRIS )@@G@@EP X11,XQ0275 . FORCE EXECUTION IBANK IN @C@@@@XQ0275 LA A1,STIT )@@G@@VCUR . GET CURRENT STATE @C@@@@ TE,U A1,STEVAL . IT CAN BEIU )@@G@@ EVALIN @B@@@@ TNE,U A1,STSUSP . OR SUSPENDED @D@@@@ IV )@@G@@ J XQ0820 . IN WHICH CASE WE SUSPEND @C@@@@ ER ERR$ IW )@@G@@ . OTHERWISE WE GO DOWN @[@@@@/. @A@@@@. TRANSFER TO STATEMENT IX )@@G@@NO IN A1,A2 @[@@@@. @#@@@@ INSTRS . @F@@@@XQ0300 SA,H2 A2,XQIY )@@G@@STMN . TEMP SAVE STATEMENT NO TO BE XQT'D @D@@@@ PURGE IZ )@@G@@ . GET RID OF THIS STATEMENT @ @@@@ ERSCOD . JA )@@G@@@ @@@@ ERSLEX . @E@@@@ TNZ STVCHN . IS JB )@@G@@THERE A STATE UNDER THIS? @E@@@@ J XQ0110 . NO, IGNORJC )@@G@@E THIS OP COMPLETELY @B@@@@ LMJ X11,UNPEND . YES, POP IT UP JD )@@G@@@C@@@@ J XQ0890 . IF TROUBLE, SYSERR @B@@@@ LA JE )@@G@@ A0,STVCUR . GET NEW STATE @E@@@@ JNE,U A0,STFUNX XQ0890 . IF IJF )@@G@@TS NOT FUNC, SYSERR @C@@@@ LA A0,STVFNN . GET NAMEBLOK ADJG )@@G@@DR @D@@@@ LA,H2 A2,XQSTMN . AND STMNT TO RESUME AT @E@@@@JH )@@G@@ SA A2,STVSTN . NEXT STATEMENT NO TO STATEVECTOR @G@@@@ JI )@@G@@ J XQ0427 . SINCE PENDANT FUNCS CAN BE EDITED, RESET SV @[@@@@JJ )@@G@@. @ @@@@/. FUNC EXECUTION MODE @[@@@@. @F@@@@L PROC JK )@@G@@ . POST LOC OF LEXTEXT FOR CURRENT (NUMBERED) STMNT @#@@@@LXPOST* NAMEJL )@@G@@ 1 . @#@@@@ UNLI$T . @C@@@@ LA A0,STVSTN . LINENO TOJM )@@G@@ BE EXECUTED@B@@@@ TG,U A0,1 . IS IT .LE.0? @F@@@@ JN )@@G@@ TG A0,STVFNL . NO, DOES IT EXCEED THE END OF TABLE? @E@@@@ JO )@@G@@ J L(1,1) . IF EITHER, GO EXIT FROM FUNC @E@@@@ AA JP )@@G@@ A0,STVFTA . ELSE ADD ADDR OF ENTRY FOR LINE 0@^@@@@ GO LP$01JQ )@@G@@0 . @C@@@@LZPOST* NAME 0 . ENTRY TO POST ADDR OF LINE ZERO@#@@@@ JR )@@G@@ UNLI$T . @F@@@@ LA A0,STVFTA . PICK UP LINE ZERO ADDR FROMJS )@@G@@ STATEVECT @#@@@@LP$010* NAME . @ @@@@ ABSADR A0 . JT )@@G@@@E@@@@ LA,H2 A1,0,A0 . PICK UP ADDR OF LEXICAL TEXT @C@@@@JU )@@G@@ SA A1,STVLXT . PUT INTO STATEVECTOR @E@[@@ DO 1-L(0,0) , LA,JV )@@G@@U A1,0 . IF LINE ZERO, CLEAR TRACE/STOP @G@[@@ DO L(0,0) , LA,H1 A1,JW )@@G@@0,A0 . OTHERWISE, GET TRACE/STOP FLAGS FROM TBL @D@[@@ SA A1,STJX )@@G@@VTRC . GET 6TH WORD FOR TRACE @D@@[[ LA,H1 A1,0,A0 JY )@@G@@. GET TRACE/STOP FLAGS @F@@[[ DO L(0,0) , SA A1,STVTRC . IF NOT FUNJZ )@@G@@C HDR, SET TRACE FLAG @ #@@@ SSL A1,6 . @B@@@@ KA )@@G@@ SA A1,STVSTP . DITTO FOR STOP @#@@@@ LI$T . @#@@@@ KB )@@G@@ END . @[@@@@. @#@@@@ INSTRS . @D@@@@XQ0400 SA A1,XQFKC )@@G@@NMB . TEMP SAVE ADDR OF NAMEBLOK @C@@@@ ABSADR A1 . ADDKD )@@G@@R OF NAME BLOK @D@@@@ LA,H2 A0,1,A1 . GET RELAD OF NEXT DESKE )@@G@@CR @E@@@@ LA,U A2,ZTPFUN . AND VALUE FOR TYPE COMPARISONS KF )@@G@@@D@@@@. SEARCH CHAIN OF DESCRS ON THIS NAME FOR FUNC DESCR @G@@@@XQ0410KG )@@G@@ JZ A0,XQ0490 . IF CAN'T FIND FUNC, MAYBE ERASED. VALUE ERR @B@@@@KH )@@G@@ LA A1,A0 . DUPE DESCR ADDR@ @@@@ ABSADR A1 KI )@@G@@ . @E@@@@ JE,S1 A2,0,A1 XQ0415 . IF DESCR IS FUNC, WE'RE DONEKJ )@@G@@@D@@@@ LA,H2 A0,2,A1 . OTHERWISE, GET FWD POINTER @C@@@@ KK )@@G@@ J XQ0410 . AND KEEP LOOKING @B@@@@XQ0415 TNZ,H2 2,A1 KL )@@G@@ . IS DEF CLOSED? @F@@@@ TNZ,H2 1,A1 . AND IS THERE A CLOSEDKM )@@G@@ TABLE OF LINENOS?@C@@@@ J XQ0920 . IF NEITHER, SYSERR KN )@@G@@@E@@@@. EVERYTHING CHECKS OUT-- ESTABLISH THE FUNC EXECUTION STATE@ @@@@KO )@@G@@XQ0420 NUSTAT,STFUNX XQ0730 . @G@@@@ LA A0,STVDPT . CURRENT SKP )@@G@@TATEVECTOR DEPTH OF FUNC NESTING @B@@@@ TG,U A0,0777 . WITKQ )@@G@@HIN RANGE? @D@@@@ J XQ0491 . NO, STATEVECTOR OVERFLOW KR )@@G@@@A@@@@ AA,U A0,1 . BUMP @D@@@@ SA A0,STVDPT KS )@@G@@ . POST NEW STATEVECTOR DEPTH @E@@@@ LA A0,XQFNMB . RECOVER RKT )@@G@@ELADR OF FUNC NAMEBLOK @E@@@@ SA A0,STVFNN . AND PUT IT IN TKU )@@G@@HE NEW STATEVECTOR@G@@@@ LMJ X11,XQ0480 . THEN INITIALIZE TABLEKV )@@G@@ ADDRESSES IN STATEVECT @G@@@@ SZ STVSTN . SET NEXT LINE TKW )@@G@@O EXECUTE TO LINE ZERO (HDR) @D@@@@ LZPOST . POST ADDRKX )@@G@@ OF LEXICAL TEXT @F@@@@ LA A2,STVLXT . GET ADDR OF LEXICAL TKY )@@G@@EXT FROM STATEVECT@F@@@@ LMJ X11,FUNCST . GO EXECUTE ENTRY TO FKZ )@@G@@UNC (HEADER LINE) @ @@@@ J XQ0470 . @C@@@@ LA LA )@@G@@ A0,STVFTA . BASE ADDR OF FUNC TBL@F@@@@ LMJ X11,FUNLBC . ANDLB )@@G@@ GO CREATE LABEL VARIABLES, IF ANY @ @@@@ J XQ0800 . LC )@@G@@@E@@@@ J XQ0430 . THEN START EXECUTING THE FUNC @ @@@@LD )@@G@@. RESUMING PENDANT FUNCTION @B@[@@XQ0427 LXPOST XQ0460 . POST TEXTLE )@@G@@ DATA @B@@][XQ0427 LXPOST XQ0459 . POST TEXT DATA @G[@@@ SZ LF )@@G@@ STVSTP . BE SURE STOPVECT FLAG IS OFF, ELSE WE'LL LOOP@ @@@@ LG )@@G@@ J XQ0445 . @ @@@@. NOW EXECUTE THRU LINENO TBL @B@@@@XQ0430LH )@@G@@ LA A2,STVSTN . LAST STMNT NO @A@@@@ AA,U A2,1 . BUMLI )@@G@@P IT @ @@@@ SA A2,STVSTN . @F@@@@. NOTE: GOTO LEAVES STMNLJ )@@G@@TNO (INT) IN A2 AND COMES DIRECTLY HERE @E@@@@XQ0440 LXPOST XQ0460 LK )@@G@@ . POST TEXT ADDR, STOP/TRACE DATA @ @@@@XQ0445 WSDUMP . LL )@@G@@@ @@@@ BRKCHK XQ0830 . @D@@@@ TZ STVSTP . IS LM )@@G@@STOPVECTOR FLAG ON? @B@@@@ J XQ0853 . YES, GO SUSPENDLN )@@G@@@C@@@@ COMPIL XQ0810 . COMPILE THIS STMNT @B@@@@. RUN (OR RELO )@@G@@SUME RUNNING) PRESENT STMNT @F@@@@XQ0450 RUN XQ0455,XQ0400,XQ0500,XQLP )@@G@@0600 XQ0830,XQ0800,XQ0870 @C@@@@ ERSCOD XQ0920 . PURGE COMLQ )@@G@@PILED CODE @G@@@@ ANSPRT XQ0820 . PRINT ANSWER, IF NECESSARY LR )@@G@@(WITH TRACE CHK) @C@@@@ J XQ0430 . GO DO NEXT STMNT LS )@@G@@@B@@@@. GO TO ENCOUNTERED (STMNT NO IS IN A2) @ @[@@XQ0455 SA A2,STLT )@@G@@VSTN . @F@[@@ ERSCOD XQ0920 . GET RID OF COMPILED CODE, TLU )@@G@@HIS STMNT @E@[@@ PURGE . GET RID OF ANY STACKED GARBLV )@@G@@AGE @F@[@@ J XQ0440 . AND EXECUTE THE DESTINATION STATELW )@@G@@MNT @F@@[[XQ0455 SA A2,XQSTMN . TEMP SAVE STATEMNT WE'LL GO LX )@@G@@TO @G@@[[ ERSCOD XQ0920 . GET RID OF COMPILED CODE FORLY )@@G@@ THIS STMNT @F@@[[ TNZ STVTRC . IS THIS STATEMENT BEINLZ )@@G@@G TRACED? @D@@[[ J XQ0456 . NO, GO PURGE THE STACKMA )@@G@@@D@@[[ ANSPRT XQ0820 . YES, PRINT ITS RESULT @A@@[[ MB )@@G@@ J XQ0457 . @F@@[[XQ0456 PURGE . NO TMC )@@G@@RACE; CLEAR GARBAGE IN STACK @E@@[[XQ0457 LA A2,XQSTMN . RECOMD )@@G@@VER TARGET LINENUMBER @E@@[[ SA A2,STVSTN . POST IT INME )@@G@@ THE STATEVECTOR @C@@[[ J XQ0440 . AND LEAP TO IT MF )@@G@@@C@@[[. GO TO LINE ZERO RESUMPTION OF PENDANT FUNC-- @D@@[[XQ0459 SZ MG )@@G@@ STVSTN . SET TARGET LINENUMBER @D@@[[ LZPOST MH )@@G@@ . FIND STATEMENT TEXT @F@@[[ SZ STVSTP . SINCE WE'MI )@@G@@RE RESUMING, WE CAN'T STOP @C@@[[ J XQ0465 . SO GMJ )@@G@@O EXECUTE @B^@@@. LINENO OUT OF RANGE, TAKE FUNC EXIT @E@@@@XQ0460MK )@@G@@ SZ STVSTN . GET SET TO AGAIN EXECUTE LINE 0 @F@@@@ LZPOSML )@@G@@T . POST ADDR OF LEXTEXT OF HEADER LINE @E@[@@ LA MM )@@G@@ A2,STVLXT . GET LEXICAL TEXT ADDR FOR SCANNER@C@@[[ TZ STVMN )@@G@@STP . IS STOPVECTOR SET? @E@@[[ J XQ0853 . YES,MO )@@G@@ GO SUSPEND EXECUTION @G@@[[XQ0465 LA A2,STVLXT . NO, GET TEMP )@@G@@XT ADDR FOR EXECUTION RTNE @G[@@@ LMJ X11,FUNCEX . TAKE EXITMQ )@@G@@ PROCESSING OPTION OF HEADER LINE @ @@@@ J XQ0920 . MR )@@G@@@C@@@@ LA A0,STVFTA . GET FUNCTBL ADDR @E@@@@ LMJ MS )@@G@@ X11,FUNLBE . AND ERASE LOCAL VARIABLES, IF ANY@ @@@@ J XQ092MT )@@G@@0 . @C@@@@ LMJ X11,UNPEND . POP PREVIOUS STATE UP@ @@@@MU )@@G@@ J XQ0920 . @B@@@@ J XQ0700 . AND RESUMMV )@@G@@E IT @[@@@@. @G@@@@. ERROR DURING FUNC HEADER INITIALIZATION- SINCEMW )@@G@@ HEADERS SHOULD NOT BE @E@@@@. PRINTED, POP STATE TO CALLER BEFORE SIGNMX )@@G@@ALLING THE ERROR @[@@@@. @F@@@@XQ0470 LA A2,STVLXT . RECOVER TMY )@@G@@EXT POINTER FOR LINE ZERO @]@@@@ WSDUMP . @F@@@@ LMJ X11,FMZ )@@G@@UNCLR . BE SURE NO LOCALS ARE PARTIALLY CREATED@ @@@@ ER ERR$ NA )@@G@@ . @C@@@@ LMJ X11,UNPEND . POP STATEVECT UP @ @@@@NB )@@G@@ J XQ0920 . @ @@@@ J XQ0800 . @[@@@@NC )@@G@@. @G@@@@. FUNC INITIALIZATION-- SET UP STATE VECTOR PARAMETERS FOR FND )@@G@@UNCS. USED @G@@@@. BOTH WHEN ENTERING AND ALSO WHEN LEAVING (IN CASE PENE )@@G@@NDANT FUNC WAS @]@@@@. EDITED) @[@@@@. @]@@@@$(IBCOMN) @E@@@@NF )@@G@@XQ0480 LA A0,STVFNN . GET NAMEBLOK ADDR FROM STATEVECT @D@@@@ NG )@@G@@ ABSADR A0 . PREPARE TO EXAMINE NAMEBLOK@D@@@@ LA,H2 A1,1,NH )@@G@@A0 . GET DESCRIPTOR ADDR FROM IT@D@@@@ SA A1,STVFND . DESNI )@@G@@CR ADDR TO STATEVECT @E@@@@ ABSADR A1 . PREPARE TO EXAMNJ )@@G@@INE DESCRIPTOR @F@@@@ LA,S1 A0,0,A1 . JUST TO BE SAFE, GET NK )@@G@@THE BLOK TYPE @D@@@@ JNE,U A0,ZTPFUN 0 . IF NOT FUNC, SYSNL )@@G@@ERR @E@@@@ LA,H2 A0,1,A1 . GET ADDR OF LINENO TBL FROM DESCRNM )@@G@@@G@@@@ LA,U A0,1,A0 . STEP TABLE ADDR PAST 1ST (BLOK HEADER) NN )@@G@@WORD @F@@@@ SA A0,STVFTA . SAVE FUNC TABLE (LINE ZERO) ADDRENO )@@G@@SS @G@@@@ LA,H2 A0,0,A1 . FROM DESCR, GET NO OF LINES (INCLNP )@@G@@ LINE ZERO) @G@@@@ SA A0,STVFNL . SAVE LAST LINENO+1 FOR OUT NQ )@@G@@OF RANGE TESTS @C@@@@ J 0,X11 . RETURN TO CALLER NR )@@G@@@#@@@@ INSTRS . @[@@@@. @ @@@@XQ0490 ERROR YVALUE,XQ0800 . NS )@@G@@@ @@@@XQ0491 ERROR YDEPTH,XQ0860 . @[@@@@. @#@@@@ VARBLS . NT )@@G@@@F@@@@XQSTMN RES 1 . NEXT STMNT ($GN FROM KEYBOARD LEVEL) NU )@@G@@@#@@@@XQFNMB RES 1 . @^@@@@/. EVALUATED INPUT STATE@[@@@@. @#@@@@NV )@@G@@ INSTRS . @D@@@@XQ0500 NUSTAT,STEVAL XQ0730 . POST EVAL INPUT STNW )@@G@@ATE @ @@@@. GET INPUT LINE FROM TERMINAL@D@@@@XQ0510 PRINT 8,WSSFEI NX )@@G@@ . SOLICIT INPUT FROM USER @E@@@@ BRKCHK XQ0510 . SERVICE BNY )@@G@@REAK AND RETRY INPUT @B@@@@ ACCEPT XQ0250,XQ0550 XQ0820,XQ0720 NZ )@@G@@@ @@@@ COMPIL XQ0810 . @B@@@@. RUN (OR RESUME RUNNING) CURROA )@@G@@ENT STMNT @F@@@@XQ0520 RUN XQ0552,XQ0400,XQ0500,XQ0600 XQ0830,XQ0800OB )@@G@@,XQ0870 . @D@@@@ ERSCOD XQ0810 . GET RID OF COMPILED CODE OC )@@G@@@C@@@@ ANSTAK XQ0525 . PLACE RESULT IN STACK@D@@@@ ERSLEOD )@@G@@X XQ0820 . GET RID OF LEXICAL TEXT @F@@@@ LMJ X11,UNPEND OE )@@G@@ . RECOVER STMNT WHICH REQUESTED THE INPUT@ @@@@ J XQ0820 OF )@@G@@ . @D@@@@ J XQ0700 . RESUME POPPED UP STATE @F@@@@OG )@@G@@. RESULT NOT PROPERLY STACKED, SIGNAL VAL ERR IN CALLING STATE @F@@@@OH )@@G@@XQ0525 ERSLEX . GET RID OF PREVIOUS STATEMENT TEXT @D@@@@OI )@@G@@ LMJ X11,UNPEND . RECOVER PREVIOUS STATE @ @@@@ J OJ )@@G@@ XQ0820 . @ @@@@ ERROR YVALUE,XQ0800 . @#@@@@. ERROR CODEOK )@@G@@S @E@@@@XQ0550 ERROR YSYNTA,XQ0820 . EDIT CMND ON INPUTTED LINE OL )@@G@@@D@@@@XQ0552 ERROR YSYNTA,XQ0800 . GOTO DURING EXECUTION @[@@@@/. OM )@@G@@@^@@@@. UNQUOTE STATE--- @[@@@@. @#@@@@ INSTRS . @D@@@@ON )@@G@@XQ0600 SA A1,XQUQDT . SAVE DATA ADDR FOR LEXCAN @C@@@@ SA OO )@@G@@ A5,XQUQCT . SAVE CHARACTER COUNT @F@@@@ SA A6,XQUQDS . SAVOP )@@G@@E DESCRIPTOR ADDR FOR LATER ERASE @#@@@@ WSDUMP . @E@@@@ OQ )@@G@@ ATTCHK XQ0830 . IF USER HAS SIGNALED ATTN, ESCAPE@ @@@@ NUSTAOR )@@G@@T,STUNQU XQ0730 . @E@@@@ LA A0,XQUQDS . GET DESCR ADDR OF UNQOS )@@G@@UOTED STRING@D@@@@ SA A0,STVFNN . TREAT IT AS NEW FUNCNAME OT )@@G@@@B@@@@ LA A0,XQUQDT . GET DATA ADDR @C@@@@ LA A5,XQOU )@@G@@UQCT . GET CHARACTER COUNT @F@@@@ ACCUNQ XQ0630,XQ0630 XQ0820,XOV )@@G@@Q0720 . GET AND ANALYZE TEXT @B@@@@ COMPIL XQ0810 . COMPILE IOW )@@G@@T @B@@@@. RUN (OR RESUME RUNNING) CURRENT STMNT @F@@@@XQ0610 RUN OX )@@G@@ XQ0552,XQ0400,XQ0500,XQ0600 XQ0830,XQ0800,XQ0870 @E@@@@ ERSCOOY )@@G@@D XQ0920 . GET RID OF CODE FOR THIS STMNT @B@@@@ ANSTAK XQ06OZ )@@G@@15 . RECOVER ANSWER @C@@@@ ERSLEX XQ0920 . AND ALSO LEXICAPA )@@G@@L TEXT@F@@@@ LA A6,STVFNN . RECOVER DESCRADDR OF UNQUOTED STRPB )@@G@@ING @B@@@@ LMJ X11,ERASET . GET RID OF IT @ @@@@ J PC )@@G@@ XQ0800 . @F@@@@ LMJ X11,UNPEND . GO BACK TO STATE WHICPD )@@G@@H CALLED UNQUOTE @ @@@@ J XQ0920 . @D@@@@ J PE )@@G@@ XQ0700 . GO RESUME POPPED STATE @F@@@@. ERROR IN STAKPOP OF REPF )@@G@@SULT. SIGNAL VALUE ERR IN INVOKING STATE @C@@@@XQ0615 ERSLEX PG )@@G@@ . GET RID OF STMNT TEXT@D@@@@ LMJ X11,UNPEND . POP PRECEDING SPH )@@G@@TATE BACK UP@ @@@@ J XQ0800 . @ @@@@ ERROR YVALUPI )@@G@@E,XQ0800 . @ @@@@. SYSCMD OR EDIT CMND DETECTED@C@@@@XQ0630 LMJ X11,UPJ )@@G@@NPEND . RECOVER CALLING STATE@ @@@@ J XQ0920 . @D@@@@PK )@@G@@ ERROR YDOMAI,XQ0800 . POST DOMAIN ERROR @#@@@@ VARBLPL )@@G@@S . @ @@@@XQUQDT RES 1 . @#@@@@XQUQDS RES 1 . @B@@@@PM )@@G@@XQUQCT RES 1 . NO OF CHARS IN STRING @A@@@@/. STATE-CHANGING OPEPN )@@G@@RATIONS @D@@@@. RESUME EXECUTION OF A STATE WE HAVE POPPED UP PO )@@G@@@[@@@@. @#@@@@ INSTRS . @A@@@@XQ0700 LA A0,STVCUR . GETPP )@@G@@ STATE@D@@@@ COMJMP A0,XQ0920 STSUSP,XQ0120 STEVAL,XQ0520 ; @C@@@@PQ )@@G@@ STUNQU,XQ0610 STFUNX,XQ0450 .@[@@@@. @C@@@@. END PR )@@G@@FILE WITHOUT )OFF CARD. WIPE OUT THIS RUN@[@@@@. @G@@@@XQ0720 CALREPS )@@G@@P,SYSREP X11,SINOFF . SIGNOFF CODE IS IN COMMAND MODULE @ @@@@. NO SPT )@@G@@PACE FOR NEW STATEVECTOR@ @@@@XQ0730 ERROR YDEPTH,XQ0870 . @[@@@@. PU )@@G@@@[@@@@. @F@@@@/. EXECUTION SUSPENSION (ERRORS AND/OR BREAKS AND/OPV )@@G@@R SVCLEAR) @ @@@@. *** ERROR ENTRIES *** @A@@@@. PW )@@G@@ ***** XQT ERR @C@@@@XQ0800 SX X11,XQECHO . TURN ON ECHO FLAG PX )@@G@@@C@@@@ LA,U A0,0,X9 . CURRENT IC (ABSOLUTE)@F@@@@ ANA,UPY )@@G@@ A0,1 . ADJUST TO POINT TO LAST INSTR EXECUTED @D@@@@ RELADPZ )@@G@@R A0 . MAKE IT RELATIVE TO THE WS @G@@@@ SA A0,STVICT QA )@@G@@ . AND POST LOC N WHERE WE BUSTED IN STATEVECT @B@@@@ J XQ084QB )@@G@@0 . GO CLEAR STACK @B@@@@. ***** COMPILATION ERR QC )@@G@@@C@@@@XQ0810 SX X11,XQECHO . TURN ON ECHO FLAG @B@@@@ LOGERQD )@@G@@R . SEND ERROR MSG @C@@@@ ECHOS . PRINT THEQE )@@G@@ BAD STMNT @C@@@@ J XQ0850 . GO TEST FOR POPUP @A@@@@QF )@@G@@. ***** LEX ERR @C@@@@XQ0820 SX X11,XQECHO . TURQG )@@G@@N ON ECHO FLAG @A@@@@ LOGERR . SEND MSG @B@@@@ QH )@@G@@ J XQ0850 . GO START POPUP @C@@@@. **** BREAK (OR O-U-T) DQI )@@G@@URING STMNT XQT-- @C@@@@XQ0830 SZ XQECHO . TURN OF ECHO FLAG QJ )@@G@@@D@@@@. GET RID OF THE TRACES OF AN EXECUTING STATEMENT @D@@@@XQ0840QK )@@G@@ TNZ XQECHO . SHOULD WE ECHO THIS STMNT? @C@@@@ J XQ084QL )@@G@@5 . NO, GO CLEAR STACK @G@@@@ TZ CONSBR . HAS HE GOQM )@@G@@TTEN TIRED OF LOOKING AT THIS STUFF?@E@@@@ J XQ0845 . YESQN )@@G@@, FORGET ABOUT PRINTING IT @B@@@@ ECHOS . YES, DO IQO )@@G@@T @B@@@@XQ0845 PURGE . CLEAR STACK @D@@@@ ERSCOQP )@@G@@D . GET RID OF COMPILED CODE @ @@@@. CHECK WHETHER WE'RE DOQQ )@@G@@NE @C@@@@XQ0850 LA A0,STVCUR . GET CURRENT STATE @E@@@@ QR )@@G@@ JNE,U A0,STFUNX XQ0855 . IF NOT FUNC, GO SEE WHAT @C@@@@ TZ QS )@@G@@ XQECHO . IS ECHO FLAG OFF @G@@@@ J XQ0861 . NO,QT )@@G@@ ON. WE'RE DONE, GO ESTABLISH KBD MODE @F@@@@ TZ CONSBR QU )@@G@@ . DOES HE REALLY WANT TO SEE THIS STUFF? @E@@@@ J XQ0861 QV )@@G@@ . NO-- QUIT WITHOUT PRINTING IT @F@@@@XQ0853 ECHOL . YESQW )@@G@@, WE HAVEN'T ECHOED, SO SEND LINE NO@E@@@@ J XQ0861 . ANDQX )@@G@@ GO ESTABLISH KEYBOARD MODE @E@@@@XQ0855 ERSLEX . NOT FUNC,QY )@@G@@ SO ERASE LEXICAL TEXT @C@@@@ LA A0,STVCUR . GET CURRENT STAQZ )@@G@@TE @F@@@@ COMJMP A0,XQ0890 STSUSP,XQ0864 STEVAL,XQ0866 STUNQU,RA )@@G@@XQ0860@C@@@@. UNQUOTE- CAN'T STOP HERE, SO KEEP POPPING @ @@@@XQ0860RB )@@G@@ LMJ X11,UNPEND . @ @@@@ J XQ0890 . @ @@@@ RC )@@G@@ J XQ0840 . @[@@@@. @B@[@@XQ0861 LA A0,STVCUR . GETRD )@@G@@ STATE VECT @D@[@@ JNE,U A0,STFUNX XQ0862 IF NOT FUNC GO FINISH UPRE )@@G@@@ @[@@ LA A0,STVFND . @ @@][XQ0861 LA A0,STVFND . RF )@@G@@@ #@@@ ABSADR A0 . @C@@@@ TZ,S1 1,A0 . IS RG )@@G@@FUNCTION LOCKED? @G@@@@ J XQ0863 . YES- GO POP 1, CAN'T RH )@@G@@SUSP IN LOCKED FUNC @F@[@@XQ0862 SZ CONSBR . POPED UP INTO FRI )@@G@@UNC- CLEAR BREAK KEY @F@@][ SZ CONSBR . POPED UP INTO FRJ )@@G@@UNC- CLEAR BREAK KEY @F[@@@ SZ STVSTP . FOR GOOD LUCK, RK )@@G@@CLEAR STOP INDICATOR @F@@@@ J XQ0100 . AND GO PUSH SUSRL )@@G@@P MODE ON TOP OF FUNC @E@@@@XQ0863 PURGE . GET RID OF CURRRM )@@G@@ENT STATEMENT @ @@@@ ERSCOD . @E@@@@ LZPOSRN )@@G@@T . PREPARE TO XQT LINE 0 OF FUNC @D@@@@ LA A2,STRO )@@G@@VLXT . GET ADDR OF HDR LINE TEXT @E@@@@ LMJ X11,FUNCLR . GO RP )@@G@@CLEAR PUSHED DOWN VARIABLES @C@@@@ J XQ0890 . ERROR EXIRQ )@@G@@T - SYS ERR @C@@@@ LA A0,STVFTA . GET ADDR OF FUNCTABLE@D@@@@RR )@@G@@ LMJ X11,FUNLBE . ERASE ANY LOCAL LABELS @C@@@@ J RS )@@G@@ XQ0890 . ERROR EXIT - SYS ERR @ @@@@ LMJ X11,UNPEND . RT )@@G@@@C@@@@ J XQ0890 . ERROR EXIT - SYS ERR @E@[@@ J RU )@@G@@ XQ0861 . GO SEE WHAT WE HAVE UNCOVERED @E@@][ J XQ084RV )@@G@@5 . GO SEE WHAT WE HAVE UNCOVERED @E[@@@XQ0864 SZ CONSBR RW )@@G@@ . POPPED UP INTO SUSEPNDED STATE-- @B@@@@ J XQ0110 . GO RX )@@G@@RESUME IT @E@@@@XQ0866 SZ CONSBR . POPPED UP INTO EVAL INPUT SRY )@@G@@TATE @D@@@@ J XQ0510 . GO TRY AGAIN FOR INPUT @[@@@@RZ )@@G@@/. @A@@@@. ***** STATEVECTOR CLEAR OPN @E@@@@XQREST* SX X11,XSA )@@G@@QPEND . SAVE RETURN AND SET )RESET FLAG @ @@@@ SX X11,XQFPOP SB )@@G@@ . @ @@@@ J XQ0880 . @D@@@@XQ0870 SX X11,XQFPOP SC )@@G@@ . TURN ON '1ST TIME' FLAG @[@@@@. @D@@@@ SZ XQPEND SD )@@G@@ . SET FLAG TO DO $G CODE @E@@@@XQ0880 PURGE . GET RID OSE )@@G@@F CURRENT STATEMEMENT @ @@@@ ERSCOD . @B@@@@ SF )@@G@@ LA A0,STVCUR . CURRENT STATE @E@@@@ JE,U A0,STFUNX XQ0883 SG )@@G@@ . IF FUNCTION, GO POP @F@@@@ ERSLEX . ELSE GET SH )@@G@@RID OF LEXICALLY ANALYZED TEXT@C@@@@ LA A0,STVCUR . RECOVER CSI )@@G@@URRENT STATE@E@@@@ JNE,U A0,STSUSP XQ0883 . IF NOT KEYBOARD, GO POSJ )@@G@@P @D@@@@ TZ XQFPOP . KEYBOARD: IS THIS 1ST TIME?@E@@@@SK )@@G@@ TNZ STVCHN . NO, IS THERE A STATE UNDER THIS @A@@@@ SL )@@G@@ J XQ0888 . GET OUT @F@@@@XQ0883 JNE,U A0,STFUNX XQ0885 . IF NSM )@@G@@OT FUNC, GO ERASE LEXTEXT @F@@@@ LZPOST . ELSE PREPSN )@@G@@ARE TO XQT LINE 0 OF FUNC @E@@@@ LA A2,STVLXT . GET ADDR SO )@@G@@OF HEADER LINE TEXT @E@@@@ LMJ X11,FUNCLR . GO CLEAR PUSHEDSP )@@G@@ DOWN VARIABLES @ @@@@ J XQ0890 . @C@@@@ LA SQ )@@G@@ A0,STVFTA . GET ADDR OF FUNCTABLE@D@@@@ LMJ X11,FUNLBE . ERASR )@@G@@SE ANY LOCAL LABELS @ @@@@ J XQ0890 . @B@@@@ SS )@@G@@ J XQ0886 . CONTINUE POPUP @E@@@@XQ0885 ERSLEX . NOTST )@@G@@ FUNC, SO PURGE LEXICAL TEXT @^@@@@XQ0886 TNZ XQPEND @ @@@@ SU )@@G@@ SZ XQFPOP . @ @@@@ LMJ X11,UNPEND . @ @@@@ SV )@@G@@ J XQ0890 . @D@@@@ J XQ0880 . GO BACK AND KEESW )@@G@@P POPPING @C@@@@XQ0888 TNZ XQPEND . FINISH UP SEQUENCE @F@@@@SX )@@G@@ J XQ0110 . RESUME AT KEYBOARD LEVEL IN XQTSUP @ @@@@SY )@@G@@ LX X11,XQPEND . @D@@@@ J 1,X11 . RETURN TOSZ )@@G@@ SYSCMD )RESET @[@@@@. @ @[@@XQ0890 ERROR YSYSTM . @ @[@@TA )@@G@@ LOGERR . @ @[@@ ER ERR$ . @[@[@@TB )@@G@@/. @[@[@@. @F@[@@. AT THIS POINT, WE WILL CLEAR THE STACK, ERASE TC )@@G@@TEMPORARIES, ETC. @ @[@@XQ0900 J XQ0990 . @ @[@@XQ0920 ERRORTD )@@G@@ YSYSTM,XQ0910 . @D@[@@XQ0910 LMJ X11,ERRMSG . PRINT THE ERROR MESSTE )@@G@@AGE @[@[@@. @D@[@@XQ0990 J XQ0110 . CONTINUE IN SUSPENDEDTF )@@G@@ MODE @A@@[[XQ0890 EQU 0 . SYSERR @A@@[[XQ0920 EQU 0 TG )@@G@@ . SYSERR @[@@[[. @B@@[[. THIS IS WHERE WE GO DOWN THE TUBE.TH )@@G@@.. @[@@[[. @F@@[[XQ0999 LXI,U X11,SYSREP . TERMINATION CODETI )@@G@@ IS IN SYSTEM REP @D@@[[ LIJ X11,ERROFF . GO THERE AND DISTJ )@@G@@APPEAR@[@@[[. @#F@@@ VARBLS . @#@@@@XQLINK RES 1 . @#@@@@TK )@@G@@XQECHO RES 1 . @#@@@@XQFPOP RES 1 . @#@@@@XQPEND RES 1 . @F@@@@TL )@@G@@/. CLEAR STACK WITH IMPLIED PRINT (CALLED BY PROC ANSPRT, ABOVE)@[@@@@TM )@@G@@. @#@@@@ INSTRS . @ @@@@APRINT SX X11,APLINK . @ @@@@TN )@@G@@ SZ APPRNT . @D@@@@ LA A0,STVCUR . CURRENT ETO )@@G@@XECUTION STATE @C@@@@ TNE,U A0,STFUNX . EXECUTING A FUNCTION?TP )@@G@@@D@@@@ TNZ STVTRC . YES- IS TRACE FLAG ON? @F@@@@ TQ )@@G@@ J AP0010 . NO, DON'T BOTHER PRINTING FUNC NAME @C@@@@ TR )@@G@@ LMJ X11,LNFLSH . FLUSH THE BUFFER AND @B@@@@ SX X11,APPRNT TS )@@G@@ . MARK IT FLUSHED@E@@@@ ECHOLN . PUT LINENO IN BUF WITTT )@@G@@HOUT FLUSH @D@@@@ SZ STVTRC . MARK TRACE REQUEST SERVICEDTU )@@G@@@D@@@@ SZ,H1 STOFLG . TURN PRINT INHIBIT OFF @C@@@@AP0010TV )@@G@@ TNZ STVSTK . IS ANYTHING STACKED? @A@@@@ J AP0040 TW )@@G@@ . NO, EXIT @C@@@@AP0020 POP A6 . GET NEXT DATA ITEM @C@@@@TX )@@G@@ JZ A6,AP0020 . IF NULL, IGNORE IT @C@@@@ TEP,U A6,04TY )@@G@@00000 . IS STACKMARK BIT OFF?@E@@@@ J AP0030 . NO, GO EXTZ )@@G@@AMINE THIS STACKMARK @D@@@@ SA A6,APERAS . SAVE POINTER FOUA )@@G@@R ERASURE @E@@@@ TNZ,H1 STOFLG . IS PRINTING INHIBITED BY A UB )@@G@@STORE?@E@@@@ J AP0025 . NO, GO PRINT THE STACH CONTENTS UC )@@G@@@E@@@@ POP A5 . YES, PEEK UNDERNEATH THIS DATUM @E@@@@UD )@@G@@ PUSH A5 . BUT BE SURE IT STAYS STACKED @E@@@@ UE )@@G@@ TNE,U A5,SKMRHS . IS IT END OF STATEMENT MARKER? @E@@@@ J UF )@@G@@ AP0027 . YES, FORGET ABOUT PRINTING THIS @G@@@@ SZ,H1 STOFLUG )@@G@@G . NO DISABLE PRINT INHIBIT (PROBABLE SEMICOLON)@ @@@@AP0025 TNZ UH )@@G@@ APPRNT . @ @@@@ LMJ X11,LNFLSH . @D@@@@ SX UI )@@G@@ X11,APPRNT . MARK THE BUFFER FLUSHED @D@@@@ LMJ X11,PRNTDS UJ )@@G@@ . AND PRINT CURRENT DATUM @D@@@@ J AP0050 . OOPS, BREUK )@@G@@AK WHILE PRINTING @C@@@@AP0027 LA A6,APERAS . RECOVER DESCRIPTOR UL )@@G@@@ @@@@ LMJ X11,ERASET . @C@@@@ J XQ0890 . ERAUM )@@G@@SE ERR IS SYSERR @D@@@@ J AP0020 . GO BACK FOR NEXT DATUUN )@@G@@M @E@@@@AP0030 TE,U A6,SKMRHS . IS STACKMARK END OF STATEMENT? UO )@@G@@@B@@@@ J AP0020 . NO, IGNORE IT @D@@@@ SZ STVSTUP )@@G@@K . YES, SET STACK EMPTY FLAG @ @@@@AP0040 TZ APPRNT . UQ )@@G@@@C@[@@ LMJ X11,LINSTR . FLUSH OUTPUT BUFFER @C@@][ LMJ UR )@@G@@ X11,LINFRS . FLUSH OUTPUT BUFFER @ [@@@ LX,H2 X11,APLINK . US )@@G@@@C@@@@ J 1,X11 . AND TAKE NORMAL EXIT @D@@@@AP0050 LA UT )@@G@@ A6,APERAS . BREAK-- GET LAST DATUM @B@@@@ LMJ X11,ERASET UU )@@G@@ . GET RID OF IT @ @@@@ J XQ0890 . @D@@@@ PURGEUV )@@G@@ . CLEAR REMAINDER OF STACK @F@@@@ LMJ X11,LINITL UW )@@G@@ . FORCE BUF POINTERS TO EMPTY BUF STATE @ @@@@ LX X11,APLINK UX )@@G@@ . @C@@@@ J 0,X11 . TAKE EXIT FOR BREAK @#@@@@ UY )@@G@@ VARBLS . @#@@@@APLINK RES 1 . @ @@@@APPRNT EQUF APLINK,,H1 . UZ )@@G@@@#@@@@APERAS RES 1 . @E@@@@/. MANAGE INSTRUCTION COUNTER IN STMNTS OFVA )@@G@@ SIMULATED MACHINE@[@@@@. @A@@@@. LOAD IC VB )@@G@@@D@@@@$(IBCOMN) . IBANK COMMON, USED YB )CLEAR COMMAND @E@@@@ICLOADVC )@@G@@ LX X9,STVICT . CURRENT STATEVECTOR INSTR CTR @ @@@@ ABSADVD )@@G@@R X9 . @A@@@@ LXI,U X9,1 . SET STEP @D@@@@ VE )@@G@@ LX,U X8,IC0010 . AND POINTER FOR INST FETCH @ @@@@ J 1,X11VF )@@G@@ . @C@@@@. ACTUAL INSTRUCTION FETCHING IS DONE HERE-- @#@@@@VG )@@G@@ INSTRS . @A@@@@IC0010 LA,H2 A0,0,*X9 . NEXT INST@C@@@@ VH )@@G@@ JZ A0,IC0010 . IF NULL, SKIP IT @B@@@@ LMJ X8,0,X8 VI )@@G@@ . ELSE RETURN @ @@@@ J IC0010 . @#@@@@. SAVE INST VJ )@@G@@CTR---@ @@@@ICSAVE LA,U A0,0,X9 . @ @@@@ RELADR A0 VK )@@G@@ . @C@@@@ SA A0,STVICT . STASH IN STATEVECT @A@@@@ VL )@@G@@ J 1,X11 . RETURN @ @@@@/. ECHO LINES FOR SUSPENSION @#@@@@VM )@@G@@ INSTRS . @ @@@@ECHEAD SX,H2 X11,ECLINK . @C@@@@ LMJ VN )@@G@@ X11,LNFLSH . CLEAR OUT BUFFER @C@@@@ LA A0,STVCUR . GETVO )@@G@@ CURRENT STATE @F@@@@ JE,U A0,STFUNX EC0010 . IF FUNC EXECUTIOVP )@@G@@N, GO PRINT NAME @B@@@@ LA,U A1,ASPACE . ELSE GET BLANK @B@@@@VQ )@@G@@ DO 6 , LMJ X2,0,X2 . AND INDENT @ @@@@ J EC0020 VR )@@G@@ . @B@@@@EC0010 LA A6,STVFNN . NAMEBLOK ADDR @C@@@@ LMJ VS )@@G@@ X11,PRTNAM . CONVERT TO CHARACR @ @@@@ J *ECLINK . VT )@@G@@@C@@@@ LA,U A1,ALBRAK . OPENING LEFT BRACKET @C@@@@ LMJ VU )@@G@@ X2,0,X2 . DUMP INTO OUTBUF @E@@@@ DSL A0,72 . INIVV )@@G@@TIALIZE REGS FOR FORMAT RTNE @D@@@@ LA A4,STVSTN . GET CURREVW )@@G@@NT STATEMENT NO @B@@@@ DSL A4,36 . SIGN EXTEND IT @A@@@@VX )@@G@@ LMJ X11,FORMI . PRINT IT @ @@@@ J *ECLINK . VY )@@G@@@D@@@@ LA,U A1,ARBRAK . CLOSING RIGHT BRACKET @A@@@@ VZ )@@G@@ LMJ X2,0,X2 . PRINT IT @C@@@@ LA,U A1,ASPACE . GET TRAILWA )@@G@@ING SPACE @F@@@@ DO 2 , LMJ X2,0,X2 . AND FILL 2 IN CASE TRACE OUWB )@@G@@TPUT FOLLOWS@E@@@@EC0020 LMJ X11,LINSUS . POST CURRENT BUFFER POINTERWC )@@G@@S @ @@@@ LX,H2 X11,ECLINK . @B@@@@ J 1,X11 WD )@@G@@ . NORMAL EXIT @[@@@@. @ @@@@. ENTRY TO PRINT TEXT LINE-- @[@@@@WE )@@G@@. @ @@@@ECTEXT SX,H2 X11,ECLINK . @G@@@@ TNZ STVLXT WF )@@G@@ . IS THERE ANY LEXICAL TEXT TO BE PRINTED? @C@@@@ J EC010WG )@@G@@0 . NO, FORGET THIS STUFF@B@@@@ LA A0,STVCUR . CURRENT SWH )@@G@@TATE @G@@@@ JNE,U A0,STFUNX EC0030 . IF NOT EXECUTING A FUNC, GO WI )@@G@@PRINT IT @D@@@@ LA A0,STVFND . ELSE GET FUNC DESCR ADDR WJ )@@G@@@ @@@@ ABSADR A0 . @C@@@@ TZ,S1 1,A0 . IS WK )@@G@@FUNC UNLOCKED? @F@@@@ J EC0100 . NO, LOCKED-- EXIT WITWL )@@G@@HOUT PRINTING IT @E@@@@EC0030 LMJ X11,LINSUS . POST CURRENT LINE BUFWM )@@G@@ POINTERS @D@@@@ LA A2,STVLXT . GET ADDR OF LEXICAL TEXT WN )@@G@@@G@@@@ LA,U A1,0 . TURN OFF FLAG MARKING LOC IN TEXT OF ERWO )@@G@@ROR @G@@@@ TNZ STVCCL . IS THERE ANY COMPILED CODE LEAYINWP )@@G@@G AROUND? @E@@@@ J EC0050 . NO, WE CAN'T LOCATE THE ERRWQ )@@G@@OR @D@@@@ LA A1,STVICT . YES, GET INSTR COUNTER @D@@@@WR )@@G@@ JZ A1,EC0050 . IF NULL, DONWT MARK EITHER @F@@@@ ABSADWS )@@G@@R A1 . LOCATE THE COMPILDE WORD WE DIED ON @E@@@@ LA,H1WT )@@G@@ A1,0,A1 . AND GET LEXICAL ITEMNO FROM IT @F@@@@EC0050 LNA,U A4,1 WU )@@G@@ . POST FLAG INHIBITING ECHO OF LINE NUM @D@@@@ SZ A3 WV )@@G@@ . ZERO TO LABEL PRINT CONTROL@C@@@@ LMJ X11,LEKOWF . GO WW )@@G@@PRINT THE TEXT @ @@@@ J *ECLINK . @ @@@@EC0100 LX WX )@@G@@ X11,ECLINK . @B@@@@ J 1,X11 . NORMAL EXIT @#@@@@WY )@@G@@ VARCON . @]@@@@ECLINK +0 . @B@@@@/. MAKE STATES PENDANT AND WZ )@@G@@UN-PENDANT @[@@@@. @#@@@@ INSTRS . @ @@@@SUSPEN* SX X11,SXA )@@G@@PLINK . @C@@@@ LMJ X11,STKFLU . FLUSH STACK TO CORE @ @@@@XB )@@G@@ J SP0990 . @D@@@@ LMJ X11,ICSAVE . SAVE CURRXC )@@G@@ENT INSTR COUNTER @^@@@@ J SP0990 @G@@@@SP0010 ALLOCT,U WSXD )@@G@@SVSI SP0900 . GET SPACE TO PUSH DOWN OLD STAKBLOK @F@@@@ SA XE )@@G@@ A1,A2 . TEMP SAVE REL BLOK ADDR FOR CHAINING @C@@@@ ABSADXF )@@G@@R A1 . SET UP 'TO' ADDR @ @@@@ LXI,U A1,1 . XG )@@G@@@C@@@@ LA,U A0,WSTATE . SET UP 'FROM' ADDR @ @@@@ LXI,UXH )@@G@@ A0,1 . @ @@@@ LR,U R1,WSSVSI . @D@@@@ BT XI )@@G@@ A1,0,*A0 . MOVE OLD STAKBLOK TO WS @D@@@@ SA A2,STVCHN XJ )@@G@@ . STASH NEW CHAIN POINTER @E@@@@ SZ STVSTK . POST STACXK )@@G@@K EMPTY FOR THIS STATE @D@@@@ SZ STVICT . CLEAR INSTRUCTIXL )@@G@@ON COUNTER @D@@@@ SZ STVLXT . ADDRESS OF LEXICAL TEXT XM )@@G@@@E@@@@ SZ STVCCL . AND ADDRESS OF COMPILED CODE @G@@@@XN )@@G@@. ....... NOTE: BUT DON'T FARBLE WITH FUNCTION NESTING DEPTH COUNTER XO )@@G@@@ @@@@SP0100 LX X11,SPLINK . @B@@@@ J 1,X11 . NORXP )@@G@@MAL EXIT @A@@@@SP0900 ERROR YWSFUL,SP0990 . @[@@@@. @F@@@@XQ )@@G@@. ****** CODE BELOW IS I-BANK COMMON BECAUSE )SYS REP MAY USE IT @]@@@@XR )@@G@@$(IBCOMN) . @[@@@@. @D@@@@. WAKEUP PENDING PROCESSES (I.E. ONE-LXS )@@G@@EVEL POPUP) @C@@@@SVCLEA* SZ STVCHN . SET CLEAR INDICATOR @ @@@@XT )@@G@@UNPEND* SX X11,SPLINK . @C@@@@ LA A1,STVCHN . GET LAST XU )@@G@@BLOK POINTER@C@@@@ JZ A1,UP0020 . IF NONE, GO CLEAR @F@@@@XV )@@G@@UP0010 LA A0,A1 . OTHERWISE USE AS A 'FROM' ADDR FOR BT @E@@@@XW )@@G@@ ABSADR A0 . SET 'FROM' ADDR=ABS OF LAST BLOK @B@@@@ XX )@@G@@ LXI,U A0,1 . AND INCR=1 WD @^@@@@ J UP0030 @E@@@@XY )@@G@@UP0020 LA,U A0,A1 . SET TO XFER FROM REG WITHOUT INCR@E@@@@UP0030XZ )@@G@@ LA,U A2,WSTATE . SET 'TO' ADDR TO CURRENT BLOK @ @@@@ LXI,UYA )@@G@@ A2,1 . @C@@@@ LR,U R1,WSSVSI . NO OF WDS TO MOVE YB )@@G@@@F@@@@ BT A2,0,*A0 . MOVE FROM WS OR REG TO CURRENT STATE YC )@@G@@@C@@@@ JZ A1,UP0100 . IF WE CLEARED, EXIT @C@@@@UP0040 LA,U YD )@@G@@ A0,WSSVSI . ELSE GET BLOCK SIZE @D@@@@ FREE . ANDYE )@@G@@ RELEASE OLD STAKBLOK @B@@@@. CHECK FOR RESUMPTION OF PENDANT FUNC YF )@@G@@@C@@@@UP0050 LA A0,STVCUR . GET CURRENT STATE @E@@@@ TNE,UYG )@@G@@ A0,STFUNX . IS THIS FUNC EXECUTION MODE? @E@@@@ TZ STVCCYH )@@G@@L . YES, IS THERE COMPILED CODE? @F@@@@ J UP0090 YI )@@G@@ . DONE IF FUNC COULD NOT HAVE BEEN EDITED@F@@@@ LMJ X11,XQ0480 YJ )@@G@@ . OTHERWISE, RESET TABLES IN STATEVECTOR @[@@@@. @B@@@@UP0090 LMJ YK )@@G@@ X11,ICLOAD . RESTORE IC @ @@@@ J UP0990 . @B@@@@YL )@@G@@UP0100 LX X11,SPLINK . NORMAL EXIT @ @@@@ J 1,X11 YM )@@G@@ . @[@@@@. @]@@@@SP0990 . @B@@@@UP0990 LX X11,SPLINK . ERRYN )@@G@@OR EXIT @A@@@@ J 0,X11 . RETURN @[@@@@. @#@@@@YO )@@G@@ VARBLS . @#@@@@SPLINK RES 1 . @ @@@@ END YP )@@G@@ . ___@@@ SA A1,A2 . TEMP SAVE*[S@@@*SDFF*@ @@@@@HDG CYQ )@@G@@ULL EXTERNAL REFERENCES @#@@@@@CULL,IWX ASM/72 @#@@@@ PROC AXR$ RES I$YR )@@G@@@ @@@@@HDG CULL ALL REFERENCES @#@@@@@CULL,I ASM/72 @#@@@@ PROCYS )@@G@@ AXR$ RES I$@E@@@@ INSTRS CONSTS VARBLS VARCON JNGD JE JNE JG JNG JLE JOYT )@@G@@P JEP @F@@@@ TSC LTSC TSL LTSL TSTO TLD TSA DTG DTLE WSDEF PSUDOP SKMARYU )@@G@@X @[@@@@@HDG ___@@@*[S@@@*SDFF*@G@@@@$: TEST DATA USING WORKSPACE 1YV )@@G@@ ADVANCEDEX (FROM BACK OF APL/360 MANUAL) @^@@@@ )LOAD 1 ADVANCEDEX YW )@@G@@@]@@@@ )FNS @]@@@@ )VARS @#@@@@ DESCRIBE @]@@@@ DYX )@@G@@PACK @#@@@@ $FPACK["]$F @#@@@@ $FUNPACK["]$F@ @@@@ +P$SPACYY )@@G@@K 2314 7 17 68 @#@@@@ UNPACK P @ @@@@ UNPACK PACK 2311 9 YZ )@@G@@21 72 @ @@@@ PACK UNPACK 92137142 @#@@@@ PACK 1 1 31 1@#@@@@ZA )@@G@@ UNPACK 3000 @]@@@@ DHILB @#@@@@ $FHILB["]$F @]@@@@ HZB )@@G@@ILB 3 @]@@@@ DINV @#@@@@ $FINV["]$F @#@@@@ $FINVP["]$F ZC )@@G@@@^@@@@ +N$SINV M $S HILB 3@]@@@@ M+.#N @]@@@@ )CLEAR ___@@@ZD )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*[S@@@*SDFF*@A@@@@ ZE )@@G@@ WHENEVER X.GE.R/2,N=N+R @]@@@@ )CLEAR @E@@@@ WHENEVEZF )@@G@@R X(0).NE.0.,XLOG=.434*ELOG.(.ABS.X(0)) @C@@@@ 02 FILLER PIZG )@@G@@CTURE X(8) VALUE SPACE. @G@@@@ WHENEVER X(NDATA).NE.0., XNLOG=ZH )@@G@@.434*ELOG.(.ABS.X(NDATA)) @[@@@@GO @#@@@@007146 02 SE @#@@@@ZI )@@G@@ N=H*R @^@@@@ 374 27 16 32@ @@@@ 5470 IF Y2 = 26 TZJ )@@G@@HEN 5440 @E@@@@ 02 AS PICTURE X(14) VALUE 'ACCOUNT STATUSZK )@@G@@'. @I@@@@020030 02 ITIMEX PICTURE 9(6). ZL )@@G@@ M6300280 @#@@@@ AXR$ @ @@@@ GO TO BZM )@@G@@LOCK-6. @I@@@@060190 MOVE IETIMEX TO IETIME. ZN )@@G@@ M6301020 @A@@@@ CALL GEN(LX,0,WREG,0,WREG) ZO )@@G@@@E@@@@ IF ACT-EXP LESS THAN BUD-ALLOW GO TO BLOCK-5. @#@@@@ZP )@@G@@ ANMB=NOIN-2 @I@@@@040200 02 ILTIME USAGE COMPUTATIONAL SYNCHROZQ )@@G@@NIZED RIGHT M6300740 @I@@@@060200 MOVE IUTIMEX TO IUTZR )@@G@@IME. M6301030 @ @@@@ WRITE ZS )@@G@@(F1,N,NFACTORIAL)$@I@@@@001060 SOURCE-COMPUTER. IBM-7094. ZT )@@G@@ PROBLEM2 @^@@@@ 589 36 10 27@B@@@@ZU )@@G@@27 ADDR(CODE(B1)) = ORIGIN + I + 1 @I@@@@002200 MOVE GRTST-NOZV )@@G@@ TO DIS-1. PROBLEM2 @H@@@@010050ZW )@@G@@ OBJECT-COMPUTER. UNIVAC-1108. UNIVACZX )@@G@@@E@@@@ SUBTRACT TOT-UNDER FROM TOT-OVER GIVING DIFF. @I@@@@ZY )@@G@@060250 RETURN VIA 'READR'. ZZ )@@G@@M6301090 @^@@@@ 631 35 12 29@A@@@@ V2=359.*((W2/28.8)AA )@@G@@+(W4/18.8)) @G@@@@ DISPLAY ' AB )@@G@@ ' UPON SYSOU1.@]@@@@ I=I+1 @A@@@@ CALL GEN(LX,0,WREG,REL,0AC )@@G@@) @#@@@@ X=N-H*R@E@@@@C CHECK FOR SUBSCRIPTED VARIABLES WAD )@@G@@ITH SIMPLE CONSTANT OR @^@@@@ D'N A(131) @^@@@@ LIB FORMAE )@@G@@ATSCANNR*Z. @#@@@@$F INITIALIZE @#@@@@DO $S 'X1DO $S B' @G@@@@ AF )@@G@@ DISPLAY 'NET EXCESS OF ACTUAL OVER BUDGET (MINUS SIGN INDICAT@ @@@@AG )@@G@@ 5070 REM NO SPECIAL SITUATION@^@@@@ + 0 @#@@@@DFREN AH )@@G@@ 2BUTOR @ @@@@ + W$,0,0 @H@@@@DGEOG411 1HISTORICAI )@@G@@AL GEOGRAPHY OF NORTH AMERICA AFTER 1800 (03) (P-F) /129/ @]@@@@$COMPIAJ )@@G@@LE MAD@D@@@@ BLOCK-3A. COMPUTE RUN-OVER = BUD-ALLOW * 0. @C@@@@AK )@@G@@ COMPUTE RUN-UNDER = ACT-EXP * 0. @#@@@@ GO TO 200 AL )@@G@@@A@@@@ EXTERNAL FUNCTION (N,R) @I@@@@060230 MOVE IRESTX TAM )@@G@@O IREST. M6301060 @C@@@@ OUT: AN )@@G@@ WRITE ('N= ',I,'N FACTORIAL= ',NFACT) @ @@@@ W'R .NOT. C(1AO )@@G@@3) @D@@@@ 02 FILLER PICTURE X(6). @D@@@@AP )@@G@@ 02 ACCT-NUM PICTURE X(5). @#@@@@A $S 2 2 2 $AQ )@@G@@R $I 8@#@@@@$IBJOB GO @A@@@@ WORKING-STORAGE SECTION. AR )@@G@@@I@@@@030040 02 IRESTO PICTURE X(8). AS )@@G@@ M6300540 @ @@@@ DATA IN/1H@,13*1H / @^@@@@ DIMENSAT )@@G@@ION PKT(3) @#@@@@ 00000 @#@@@@ 2750J @#@@@@ AU )@@G@@ 63482 @#@@@@ 37519 @#@@@@G98453505034000 @^@@@@ 393AV )@@G@@ 23 13 34@ @@@@ DATA PKT/0,17K6,62K6/ @^@@@@ DIMENSAW )@@G@@ION OUT(3) @B@@@@ DATA OUT/6HENTER ,6HSTATEM,6HENT /@G@@@@ AX )@@G@@ VECTOR VALUES BLUR2=$ S30, 8HXBAR IS ,F12.6,S40,8HYBAR IS , @^@@@@AY )@@G@@ 1 F12.6//*$@E@@@@ CALL GEN(J,0,0,0,UA1) @INDIRECT JUMPAZ )@@G@@ THRU LABEL TABLE @ @@@@ 66 0 0 0 0@ @@@@ 50 0BA )@@G@@ 0 0 0@ @@@@ 46 0 0 0 0@I@@@@002040 77 NBB )@@G@@O-OF-NOS PICTURE 99, VALUE ZERO. PROBLEM2 BC )@@G@@@I@@@@002050 77 SUM-OF-NOS PICTURE S99999V99, VALUE ZERO. BD )@@G@@ PROBLEM2 @A@@@@ MOVE TOT-OVER TO DIS. @B@@@@ 5030 BE )@@G@@LET A1 = R0(I1,A1) @FROM TABLE @A@@@@ COMMON/G2/TOKEN,PROD,CONBF )@@G@@SCT @ @@@@ 5480 IF Y2 <> 27 THEN 5510 @C@@@@ 02 FILLER BG )@@G@@ PICTURE X(5). @G@@@@PROBLM 1 3 4 2 0 0 0 2 2 2 BH )@@G@@ 1@I@@@@002010 WORKING-STORAGE SECTION. BI )@@G@@ PROBLEM2 @I@@@@002030 77 LEAST-NBJ )@@G@@O PICTURE S999V99, VALUE ZERO. PROBLEM2 @A@@@@BK )@@G@@ X$DUMP ECSAV6,7,'O','XAR' @I@@@@002060 77 MEAN-OF-NOS PICTUBL )@@G@@RE S999V99, VALUE ZERO. PROBLEM2 @B@@@@ JGBM )@@G@@D EA3,L($-3) . @D@@@@ SSC A1,1 BN )@@G@@ . SHIFT PATTERN @A@@@@ FLD(18,18,PKT(2))=LOC(OUT) @E@@@@ BO )@@G@@ THROUGH A10, FOR VALUES OF I=2,3,5,7,11,13,17,19 @A@@@@A10 CBP )@@G@@(I)=MOD.(CNTRL,I).NE.0 @A@@@@ C(8)=MOD.(CNTRL,23).NE.0 @[@@@@BQ )@@G@@$F SIM@[@@@@'HI!' @ @@@@CGEOG411 HIST GEOG OF N AMER @A@@@@ FLD(18BR )@@G@@,18,PKT(3))=LOC(IN(2)) @C@@@@ WHENEVER Y(I).L. YSMALL, YSMALLBS )@@G@@=Y(I) @]@@@@2 1 $R ' ' @]@@@@INITIALIZE @I@@@@040110 02 CODE2 USAGBT )@@G@@E COMPUTATIONAL SYNCHRONIZED RIGHT PICTURE 9. M6300650 @D@@@@ BU )@@G@@ J L(LOOP) . DO IT AGAIN @F@@@@SUBPRO 2 BV )@@G@@ YES YES YES @#@@@@'WHICH ONE$Q' BW )@@G@@@E@@@@7.560000E+00 0.0000 2.016294E+010.002940E+001.260000E+01@I@@@@BX )@@G@@003200 CLOSE DATA-FILE-1. STOP RUN. BY )@@G@@PROBLEM2 @B@@@@EA0 EQU 108 . @A@@@@ BZ )@@G@@ LABEL RECORD OMITTED. @I@@@@002141 ADD 1 TO NO-OF-NOS. CA )@@G@@ PROBLEM2 @ @@@@ CALL PLOTC(1CB )@@G@@.0,0.0,-3) @B@@@@ CALL RECT(1.0,0.0,5.0,2.0,32.0) @B@@@@ CC )@@G@@CALL PAR( 1.0,0.0,5.,.25,32.0,8) @ @@@@ CALL PLOTC(10.0,5.0,-3) CD )@@G@@@#@@@@100 BIG=0.0 @^@@@@ DO 150 I=1,NPLT @E@@@@ FILE-CE )@@G@@CONTROL. SELECT TRANS-FILE ASSIGN TO SYSIN1. @C@@@@ MOVE SPCF )@@G@@ACE TO ACCT-ANALYSIS-WORK. @I@@@@003060 DISPLAY ' ' UPON SYSCG )@@G@@OU1. PROBLEM2 @E@@@@ SUBROUTINE GCH )@@G@@VESZE(REF,NPLT,NSECT,XMAX,XMIN,SCALE) @#@@@@ N'R @^@@@@CI )@@G@@MEMPAR LSL EA3 @#@@@@ GO TO 21 @]@@@@AGAIN:RESET @[@@@@CJ )@@G@@DOIT @C@@@@ WHENEVER Y(I).G. YLARGE, YLARGE=Y(I)@A@@@@ CK )@@G@@ MOVE DIFF TO PCT-UNDER. @A@@@@ MOVE ZERO TO PCT-OVER. CL )@@G@@@^@@@@ WRITE-TOTALS. @C@@@@ CLOSE TRANS-FILE, BUDGET-CM )@@G@@ANALYSIS. @B@@@@ IF(TCODE(TRIP).EQ.63) SUBPT =SUBPT-1@^@@@@ CN )@@G@@ DATA DIVISION. @^@@@@ FILE SECTION. @^@@@@ END-ROUTINECO )@@G@@. @]@@@@'X3: ';X3I @I@@@@020040 02 ICTIMEX PICTURECP )@@G@@ 9(5). M6300290 @ @@@@ END OF CONDITCQ )@@G@@IONAL @I@@@@020150 01 OUTREC. CR )@@G@@ M6300400 @B@@@@ PERFORM ACT-UNDER-BGT-ROUTINECS )@@G@@@G@@@@ ELSE MOVE SPACE TO ACCOUNT-STATUS, MOVE ZERO TO PCT-OVECT )@@G@@R, @^@@@@ YLARGE=Y(0) @C@@@@ THROUGH ORDER, FOR CU )@@G@@I=0,1,I.GE.NDATA @H@@@@005056 02 CCC PICTURE X. CV )@@G@@ 000169@G@@@@ 77 TOT-OVER CW )@@G@@ PICTURE 99999V99 VALUE ZERO. @B@@@@150 IF(XREF(I,2).GT.BIG) BICX )@@G@@G=XREF(I,2) @^@@@@ 5 B(J)=ZT(J)+ZTA @A@@@@ X=XREF(I,J)+DEL*FLCY )@@G@@OAT(I-1) @B@@@@ WRITE(6,151) (B(J),C(J),J=1,KP) @^@@@@ CZ )@@G@@ F2=FUNC2(X,G) @A@@@@ WHENEVER X(I).G.X(I+1) @ @@@@ DA )@@G@@ ENVIRONMENT DIVISION. @I@@@@070110 MOVE IDME TO IDMEO. DB )@@G@@ M6301200 @D@@@@ THROUGH ORDERDC )@@G@@, FOR Z=0,1,Z.G.NDATA.OR.CHECK@^@@@@END: 'HOW MANY YEARS' @#@@@@ENDDOIDD )@@G@@T: $: OUTPUT@E@@@@1 9 $R ' T ','Y1 ','Y2 ','Y3 ','Y4 ','X1 ','X2 ','X3 'DE )@@G@@,'X4 '@[@@@@*END @#@@@@ [HDG,J,K,1]& @B@@@@ SUBROUTINE NWPLTRDF )@@G@@(XREF,NPLT,NUMPLT)@[@@@@*. @[@@@@*. @I@@@@ TZE *+2 DG )@@G@@ .719.GWB @I@@@@ DH )@@G@@ TPL OUT1 .719.GDI )@@G@@WB @I@@@@ TZE OUT1+2 DJ )@@G@@ .719.GWB @I@@@@ CLA I DK )@@G@@ .719.GWB @[@@@@OUT @I@@@@ LXA DL )@@G@@ J,2 .719.GWB DM )@@G@@@I@@@@ CLA HOLD,2 DN )@@G@@ .719.GWB @I@@@@ TMI BACK2 DO )@@G@@ .719.GWB @I@@@@ TSX SWITCH,4 DP )@@G@@ .719.GWB @^@@@@ LDDQ )@@G@@SL A0,6@F@@@@C-- BACK COUNT IS THE NUMBER OF BLOCKS-1 THAT THE VARIDR )@@G@@ABLE IS @B@@@@$G C4 #$I((($EINP[2])<1) $O(($EINP[2])>4))@^@@@@CHANGEDS )@@G@@[1] $S INP[1] @A@@@@$GINY#$I($A/'YES'=(3^INP,' ')) @]@@@@'TRY ADT )@@G@@GAIN' @[@@@@$G TOP@[@@@@T $S 1@]@@@@*EDIT OFF @[@@@@*LOOP @[@@@@$(1). DU )@@G@@@ @@@@ END OF CONDITIONAL @[@@@@*LOOP @^@@@@*PROCESS PROCESS ADV )@@G@@LG @[@@@@$F @G@@@@15060 DATA 6,5,4,1,-2,-2,2600,-3,-2,-4,-3,-5,-5,DW )@@G@@-7,-7704,2702,-5,-2107 @[@@@@*. @ @@@@ W'R .NOT. FLAG1 DX )@@G@@@[@@@@*SDFF*@#@@@@*DEFINE PROCESS @^@@@@TGEOG411 0101MULLER @B@@@@DY )@@G@@ T'H BLACK, FOR I=0,1,I.G. NDATA@E@@@@*. GENERATE FIELDS TO BEDZ )@@G@@ USED ON PROCESSOR CALL CARDS FOR @ @@@@ DS A0,*0,X11 EA )@@G@@@#@@@@LABEL C'E @I@@@@ TTR OUT1+2 EB )@@G@@ .719.GWB @[@@@@START.@#@@@@PRINT CEC )@@G@@'E @G@@@@ILLEGAL CHARACTER TO LEFT OF POSSIBLE IDENTIFIER OR NUMBER (ED )@@G@@ERROR 6) @I@@@@OUT2 CLA =1 EE )@@G@@ .719.GWB @I@@@@ TTR *+3 EF )@@G@@ .719.GWB @[@@@@*LOOP @I@@@@20 EG )@@G@@WRITE (6,200) M63016EH )@@G@@20 @I@@@@ CLA I EI )@@G@@ .719.GWB @F@@@@ BLOCK-1. OPEN INPUT TRANS-FILE, OUTEJ )@@G@@PUT BUDGET-ANALYSIS. @#@@@@ *** & @F@@@@15110 DATA 29,11,1EK )@@G@@7,8,12,2606,9,5,7,3,1,2,7714,2704,14,13,10,9 @G@@@@15120 DATA 2607,6,EL )@@G@@5,1,0,2,2600,-3,-1,-4,-3,-5,-4,-7,-6,2705,2199,-2102 @I@@@@BACK3 CLA EM )@@G@@ I .719.GWB EN )@@G@@@I@@@@ PAX ,1 EO )@@G@@ .719.GWB @I@@@@STA3 STO ,1 EP )@@G@@ .719.GWB @^@@@@STRING CHAR(80),C(1); @I@@@@EQ )@@G@@ ADD =1 ER )@@G@@.719.GWB @^@@@@N + 0 @#@@@@QUAL GETCHR @E@@@@ES )@@G@@ COMMON/G4/CURBLK,CHKBLK,VAR1,VAR2,CON1,C0N2,LAB1,LAB2 @ @@@@200 ET )@@G@@CALL PLOTC(X,-11.0,-3) @ @@@@ IF(NAX.LT.2) GO TO 200 @F@@@@ 3 01EU )@@G@@ 01 01 01 01 03 04 05 08 10 11 12 13 14 15 @F@@@@ EV )@@G@@ WHENEVER .ABS. (XPOS-X(I)).L.XGR2.OR.XPOS-X(I).E.XGR2 @ @@@@ EW )@@G@@ PRINT COMMENT $1$ @B@@@@ PRINT COMMENT $ X EX )@@G@@@#@@@@ 1 F(X)$@B@@@@ WRITE(6,151) (B(J),W(J),C(J),J=U,KP)EY )@@G@@@ @@@@ ER PRINT$ @B@@@@ I REPRESENTS ANY LEGAEZ )@@G@@L IDENTIFIER@A@@@@ 1.155 E+04 2.29 E+01 @B@@@@ WFA )@@G@@HENEVER C(3), TRANSFER TO A1 @G@@@@C THE PREVIOUSLY DECODES COFB )@@G@@MMAND CARD. IF THE CALUE OF NA IS @[@@@@C @C@@@@ COMPUTEFC )@@G@@ RUN-OVER = BUD-ALLOW * 0. @G@@@@ DISPLAY ' FD )@@G@@ ' UPON SYSOU1.@^@@@@ 5160 PRINT 'FUMBLE...' @C@@@@FE )@@G@@ FD TRANS-FILE DATA RECORD TRANS-RCD @^@@@@ REGTOP=REGTOFF )@@G@@P+1 @D@@@@ 01 ACCT-ANALYSIS PICTURE X(132). @D@@@@FG )@@G@@ SELECT BUDGET-ANALYSIS ASSIGN TO SYSOU1. @^@@@@ DATA FH )@@G@@DIVISION. @D@@@@C-- IS THE LINE NUMBER IN WHICH THE ITEM APPEARS. FI )@@G@@@[@@@@C @]@@@@CONTINUE @^@@@@ REQUEST COM,PKT @ @@@@ 5330 FJ )@@G@@GOSUB 12500 @TIME @^@@@@15040 REM 5 MAN, 0-69 @D@@@@ BUFFK )@@G@@FER OUT(IDT,1) LLINE(1,K),LLINE(LEN+1,J) @C@@@@ 02 FILLER PIFL )@@G@@CTURE X(4) VALUE SPACES.@D@@@@ 02 ACT PICTURE X(7) VALUE 'ACFM )@@G@@T EXP'. @I@@@@003110 DISPLAY 'THE GREATEST NUMBER IS ' DIS-1 UPFN )@@G@@ON SYSOU1. PROBLEM2 @#@@@@ B1 = I-1 @C@@@@ 0FO )@@G@@2 FILLER PICTURE X(4) VALUE SPACE. @]@@@@ P=0.0 @A@@@@ 5260 IF ABSFP )@@G@@(Y2) <> 27 THEN 5300 @#@@@@ REQUEST EXIT@E@@@@ SUBTRACFQ )@@G@@T ACT-EXP FROM BUD-ALLOW GIVING RUN-UNDER.@G@@@@ COMPUTE PCT-UFR )@@G@@NDER ROUNDED = ((BUD-ALLOW - ACT-EXP) / BUD- @F@@@@ CALL SPLNCP(FS )@@G@@NDATA,N3,XLN,YDATA,XJLN,NCEND,XTX,XTY,ERR,E,W) @ @@@@ ENVIRONMENTFT )@@G@@ DIVISION. @G@@@@ 77 TOT-UNDER PICTURE 99999V9FU )@@G@@9 VALUE ZERO. @]@@@@ END @B@@@@ L A3,EA0 FV )@@G@@ . @A@@@@ 91 FORMAT (3X,F4.1,F10.6,/6) @]@@@@'Y1: Y1I FW )@@G@@@D@@@@ S A1,0,A3 . FILL UP CORE @[@@@@$G FX )@@G@@@]@@@@'X4: ';X4I @]@@@@ END @]@@@@'Y2 ';Y2I @[@@@@$G R4 @G@@@@FY )@@G@@15240 DATA 4,3,2,-1,0,-1,0,-2602,-4,-6,-5,-7,-7,-8,7702,2703,-2105,-2206FZ )@@G@@@[@@@@C @^@@@@ WRITE (3,100)IN @^@@@@100 FORMAT (14A6) GA )@@G@@@F@@@@ DISPLAY 'TOTAL BUDGET ALLOWANCE, ' DIS-B UPON SYSOU1. GB )@@G@@@^@@@@ 1 LABTBL(MXLABS) @C@@@@ 5050 GOSUB 13500 @ PRINT YARDAGGC )@@G@@E RESULT @#@@@@ WSDUMP . @I@@@@050040 PICTURE 9(5). GD )@@G@@ M6300810 @^@@@@ CGE )@@G@@HECK=1B @ @@@@ 0 0- 32 0 0@ @@@@ 72 0 0GF )@@G@@ 0 0@#@@@@ C(4)=0B@ @@@@ YBAR=YBAR/10.P.YLOGGG )@@G@@@ @@@@ 0- 32 0 0 0@#@@@@ C(6)=1B@E@@@@ GH )@@G@@ WHENEVER MULT .E.0 .OR. NDATA.E.0.OR. CNTRL.E.0 @#@@@@R3:'EXPRESSIGI )@@G@@ONS$Q'@E@@@@ PRINT COMMENT $ EMPLOT. NOT CALLED CORRECTLY $ GJ )@@G@@@ @@@@ 106 0 0 0 0@#@@@@ ENDFILE 3 @ @@@@ 62GK )@@G@@ 0 0 0 0@I@@@@070100 MOVE UNAME TO UNAMEO. GL )@@G@@ M6301190 @ @@@@ 74 0 0 0GM )@@G@@ 0@B@@@@150 IF(XREF(I,2).GT.BIG) BIG=XREF(I,2) @ @@@@ FGN )@@G@@UNCTION RETURN @ @@@@ LI$T . @^@@@@ CGO )@@G@@HECK=0B @ @@@@ 5060 IF Y2 <> 0 THEN 5120 @]@@@@ IBIT=0@#@@@@GP )@@G@@ REGTOP=28 @D@@@@C TEMPORARY CODE TO PRINT OUT GENERATED CODE INGQ )@@G@@ OCTAL@^@@@@ DEF(OPN(X)) @I@@@@003070 DISPLAY ' ' UPGR )@@G@@ON SYSOU1. PROBLEM2 @I@@@@003080 DGS )@@G@@ISPLAY ' ' UPON SYSOU1. PROBLEM2 GT )@@G@@@I@@@@003090 DISPLAY 'THE NUMBER OF NUMBERS IS ' DIS-3 UPON SYSOU1.GU )@@G@@ PROBLEM2 @I@@@@003100 DISPLAY ' ' UPON SYSOU1. GV )@@G@@ PROBLEM2 @[@@@@C @I@@@@020220 02 ICTIGW )@@G@@MEO PICTURE 9(5). M6300470 @ @@@@GX )@@G@@ L,U A0,WEF @#@@@@ C(6)=0B@ @@@@ 5450 IF R3 GY )@@G@@= 2 THEN 11500 @I@@@@003030 ' ISM 101 - PROBLEM 2 ' UPON SGZ )@@G@@YSOU1. PROBLEM2 @^@@@@ FILE SECTION. @#@@@@HA )@@G@@ ENDFILE 3 @A@@@@ REQUEST CSF,'@ADD 3. . ' @ @@@@ 102HB )@@G@@ 0 0 0 0@^@@@@ ER IOW$@ @@@@ 50 0HC )@@G@@ 0 0 0@#@@@@ WSDUMP . @B@@@@ 5020 LET A1 = R1(T,A1) HD )@@G@@@ FROM RUNNER @#@@@@ XLOG=0 @#@@@@105 FORMAT(K @ @@@@HE )@@G@@ END OF CONDITIONAL @#@@@@ 5460 GO TO 1000 @ @@@@ 0HF )@@G@@00091800018000 @#@@@@CONDEL1111211 @^@@@@ 569 37 14 30HG )@@G@@@^@@@@ 376 27 16 34@#@@@@YI $S 20 20 20 20 @I@@@@070090 MHH )@@G@@OVE CODE1 TO CODE1O. M6301180 HI )@@G@@@^@@@@ SUBROUTINE CHG @C@@@@ CALL MVECR (LA(K),1,IA(J),1,IBHJ )@@G@@UFR(NWORD)) @]@@@@1 0 1 \$I2 @A@@@@ DEFINE FFIELD=FLD(0,6,CODE(I))HK )@@G@@@A@@@@ DEFINE JFIELD=FLD(6,4,CODE(I))@E@@@@0.004450E+00 0.0000 HL )@@G@@1.063870E+011.063425E+01 0.0000 @]@@@@'ANYMORE$Q' @#@@@@$G R3 # $I(IHM )@@G@@NPUT) @[@@@@$F @]@@@@$F RESET;INP@C@@@@R1:'DO YOU WANT TO SEE ANYTHINHN )@@G@@G$Q (YES OR NO)' @#@@@@$G R2 # $I(INPUT) @#@@@@'INITIAL VALUES' @F@@@@HO )@@G@@ DIMENSION RAN(40),DECK(60,6),PLAY(10),X(15),Y(10),SUM(10) @D@@@@HP )@@G@@ TG A0,A1 . DO WE STAY IN THIS BLOCK ?@I@@@@020240 0HQ )@@G@@2 ILTIMEO PICTURE 9(5). M6300490 HR )@@G@@@ @@@@ 000071600006000 @ @@@@ 000081700005000 HS )@@G@@@#@@@@ IFIELD=IBIT @B@@@@ L A2,0235 . HT )@@G@@@#@@@@ XNLOG=0@#@@@@ YLOG=0 @#@@@@ 5210 LET I1 = 4 HU )@@G@@@I@@@@020230 02 IATIMEO PICTURE 9(5). HV )@@G@@ M6300480 @ @@@@ ER EXIT$ @[@@@@C @I@@@@HW )@@G@@070190 MOVE ITTIME TO ITTIMEO. HX )@@G@@M6301280 @#@@@@ CCCCEFCSFSS@#@@@@$IBJOB GO @#@@@@ HY )@@G@@HFIELD=HBIT @^@@@@ A(I)=A(I+1) @D@@@@ 02 BUD-ALLOWHZ )@@G@@ PICTURE 999V99.@ @@@@ END OF CONDITIONAL @#@@@@IA )@@G@@ 5150 REM FUMBLE @ @@@@ INPUT-OUTPUT SECTION. @I@@@@060170 MIB )@@G@@OVE IATIMEX TO IATIME. M6301000 IC )@@G@@@^@@@@$F DOIT;COUNT;DTEMP @]@@@@COUNT $S 1 @B@@@@LOOP: OUT[COUNT;] ID )@@G@@$S T,(,Y[T;]),(,X[T;]) @B@@@@ VECTOR VALUES PAGEUP=$ 1H1 * $ IE )@@G@@@^@@@@S4 CONTINUE @#@@@@G55553050026050 @^@@@@ 546 30IF )@@G@@ 10 27@]@@@@DT $S 1 @#@@@@ E'L @^@@@@XI $S 20 100IG )@@G@@ 80 100 @]@@@@Y3 $S Y3I @^@@@@ 563 20 14 34@I@@@@010110IH )@@G@@ DATA DIVISION. M63001II )@@G@@50 @I@@@@080090 COMPUTE INDEX = SWITCH1 - TEST1. IJ )@@G@@ M6301430 @[@@@@C @^@@@@S9 CONTINUE @ @@@@IK )@@G@@ 91 FORMAT (3X,F4.1,4X,FU @^@@@@OUT 'BOOTAPE' @C@@@@006102IL )@@G@@ 02 BSEQ-NO PICTUEE @^@@@@006100 02 BSDC-NO IM )@@G@@@D@@@@007010 03 MAX-SETS PICTURE 9(3). @A@@@@ 20 IN )@@G@@CALL SQUARE(0.0,0.0,3.0,P) @E@@@@ 77 DIS IO )@@G@@ PICTURE --,--9.99. @B@@@@006020 LABEL REOCRDS ARE STANDARD IP )@@G@@@#@@@@'INPUT YES OR NO' @C@@@@ THROUGH LOOP, FOR A=0,1,I*9.G.3IQ )@@G@@60 @A@@@@ X(A)=((9*I*6.28318)/360) @E@@@@C-- THIS SUBROUTINIR )@@G@@E CHANGES A TERMINAL INTO A FORM WHICH IS @#@@@@ 5001J @#@@@@IS )@@G@@ 73214 @I@@@@001120 FD DATA-FILE-1 LABEL RECORDS OMITTED DATIT )@@G@@A RECORD IS NO-RCD. PROBLEM2 @I@@@@060110 MOVE CODE2X TO CODEIU )@@G@@2. M6300940 @D@@@@15140 DATA 9IV )@@G@@9,6,13,4,9,3,7,3,5,2,0,1,2711,2,10,9,8,7 @ @@@@140 FORMAT('1 ERROR 1IW )@@G@@') @ @@@@ CONFIGURATION SECTION. @#@@@@ N'R @B@@@@IX )@@G@@ Y(A)=COS.((9*I*6.28318)/360) @#@@@@ E'L @I@@@@IY )@@G@@ PAX ,2 IZ )@@G@@.719.GWB @D@@@@#I=(((((I+N)*((I*N+N)/N)+(I+N)*N)/N)+(I/N))+I*I)# JA )@@G@@@]@@@@Y2I$S 20 @^@@@@ RECOGNIZE := FALSE;@[@@@@*END @]@@@@*IF [QJB )@@G@@]>0 @]@@@@*SET S TO 1 @[@@@@$F SIM@[@@@@'HI!' @I@@@@070140 MOVE ICJC )@@G@@TIME TO ICTIMEO. M6301230 @I@@@@JD )@@G@@ SUB HOLD JE )@@G@@.719.GWB @I@@@@ TZE *+2 JF )@@G@@ .719.GWB @I@@@@ TPL BACK5 JG )@@G@@ .719.GWB @B@@@@ IF(TCODE(TRIJH )@@G@@P).EQ.31) GO TO 402 @^@@@@RPAREN := OPERS[5,1]; @^@@@@BRACKET := OJI )@@G@@PERS[6,1]; @A@@@@START: READ(INPUT,CHAR,DONE,DONE); @]@@@@ )CLEAR JJ )@@G@@@#@@@@ )SYMBOLS 500 @A@@@@ 10 CALL PAR2(0.0,P,0.6,0.2,Q) @E@@@@JK )@@G@@*. IF TEXT SUPPLIED ( [HDG]>0 ) IT IS ADDED BY THE LOOP @A@@@@*. @DOJL )@@G@@C,SDF DOC/VERSION,DOC/VERSION @#@@@@ E'L @[@@@@$I 0 @[@@@@JM )@@G@@$I 0 @H@@@@DGEOG372 1INTERPRETATION OF TOPOGRAPHIC MAPS AND AERIAL PHOTJN )@@G@@OGRAPHS (03) (P-F)@I@@@@070210 MOVE IREST TO IRESTO. JO )@@G@@ M6301300 @I@@@@020070 02 IETIMEX JP )@@G@@ PICTURE 9(5). M6300320 @D@@@@ J JQ )@@G@@ 0,X2 . KEEP GOING @I@@@@ CLA HOLD,2 JR )@@G@@ .719.GWB @I@@@@ JS )@@G@@ SUB HOLD,1 .719.GJT )@@G@@WB @[@@@@$F @G@@@@1 JU )@@G@@ 6 30@F@@@@C-- VARIABLE, 35 = UNDECLARED VARIABLE, 33JV )@@G@@ = LABEL REFERENCE, @ @@@@ 77 0 0 0 0@^@@@@*. PDPJW )@@G@@ PDP,L ELT VER @^@@@@*. DOC DOC,SDF ELT1 @F@@@@ E; CJX )@@G@@OMMENT COMING FROM THE RIGHT, WE HIT 'E' FIRST; @#@@@@ GO TO RETURN;JY )@@G@@@ @@@@ 56 0 0 0 0@#@@@@ FND: END; @^@@@@PROCEDJZ )@@G@@URE IDENTIFIER; @I@@@@060130 MOVE IDMEX TO IDME. KA )@@G@@ M6300960 @[@@@@B $S 5@I@@@@ TMI BACKB )@@G@@K6 .719.GWB @I@@@@KC )@@G@@ TZE BACK6 KD )@@G@@.719.GWB @ @@@@#I=I+(I*I-I*N/I+((I+N)-I))# @#@@@@*IF [[#1],I,3]>0 KE )@@G@@@#@@@@/[[#1],I,3,1]& @]@@@@'X3: ';X3DO@]@@@@$F CONTINUE @F@@@@ KF )@@G@@ MOVE SPACE TO ACCOUNT-STATUS, PCT-OVER, PCT-UNDER. @^@@@@ KG )@@G@@ X(I+1)=HOLD @]@@@@$F DOIT @#@@@@ 6040 GO TO 5040 @[@@@@C KH )@@G@@@E@@@@0.330000E+00 0.0000 3.895354E+010.623540E+003.800000E+01@]@@@@KI )@@G@@ LIB U/ @^@@@@ 409 26 16 36@[@@@@C @]@@@@#I+N*I# KJ )@@G@@@#@@@@#I=(I+I)(I/N)# @F@@@@ DISPLAY 'ACTUAL EXPENSES INCURRKK )@@G@@ED, ' DIS-A UPON SYSOU1.@D@@@@007020 03 SEARS-TAKEN PIKL )@@G@@CTURE 9(3). @I@@@@ TSX SWITCH,4 KM )@@G@@ .719.GWB @I@@@@ TTR BACK6 KN )@@G@@ .719.GWB @^@@@@ 577 40 13KO )@@G@@ 35@^@@@@ 5010 LET A1 = ROLL2 @E@@@@ LSSL A1,18 KP )@@G@@ . AND PUT IT THERE @#@@@@B84542750025000 @#@@@@100 BIG=0.KQ )@@G@@0 @]@@@@X1 $S X1I @I@@@@RETURN AXT ,4 KR )@@G@@ .719.GWB @I@@@@ TRA 1,4 KS )@@G@@ .719.GWB @]@@@@ KT )@@G@@RETURN@ @@@@ AOK: RECOGNIZE := TRUE; @^@@@@ CHAR := CHAR + 1; KU )@@G@@@]@@@@'X4: ';X4DO@D@@@@DELETE ALPHABET *LETTER/'1'* = /F(BEGINKV )@@G@@) @A@@@@ SUBROUTINE GOT(TRIP,WREG) @^@@@@ TEMP=TEKW )@@G@@MP-5 @^@@@@ 574 27 16 36@^@@@@ 387 30 15 35@]@@@@KX )@@G@@RETURN: END;@D@@@@FORMAT REJECT(S80,A1,' IS AN ILLEGAL STRING',A1.1); KY )@@G@@@F@@@@FORMAT ACCEPT(S80,A1,' IS ACCEPTED AS A VALID STRING.',A1.1); KZ )@@G@@@I@@@@SWITCH CAL HOLD,1 LA )@@G@@ .719.GWB @I@@@@080180 XXX. STOP RUN. LB )@@G@@ M6301520 @D@@@@005094 02 P-BATCH -NO LC )@@G@@ PICTURE 9(3). @H@@@@ 91 FORMAT (3X,F4.1,F10.6,/6/3X,F4.1,4XLD )@@G@@,F10.6/3X,F4.1,4X,F10.6/3X,F4.1, @ @@@@ CHANGE=CHANGE-5 LE )@@G@@@I@@@@ LDQ HOLD,2 LF )@@G@@ .719.GWB @I@@@@ STQ HOLD,1 LG )@@G@@ .719.GWB @E@@@@ CALL GEN (LX,0,X2,0,X4) LH )@@G@@@X2 PTS TO NEW CURRENT BLK @D@@@@ 02 FILLER LI )@@G@@ PICTURE X(74). @D@@@@ FD BUDGET-ANALYSIS DATA RECORD ACCT-ANALLJ )@@G@@YSIS @ @@@@ TNW A7,A1 @^@@@@ VALUE N; INTEGER N;LK )@@G@@@ @@@@ THE GRAMMAR: @I@@@@ SLW HOLD,2 LL )@@G@@ .719.GWB @^@@@@ LM )@@G@@S ::= #V=E# @E@@@@ BLOCK-4. MOVE 'ACTUAL OVER BUDGET' TO ACCOUNT-SLN )@@G@@TATUS.@F@@@@ PRI = SPAN('(') $LPAR *****$('EXP' N) SPAN(')') $RPLO )@@G@@AR @I@@@@STA4 CLA ,2 LP )@@G@@ .719.GWB @I@@@@STA5 LDQ ,1 LQ )@@G@@ .719.GWB @I@@@@STA6 STO ,1 LR )@@G@@ .719.GWB @I@@@@STA7 LS )@@G@@ STQ ,2 .719.GLT )@@G@@WB @B@@@@ PRINT FORMAT BLUR2, XBAR, YBAR @I@@@@ CLA LU )@@G@@ HOLD,1 .719.GWB LV )@@G@@@I@@@@ TMI OUT3 LW )@@G@@ .719.GWB @#@@@@ J=J+1 @A@@@@ MARGIN=MARGINLX )@@G@@+CHANGE @I@@@@020090 02 ITTIMEX PICTURE 9(5). LY )@@G@@ M6300340 @[@@@@*. @^@@@@ T'O READ LZ )@@G@@@I@@@@ CLA I MA )@@G@@ .719.GWB @I@@@@ TRA 1,4 MB )@@G@@ .719.GWB @I@@@@ END MC )@@G@@ .719.GWB @I@@@@ TTR MD )@@G@@ *+2 .719.GWB ME )@@G@@@I@@@@BACK4 CLA J MF )@@G@@ .719.GWB @#@@@@ E'M @]@@@@'Y1: ';Y1DO@#@@@@ MG )@@G@@ ELSE BEGIN@[@@@@EXIT: @]@@@@ I=I+1 @E@@@@COMMENT FUNCTION TO IMH )@@G@@DENTIFY VARIABLE NAMES AND NUMBERS. @]@@@@ J := 0; @F@@@@ FOR I := 1MI )@@G@@,1,1,1,1,0,0,0,0,0,0,0,0,0,0 DO BEGIN J := J + 1; @^@@@@LPAREN := OPMJ )@@G@@ERS[7,1]; @D@@@@ TERMINAL[J] := IF I EQL 1 THEN FALSE ELSE TRUE; END;MK )@@G@@@^@@@@EQUAL := OPERS[8,1]; @^@@@@POINT := OPERS[9,1]; @]@@@@ J :=ML )@@G@@ 0; @[@@@@*. @]@@@@ R @G@@@@ W'R WORD(0).E.$ORWHMM )@@G@@EN$.OR.(WORD(0).A.MASK).E.$O'R@@@$.OR. @F@@@@ WHENEVER YSMAMN )@@G@@LL.NE.0., YLOG=.434*ELOG.(.ABS.YSMALL) @G@@@@ 77 ACT-TOT MO )@@G@@ PICTURE 99999V99 VALUE ZERO. @E@@@@ CALL GEN(ANXMP )@@G@@,U,X4,BLKREF(OFFSET(TRIPLE(NEXT,2))),0) @ @@@@ TYPE := 'SVETPIN+-*/()MQ )@@G@@=#'; @D@@@@ 02 PCT-UNDER PICTURE ZZ9.99.@C@@@@MR )@@G@@NEW ALPHABET *LETTER/'1'* = /F(NEXT)@F@@@@*CREATE SGS: PRC EMS )@@G@@LT,L ASM,S COB,SBE RALPH,S ALG,S MAP,S DOC,SF ; @^@@@@MINUS := OPERS[1,1MT )@@G@@]; @[@@@@#N=I# @A@@@@ ELT,L ELT,L PDP,L PDP,CL PDP,FL @G@@@@ FOR MU )@@G@@I := 15,2,14,3,15,6,4,8,9,5,10,11,6,7,12,3,13 DO BEGIN J := J + 1;@C@@@@MV )@@G@@ $LETTER ANCHOR() '0' /S(NEW) @]@@@@ END;@#@@@@MW )@@G@@ GO TO START; @]@@@@$ SNOBOL @G@@@@START SAVE = 'ABCDEFGHIJKLMNOMX )@@G@@PQRSTUVWXYZ=,$.(*)/0123456789+- ' QUOTE @ @@@@ OSG = '+'/'-'/NULMY )@@G@@L @#@@@@$G R3 # $I(INPUT) @]@@@@$COMPILE MAD@D@@@@READ READ FOMZ )@@G@@RMAT $(72A1)*$,CARD(0)...CARD(71) @#@@@@SHIFT C'E @]@@@@Y2 $S NA )@@G@@Y2I @[@@@@*. @#@@@@ 45445 @ @@@@ PARAMETER MXVARS =NB )@@G@@ 100 @ @@@@ W'R CARD(10).E.$R$ @A@@@@ 1.2850 E+04 2.7NC )@@G@@9 E+01 @C@@@@ W'R .NOT. C(17) .AND. I .NE. 101 @B@@@@ND )@@G@@ THROUGH ST3, FOR J=0,1,J.G.I @^@@@@ST3 ROW(J)=CHAR NE )@@G@@@A@@@@ WHENEVER MOD.(Z,5).E.0 @ @@@@ 5170 IF Y2 < 0 THEN 535NF )@@G@@0 @D@@@@ A(2,8)=-XOLD(3)-XOLD(4)-2.*XOLS(5)+2./XOLD(7) @A@@@@NG )@@G@@ .50E+02 .10E+01 .200E+03@#@@@@ E'L @B@@@@ NH )@@G@@ THROUGH S2, FOR Z=0,1,Z.G.M50 @ @@@@ IF(Y.EQ.X(I))GO TO 1 NI )@@G@@@^@@@@$G NEXT1 # $I(INPUT) @]@@@@'X1: ';X1I @E@@@@ DIMENSION DENJ )@@G@@CK(52), DDK(52), PH(6,7), HPC(14) SPC(14),@A@@@@ X$DUMP ECSAV6,7,'NK )@@G@@O','XAR' @#@@@@W99882101017070 @F@@@@15030 DATA 8,7,6,2,-1,-1,0,-26NL )@@G@@02,-1,-3,-2,-4,-3,-6,7703,-2,-4,2218@#@@@@Y1DO $S 'T+19' @#@@@@ NM )@@G@@ 1768Q @ @@@@ 000202800023000 @I@@@@002145 MOVE NONN )@@G@@-1 TO GRTST-NO. MOVE NO-1 TO LEAST-NO. PROBLEM2 @#@@@@NO )@@G@@ 5390 LET I1 = 4 @ @@@@ READ (6,2) X(I),I=1,N) @G@@@@'TYPE IN XI[NP )@@G@@N] OR YI[N], WHERE N IS THE ONE YOU WANT; OR A, B OR DT' @#@@@@R4:INPNQ )@@G@@ $S $E $" @#@@@@ 52211 @A@@@@ SOURCE-COMPUTER. IBM-70NR )@@G@@94. @ @@@@ DO 300 III=1,IRESET @I@@@@002120 PROCEDURE DIVISIONS )@@G@@N. PROBLEM2 @I@@@@002130NT )@@G@@ PAR-1. OPEN INPUT DATA-FILE-1. PROBLENU )@@G@@M2 @]@@@@NEXT: $I 0 @[@@@@$F @E@@@@ IF ACT-EXP GREATER NV )@@G@@THAN BUD-ALLOW GO TO BLOCK-4. @I@@@@002140 PAR-2. READ DATA-FILE-1 AT ENW )@@G@@ND GO TO PAR-9. PROBLEM2 @A@@@@ OBJECT-COMPNX )@@G@@UTER. IBM-7094. @ @@@@ 200 WRITE (6,300) F(Y) @[@@@@C @[@@@@NY )@@G@@$I2 @I@@@@070010 P4. ENTER COBOL. NZ )@@G@@ M6301100 @C@@@@ IF C EQL DIVIDE OR C EQL TIMES THEN BEOA )@@G@@GIN @#@@@@ C(4)=1B@ @@@@ XBAR=XBAR/10.P.XLOG@A@@@@OB )@@G@@ XGRID=XGRID/10.P.XLOG @ @@@@ END OF CONDITIONAL OC )@@G@@@F@@@@ EXECUTE EMPLOT.(X,Y,40,XGRID,YGRID,XBAR,YBAR,1,1155) OD )@@G@@@F@@@@15020 DATA 32,13,2621,10,15,8,12,6,9,4,2,3,18,6,25,2614,11,10 OE )@@G@@@A@@@@ PRINT RESULTS X(A),Y(A) @ @@@@ 0000615000220OF )@@G@@00 @A@@@@ YHI = YBAR + 50.*YGRID @A@@@@ YLO = YOG )@@G@@BAR - 50.*YGRID @C@@@@ THROUGH LIMIT,FOR I=0,1, I.G. NDATA OH )@@G@@@E@@@@ SUBROUTINE GVESZE(REF,NPLT,NSECT,XMAX,XMIN,SCALE) @^@@@@OI )@@G@@ WRITE (6,11) [ @ @@@@ CALL PLOTC(6.0,-11.0,-3)@ @@@@ 5440 OJ )@@G@@GOSUB 12500 @TIME @ @@@@ CALL PLOTC(0,0,999) @B@@@@ OK )@@G@@ AAIJ L($+1) . @ @@@@ CONFIGURATION SECTION. OL )@@G@@@A@@@@ XPOS = XBAR-XGRID*(M25-Z)@[@@@@RE @G@@@@ AOM )@@G@@LLOW * 100, ON SIZE ERROR DISPLAY 'OVERFLOW UPON SYSOU1. @D@@@@ ON )@@G@@ PRINT FORMAT MKLINE,XPOS,ROW...ROW(100) @]@@@@'X2: ';X2I @#@@@@OO )@@G@@T16161005015550 @[@@@@C @E@@@@ SUBROUTINE XAXIS(XSCALE,XREF,YOP )@@G@@REF,NPLT,NAX,NSIDE) @I@@@@002190 PAR-7. COMPUTE MEAN-OF-NOS = SUM-OOQ )@@G@@F-NOS / NO-OF-NOS. PROBLEM2 @^@@@@ 521 44 14 26OR )@@G@@@#@@@@ FETCH; @^@@@@ DIMENSION IN(14) @^@@@@FORMAT INPUTOS )@@G@@(A1,S80); @]@@@@ACCEPT: END;@]@@@@PROCEDURE E;@]@@@@GO TO SET; @C@@@@OT )@@G@@ BOOLEAN ARRAY TERMINAL(1:15), STRUCT(1:17); @#@@@@ PROCEDURE V; OU )@@G@@@ @@@@ 000152300014000 @ @@@@ 000162400012000 OV )@@G@@@^@@@@Y2DO $S '50 $L X2 % X4' @F@@@@ EXECUTE EMPLOT.(X,Y,40,XGOW )@@G@@RID,YGRID,XBAR,YBAR,2,1155) @G@@@@ IF NOT OPERATOR THEN ERROR(6); COX )@@G@@OMMENT IS THIS THING TERMINATED BY @ @@@@SOURCE := SUCCESSOR[SOURCE]; OY )@@G@@@ @@@@ CALL PLOTC(0.0,0.5,-3) @]@@@@ P=0.0 @A@@@@ MOZ )@@G@@OVE ZEROES TO PCT OVER. @#@@@@ Y3=S+Y2 @E@@@@ ANA,U A0,3 PA )@@G@@ . ASSUME LAST ENTRY IN SAME BLOCK @A@@@@ AINDX=( X -AMIN)/PB )@@G@@(AMAX-AMIN) @^@@@@ DIMENSION R(1000) @^@@@@ CALL BEGIN(R) PC )@@G@@@C@@@@COMMENT FUNCTION TO FIT E::= E+T \ E-T \ T; @I@@@@060040 PPD )@@G@@ROVIDE IPRONO, CODE1, CODE2, UNAME, IDME, IDATE, ITIME, M6300870 PE )@@G@@@ @@@@ INDX=AINDX*ANMB+2.5 @C@@@@ WHENEVER.NOTPF )@@G@@.C(13) , T'O S5 @E@@@@0.241000E+00 0.0000 1.643949E+000.002949E+00PG )@@G@@1.400000E+00@B@@@@IGNORE LPS L(PSR) . @ @@@@ PH )@@G@@IF (NO.GT.2) GO TO 23 @B@@@@ JADDR((2)= NWORDS-JADDR(1)*LSECT+1 PI )@@G@@@#@@@@ 5080 LET B=B + Y1@ @@@@ 5090 IF R3 = 1 THEN 1000 @ @@@@ 30 PJ )@@G@@CALL PLOTC(X3,Y3,2) @^@@@@ 50 CALL PLOTC(W,Z,3) @]@@@@ RETURNPK )@@G@@@E@@@@END RES 02000-$ . FILL OUT BOOT BLOCK @[@@@@PL )@@G@@$(0). @^@@@@ OTHERWISE @[@@@@$CBEND@[@@@@$DATA @I@@@@070050PM )@@G@@ IATIME, ILTIME, IETIME, IUTIME, ITTIME, JOBNO, IREST. M63011PN )@@G@@40 @F@@@@ 20 FORMAT 637X,'@ S.T.P.',5X,'@ OUTLET TEMP',12X,'WT 0/0'PO )@@G@@,//) @E@@@@ SUBTRACT ACT-EXP FROM BUD-ALLOW GIVING DIFF. PP )@@G@@@C@@@@ 1 18HY GRID SIZE IS F12.6/ *$ @ @@@@ DDELT PQ )@@G@@ A4 4 4 @^@@@@ST5 ROW(J)=CHAR @[@@@@C @[@@@@C PR )@@G@@@#@@@@ START=0@]@@@@ BEGIN @^@@@@ IDENTIFIER; PS )@@G@@@^@@@@ 1FUNCTION$ @I@@@@070200 MOVE JOBNO TO JOBNOO. PT )@@G@@ M6301290 @A@@@@ 5180 REM OFFENSIVPU )@@G@@E TEAM RECOVERS @^@@@@Y3DO $S ' .25 # X3' @^@@@@ 617 34 12PV )@@G@@ 27@^@@@@ 533 39 12 27@B@@@@ 5190 PRINT 'PICKED UP BY '; NPW )@@G@@(T); ' FOR';@I@@@@040010 WORKING-STORAGE SECTION. PX )@@G@@ M6300550 @B@@@@ 133 242 382 PY )@@G@@ 497 @#@@@@ X=BIG+6.0 @E@@@@ COMPUTE TOT-UNDER ROUNDEDPZ )@@G@@ = TOT-UNDER + DIFF. @]@@@@GO TO SET; @D@@@@ COMPUTE DIFF QA )@@G@@= DIFF / BUD-ALLOW * 100. @ @@@@ B = SPAN(' ') / NULL @A@@@@QB )@@G@@ YGRID=YGRID/10.P.YLOG @^@@@@ 5200 LET B = B + Y1 @]@@@@QC )@@G@@$F RESET @#@@@@ GO TO 410 @B@@@@'DO YOU WANT TO SEE THE INITIAQD )@@G@@L VALUES $Q'@G@@@@ DIMENSION SCALE(NPLT,2),XRATE(NPLT),REF(NPLT,3),QE )@@G@@DIG(100),X(200) @ @@@@ WRITE(O,ERRORS[ABS(N)]); @C@@@@ ANA,UQF )@@G@@ A1,1 . NO, SO GET BKWRD LINK@ @@@@C DBDS=(BETA-PBTA)/DS QG )@@G@@@C@@@@XDO[2;] $S 'A# (DT%B) #(+/Y[1;T-B+$I10],10 $R0)'@I@@@@020250 0QH )@@G@@2 IETIMEO PICTURE 9(5). M6300500 QI )@@G@@@F@@@@ 3 10 10 10 20 20 20 10 QJ )@@G@@@A@@@@ AA(75,17)=AA(75,17)*60.*24. @D@@@@ 02 ACTUAL QK )@@G@@ PICTURE $$$$.99. @^@@@@LOOP:Y1N $S $E Y1DO @E@@@@6.8300QL )@@G@@00E+021.402353E+036.906834E+020.003400E+007.680000E+00@B@@@@D WRITE(QM )@@G@@6,1234) (CODE(II),II=0,TRPTOP)@E@@@@ 77 ED-OVER QN )@@G@@ PICTURE $ZZ,ZZZ.99. @^@@@@ UPON SYSOU1. @F@@@@ AA,U QO )@@G@@ A1,2 . COMPUTE FIRST ENTRY FOR THIS BLOCK @B@@@@ 1 EQ( QP )@@G@@SIZE(LPAR), SIZE(RPAR) )/ SOR @ @@@@ 1 ROW(XLOG) .E. CHAR@#@@@@QQ )@@G@@ GO TO 200 @I@@@@020020 02 IDATEX PICTURE 9(6).QR )@@G@@ M6300270 @#@@@@100 CONTINUE @]@@@@Y4 $S QS )@@G@@Y4I @G@@@@ DISPLAY ' ' QT )@@G@@UPON SYSOU1.@[@@@@$F @ @@@@ 70 0 0 0 0@D@@@@NEXT: QU )@@G@@IF RECOGNIZE(LOOKFOR[GOAL]) THEN GO TO TEST; @]@@@@X4 $S X4I @D@@@@QV )@@G@@TAST: IF ALTERNATE[SOURCE] EQL 0 THEN GO TO POP2; @F@@@@ 5.015391 QW )@@G@@3.650046 0.908 1.345 0.546554 0.386@[@@@@C @A@@@@QX )@@G@@ .50E+02 .10E+01 .200E+03@B@@@@C THE FOLLOWING IS A TABLR GIVQY )@@G@@ING THE @C@@@@IF ALTERNATE[SOURCE] EQL -1 THEN GO TO POP3; @]@@@@QZ )@@G@@Y1 $S Y1I @G@@@@ 0.173 1.10 0.500 0.03 0.14 RA )@@G@@ 0.165 @B@@@@XDO[3;] $S'X[3;T-1]+DT#(Y[2;T]-Y[3;T])' @#@@@@RB )@@G@@ STRING TYPE(15);@E@@@@ 0.00569+00 0.0000 3.38072+00 3.37503+00RC )@@G@@ 0.000 @I@@@@ IF (I1 . EQ. 99999999) GO TO 20 RD )@@G@@ M6301600 @^@@@@ YLARLG=0 @B@@@@ RE )@@G@@ T'H FILL,FOR I=1,1,I.G.76K @E@@@@ RF )@@G@@ A LEGAL CHARACTER?; @B@@@@C IF STACK IS EMTY AND NOT ALL RG )@@G@@OF THE@I@@@@C THE TREE IN SY SYMMETRIC ORDER; THE ROOT OF THE TREE GRH )@@G@@OES NEAR THE THE RIG @]@@@@ Q=0.0 @]@@@@ T; @B@@@@ RI )@@G@@ DO 0400-$ , LMJ X1,L(IGNORE) @C@@@@START LPS L(PSR) RJ )@@G@@ . SET PSR @^@@@@ 30 FORMAT (F3.0) @I@@@@060160 MOVE ICRK )@@G@@TIMEX TO ICTIME. M6300990 @ @@@@RL )@@G@@ 000011100001000001 @ @@@@ 000021100008000 @#@@@@RM )@@G@@ 8399L @^@@@@ GO TO ACCEPT; @F@@@@ INTEGER ARRAY LORN )@@G@@OKFOR(1:15), TYPECODE(1:17),SUCCESSOR(1:17); @E@@@@ST2 THROUGHRO )@@G@@ ST2, FOR I=0,1,I.G.100.OR.ROW(I).E.CHAR @A@@@@ INTEGER ARRAY ALTERNATRP )@@G@@E(1:17); @#@@@@ EX0 = BAL @]@@@@ N = 0@I@@@@200 FORMATRQ )@@G@@ (17H0EXIT WAS CALLED.) M6301650 RR )@@G@@@I@@@@070130 MOVE ITIME TO ITIMEO. RS )@@G@@ M6301220 @D@@@@ S A2,1,A0 . MEM 1 FART )@@G@@ULT @F@@@@ 20 FORMAT (57X,'@ S.T.P.',3X,'@ OUTLET TEMP',7X,'WT 0/0',RU )@@G@@//) @B@@@@ XHI = XBAR + MULT*25.*XGRID @B@@@@ XRV )@@G@@LO = XBAR - MULT*25.*XGRID @B@@@@ DIMENSION REF(NPLT,3),SCALE(NPRW )@@G@@LT,2) @G@@@@ DIMENSION AX(NR,NC),AY(NR,NC),NP(NC),XSCALE(NC,2),YSCRX )@@G@@ALE(NC,2) @C@@@@ 02 FILLER PICTURE X(7) VALUE SPACE. @A@@@@RY )@@G@@C DEFINE INTERNAL SUBROUTINE GOT @#@@@@1 0 1 0 / $I4 @^@@@@ 436RZ )@@G@@ 35 16 36@#@@@@ J= J+NWORDA @]@@@@ 2 10 @F@@@@ SA )@@G@@SUBROUTINE PLOTER(AX,AY,NP,NR,NC,XSCALE,YSCALE,XREF,YREF,F) @^@@@@SOURCESB )@@G@@ := LOOKFOR[GOAL];@[@@@@END; @]@@@@ACCEPT: @]@@@@PROCEDURE T;@C@@@@SC )@@G@@COMMENT FUNCTION TO FIT T ::= T*P \ T/P \ P ;@[@@@@BEGIN @E@@@@ P;SD )@@G@@ COMMENT MUST HAVE AT LEAST THE THIRD ALTERNATE; @^@@@@ DSE )@@G@@'N CARD(71) @C@@@@TEST: IF STRUCT[SOURCE] THEN GO TO FUNNYBOX; @^@@@@SF )@@G@@ PROCEDURE ERROR(N); @F@@@@ HJ L($+1) . STSG )@@G@@OP WIT H ADD IN SLR @ @@@@ LPS L(PSR) @I@@@@020190SH )@@G@@ 02 IDMEO PICTURE X(6). M63004SI )@@G@@40 @ @@@@X1DO $S 'X1 + 1 # (Y1N-Y4N)' @#@@@@X2DO $S '100' @ @@@@SJ )@@G@@ 01 ACCT-ANALYSIS-WORK.@D@@@@C-- ALL THESE ITEMS ARE PUT TOGETHERSK )@@G@@ TO FORM A TOKEN. @#@@@@ IBIT = 1 @[@@@@C @I@@@@080130 PSL )@@G@@ERFORM 10. M6301470 SM )@@G@@@#@@@@ I=0 @I@@@@010190 03 CODE2X PICTURE SN )@@G@@9. M6300240 @C@@@@ WHENEVER XLOGSO )@@G@@.G.4 .OR. XLOG.L.-3 @^@@@@ ENTRY TO MOD.@G@@@@ PSP )@@G@@RINT COMMENT $1THE FOLLOWING SHOULD BE A PLOT OF THE COSINE @A@@@@30 SQ )@@G@@CALL GEN(LMJ,0,X11,EOJ,0) @F@@@@ FD TRANS-FILE DATA RECORD TRSR )@@G@@ANS-RCD LABEL RECORD OMITTED. @^@@@@ Z=X-Y*(X/Y) @G@@@@YDO[2;SS )@@G@@] $S '(50#(1-TEMP1))+(20#TEMP#TEMP1$S50>TEMP$SX[2;T-1]%X[4;T-1])' @ @@@@ST )@@G@@YDO[3;] $S '.25 # X[3;T-1]' @A@@@@ Y=YREF(I,J)+DEL*FLOAT(K-1) SU )@@G@@@^@@@@ A(131)=A(0) @A@@@@ DEFINE FJFLD=FLD(0,10,CODE(I))SV )@@G@@@ @@@@ FUNCTION RETURN @B@@@@ DEFINE AFIELD=FLD(10,4,CSW )@@G@@ODE(I)) @ @@@@BOOLEAN PROCEDURE OPERATOR; @A@@@@ COMMENT FIRSSX )@@G@@T TWO ALTERNATES; @F@@@@COMMENT LOGICAL FUNCTION TO DETERMINE IF THE SY )@@G@@CHARACTER IN 'C' @#@@@@IS AN OPERATOR; @]@@@@ FETCH; @[@@@@BEGIN SZ )@@G@@@C@@@@ 02 FILLER PICTURE X(5). @ @@@@ 0TA )@@G@@00172500019000 @ @@@@ 000182600025000 @ @@@@ 0TB )@@G@@00192700029000 @^@@@@15070 REM 6-7 MAN, 0-69 @]@@@@ GOTO L2> @E@@@@TC )@@G@@0.005662E+00 0.0000 3.382629E+003.376967E+00 0.0000 @I@@@@010070TD )@@G@@ INPUT-OUTPUT SECTION. M63001TE )@@G@@10 @H@@@@C THIS PROGRAM WAS WRITTEN FOR CMSC 120. IT INTERPOLATES A TF )@@G@@NUMBER FROM A TA @^@@@@ F1=FUNC1(X,G) @B@@@@ FUNC2=FUNC1-TG )@@G@@ALPHA/2.0/PI*(T5+T6) @C@@@@START SA A0,A1 .SAVE ITH )@@G@@T @I@@@@010160 02 IPRONOX PICTURE 9(8). TI )@@G@@ M6300210 @^@@@@ 400 WRITE (L,500) @ @@@@ CALL PTJ )@@G@@LOTC(X2,Y2,2) @^@@@@ AAIJ 0,X1@I@@@@010200 03 RTK )@@G@@ESTUX PICTURE X(9). M6300250 @^@@@@TL )@@G@@ 607 23 12 26@#@@@@ E'L @C@@@@ W'R .NOTM )@@G@@T. C(19) .AND. I .NE. 101 @B@@@@ T'H ST5, FOR J=I+1,1,J.G.TN )@@G@@XLOG @I@@@@020140 DATA RECORD IS OUTREC. TO )@@G@@ M6300390 @ @@@@ 000212900022000 @#@@@@ TP )@@G@@CA=COS(F) @#@@@@ SA=SIN(F) @G@@@@ IF ((SA.GE.0.0).AND.(CA.TQ )@@G@@GE.0.0).OR.(SA.LT.0.0).AND.(CA.LT.0.0)) @I@@@@060020 P1. ENTER LINKAGETR )@@G@@-MODE. M6300850 @B@@@@ TS )@@G@@ JGD EA3,L($-2) . @B@@@@ L A3,EA0 TT )@@G@@ . @F@@@@ TE A1,0,A3 . IS IT WHAT WE TU )@@G@@PUT HTERE @^@@@@ 23 DO 30 IT=3, NO @#@@@@ X4=X4+R @I@@@@TV )@@G@@050060 02 IREST PICTURE X(8) SYNCHRONIZED LEFT. TW )@@G@@M6300830 @E@@@@ INTEGER MULT, NDATA, CNTRL, Z, I, ROW, J, STX )@@G@@TART @D@@@@ INTEGER M25, M50, XLOG, YLOG, XNLOG, YLARLG@I@@@@TY )@@G@@020050 02 IATIMEX PICTURE 9(5). TZ )@@G@@M6300300 @D@@@@BACKUP* NAME . THAT POINTED TO BY FBPNTR UA )@@G@@@I@@@@080050 GO TO P3. UB )@@G@@ M6301390 @F@@@@ FOR I=PRT-1 STEP -1 UNTIL 1 DOUC )@@G@@ TOT=TOT*FACT[I] @E@@@@ BLOCK-2. READ TRANS-FILE, AT END GO TO ENUD )@@G@@D-ROUTINE. @C@@@@ IF(INDX.GT.NOIN.OR.INDX.LT.1) INDX=NOIN @ @@@@UE )@@G@@ IF (P.LE.19.0) GO TO 10 @ @@@@ GO TO BLOCK-2. @A@@@@UF )@@G@@ MOVE ACT-EXP TO ACTUAL. @C@@@@ IF ACT-EXP IS GREATUG )@@G@@ER THAN BUD-ALLOW @#@@@@ 5340 GO TO 5090 @A@@@@ 5350 REM DEFENSIVE TEAMUH )@@G@@ RECOVERS @^@@@@ST4 ROW(J)=CHAR @[@@@@C @#@@@@ 557UI )@@G@@05 @#@@@@ NDIV=NUSE-1 @^@@@@ 639 18 12 26@#@@@@ UJ )@@G@@Y4=S+Y1 @]@@@@IN POSTAP @B@@@@'DO YOU WANT TO SEE PRESENT EQUATIONUK )@@G@@S$Q' @I@@@@060010 PROCEDURE DIVISION. UL )@@G@@ M6300840 @D@@@@ANYWAY: IF SUCCESSOR[SOURCE] EQL 0 THEN GOUM )@@G@@ TO POP2; @^@@@@ INTEGER N; VALUE N; @]@@@@CONTINUE @C@@@@ UN )@@G@@ LA A0,FBPNTR . GET CURRENT ENTRY @B@@@@XDO[1;] $S 'X[1;T-1]+DT#UO )@@G@@(Y[1;T] - Y[4;T])'@B@@@@ ENTRY PAR2(X1,Y1,SIDEL,SIDEW,ANGLE) @^@@@@UP )@@G@@ INTEGER CHAR@ @@@@ BOOLEAN CHECK, C @ @@@@ UQ )@@G@@ ENTRY TO EMPLOT. @ @@@@ 5240 IF Y2 = 0 THEN 5075 @]@@@@ UR )@@G@@END @B@@@@ PERFORM ACT-OVER-BGT-ROUTINE @D@@@@ EUS )@@G@@LSE IF ACT-EXP IS LESS THAN BUD-ALLOW @I@@@@010020 PROGRAM-ID. COBOLUT )@@G@@ READ WRITE ROUTINE FOR BLOCKED I/O. M6300060 @I@@@@ 80 UU )@@G@@ FORMAT (5I5) ******UV )@@G@@** @A@@@@LPS2 Y(I)=Y(I)/10.P.YLOG @I@@@@020200 02 IDATUW )@@G@@EO PICTURE 9(6). M6300450 @A@@@@UX )@@G@@ BEGIN STRING ARRAY ERRORS(50:1:10);@I@@@@040070 01 READM. UY )@@G@@ M6300610 @I@@@@* PROGRUZ )@@G@@AM AUTHOR - GEORGE W. BALTZ .719.GWB VA )@@G@@@I@@@@* VB )@@G@@ .719.GWB @I@@@@ ENTRY EESORT VC )@@G@@ .719.GWB @I@@@@ ASSIGN I,J VD )@@G@@ .719.GWB @^@@@@ GO TVE )@@G@@O ACCEPT; @G@@@@ IF TERMINAL[I] AND NOT ALPHABETIC(TYPE[I]) AND TYPEVF )@@G@@[I] EQL CARD[CHAR]@I@@@@ TPL OUT1+2 VG )@@G@@ .719.GWB @]@@@@ RETURN@F@@@@ VH )@@G@@ FOR I= PRT-1 STEP -1 UNTIL 0 DO TOT=TOT*FACT[I:@C@@@@160 CALL GVI )@@G@@EN(LX,U,X5,OFFSET(TRIPLE(NEXT,2)),0)@ @@@@ IF I LSS 0 THEN ERROR(7); VJ )@@G@@@[@@@@END; @[@@@@$F @[@@@@C @C@@@@ 02 FILLER VK )@@G@@ PICTURE X(5). @ @@@@ AUTHOR. ARNOLD KAPLAN. @]@@@@9999 RETURNVL )@@G@@@#@@@@ SPS(J)=0 @ @@@@ PROGRAM-ID. PROBLEM-2. @ @@@@ VM )@@G@@ 01 ACCT-ANALYSIS. @I@@@@001080 INPUT-OUTPUT SECTION. VN )@@G@@ PROBLEM2 @I@@@@001090 FILE-CONTROL. SEVO )@@G@@LECT DATA-FILE-1 ASSIGN TO SYSIN1. PROBLEM2 @[@@@@$G R7 VP )@@G@@@^@@@@ V ::= I @B@@@@ ER TDATE$ VQ )@@G@@ . @C@@@@ 1 10 05 05 05 05 05 05 0 10 30 20 @^@@@@MAXYR VR )@@G@@$S MAXYR + INITYR @G@@@@ DIMENSION AX(NR,NC),AY(NR,NC),NP(NC),XSCAVS )@@G@@LE(NC,2),YSCALE(NC,2) @B@@@@$G BAD $I # $N((A[1]='X') $O A[1]='Y') VT )@@G@@@#@@@@ S=SIDEW*CA @I@@@@060070 A1. ADD 1 TO SWITCH. IF SWITCH = 1 VU )@@G@@OPEN INPUT INFILE. M6300900 @A@@@@C DEFINE INTERNAL SUBROVV )@@G@@UTINE GEN @A@@@@ 5220 GOSUB 13000 @ RETURN RESULT @E@@@@ CALL GVW )@@G@@EN(LA,0,A1,UA3,0) @SAVE A3 AS PTR TO LABEL TABLE@D@@@@ CALL GEN(AA,VX )@@G@@0,A1,X5,0) @LOCATE PROPER LABEL @]@@@@(18X,3F1.0) @F@@@@B PROC VY )@@G@@ . PROC TO GET POINTER TO ENTRY AHEAD OF @^@@@@$G BAD $I #(VZ )@@G@@3$> $E A[2])@A@@@@ IF (JPC(J).GT.21) GO TO 109 @F@@@@ FOR I := 0WA )@@G@@,0,0,0,1,1,1,0,0,1,0,0,1,1,0,0,1 DO BEGIN J := J + 1; @^@@@@LOCAL PROCEDWB )@@G@@URE ERROR; @#@@@@LOCAL LABEL START;@A@@@@*INCREMENT K FROM 2 TO [HDG,CAWC )@@G@@RD] @#@@@@5360 LET T = 3 -T @^@@@@ 5365 LET B =B + Y1 @#@@@@/[[#1]WD )@@G@@,[#2],3,1]& @F@@@@ W'R WORD(0).E.$THROUG$.OR.(WORD(0).A.MASK).WE )@@G@@E.$T'H@@@$ @#@@@@ E'L @I@@@@040040 77 TEST WF )@@G@@ PICTURE 9(6). M6300580 @#@@@@ GO TO WG )@@G@@801 @^@@@@ C EQL LPAREN OR @^@@@@ C EQL EQUAL OR @A@@@@WH )@@G@@ C EQL BRACKET THEN BEGIN @ @@@@ OPERATOR := TRUE; WI )@@G@@@^@@@@ GO TO FND; @[@@@@ END @I@@@@ TZE *+2 WJ )@@G@@ .719.GWB @I@@@@ WK )@@G@@ TPL OUT2 .719.GWL )@@G@@WB @I@@@@ LXA I,1 WM )@@G@@ .719.GWB @I@@@@ CLA HOLD,1 WN )@@G@@ .719.GWB @I@@@@ TPL OUT1+2 WO )@@G@@ .719.GWB @I@@@@ WP )@@G@@ TTR *+3 .719.GWQ )@@G@@WB @I@@@@BACK1 CLA I WR )@@G@@ .719.GWB @I@@@@ ADD =1 WS )@@G@@ .719.GWB @G@@@@THIS ROUTINE COMBINES THWT )@@G@@E SEARCHES FOR THE QUASI-TERMINALS I AND N; @]@@@@ BEGIN @B@@@@WU )@@G@@ TERM = PRI B ARBNO('**' B PRI B ) @C@@@@ AEX = TERM B ARBNWV )@@G@@O(('+'/'-') B TERM B ) @B@@@@ BEX = AEX B ARBNO( ROP B AEX B) WW )@@G@@@#@@@@ J=0 @ @@@@ CHANGE=CHANGE+5 @C@@@@ WX )@@G@@ SPRAY.($ $,SQUASH(0)...SQUASH(12)) @E@@@@ T'H SQUISH, FWY )@@G@@OR I=11,1,CARD(I).E.$,$.OR.I.G.71 @#@@@@,[[#1],I,2,1]& @ @@@@*. DOCWZ )@@G@@ DOC,SDF DOC VERSION @#@@@@ J=J+1 @^@@@@ W'R FLAXA )@@G@@G @#@@@@C TME(T)) @H@@@@020130 LABEL RECORDS ARE LAB-1 XB )@@G@@ UNIVAC@ @@@@ PRINT FORMAT XC )@@G@@PAGEUP@#@@@@ C := CHAR[I]; @#@@@@ I := I-1; @^@@@@ E$XD )@@G@@DIT EPKT@D@@@@ STRUCT[J] := IF I EQL 0 THEN FALSE ELSE TRUE; END; XE )@@G@@@]@@@@ J := 0; @A@@@@ IF(NUMPLT.GT.1) GO TO 100 @[@@@@$G TRYXF )@@G@@@[@@@@BEGIN @B@@@@ 5400 GOSUB 13000 @ RETURN RESULT @C@@@@ T;XG )@@G@@ COMMENT 'T' PRECEEDED BY AN OPERATOR; @ @@@@ 5100 IF R3 = 2 THEN 115XH )@@G@@00 @^@@@@ 5105 IF L = 0 THEN 1000@]@@@@CHAR := 1; @]@@@@GO TO QUERY;XI )@@G@@@G@@@@ RECUR: IF STACK(PTR) EQL 3 THEN GOTO EQUL0 ELSE IF STACK(PTXJ )@@G@@R) @#@@@@SAVE C'E @G@@@@15150 DATA 5,4,2603,0,-1,-4,0,-5,-3,XK )@@G@@-6,-2604,-7,-6,-9,2703,-5,2109,-2 @^@@@@15160 REM 7 MAN,10-30 @^@@@@XL )@@G@@ WRITE (F1,M,ANS)$ @#@@@@INP $S $E CHANGE @A@@@@'NEW EXPRESSION ISXM )@@G@@ '; $E CHANGE[$I7]@^@@@@DESCRIBE $S 'TYPE SIM' @[@@@@$I/ @[@@@@$F XN )@@G@@@#@@@@$F CHANGEDO;INP @]@@@@ STOP @ @@@@ CALL PLOTC(5.0,0.0XO )@@G@@,-3) @]@@@@'Y3: ';Y3I @]@@@@'Y4: ';Y4I @D@@@@NEXT1:'DO YOU WANT TO CHXP )@@G@@ANGE ANY INITIAL VALUES $Q' @E@@@@15170 DATA 99,4,9,2,2606,1,4,1,2,1,-XQ )@@G@@1,0,7707,1,7,6,4,2604 @[@@@@C @B@@@@ SUBROUTINE GEN(F1,J1,AA1XR )@@G@@,U1,XX1) @B@@@@PSRFRM FORM 9,9,2,7,9 . @]@@@@'THINKXS )@@G@@ING' @I@@@@001100 DATA DIVISION. XT )@@G@@ PROBLEM2 @^@@@@ 369 19 12 27@I@@@@040230 PXU )@@G@@ICTURE 9(5). M6300770 XV )@@G@@@B@@@@ 5420 GOSUB 13500 @PRINT YARDAGE RESULT @ @@@@ J XW )@@G@@ 2,X11 @^@@@@*PROCESS PROCESS PDP @^@@@@*PROCESS PROCESS RALPH XX )@@G@@@I@@@@050010 02 IUTIME USAGE COMPUTATIONAL SYNCHRONIZED RIGHT XY )@@G@@ M6300780 @#@@@@ END @F@@@@ DISPLAY 'EXCEXZ )@@G@@SSES OF BUDGET OVER ACTUAL, ' ED-UNDER @#@@@@L* FUNC @[@@@@YA )@@G@@KJN @ @@@@OUT SA A0,FSPNTR . @^@@@@'TYPE IN X1-X4 OR Y1-Y4'YB )@@G@@@#@@@@$F INITIALIZE @#@@@@ A(1,1)=.5 @ @@@@ END L(1YC )@@G@@)-BEGIN @^@@@@*PROCESS PROCESS DOC @^@@@@*PROCESS PROCESS ELT YD )@@G@@@]@@@@ END;@G@@@@ IF C EQL LPAREN THEN GO TO ACCEPT; COMMENT YE )@@G@@OR 'T' PRECEEDED BY '(';@E@@@@ IF C EQL EQUAL THEN GO TO ACCEPT; COYF )@@G@@MMENT OR BY '='; @ @@@@ AUTHOR. FEE JING MON. @A@@@@ L YG )@@G@@ A0,(0305,IMAGE) @^@@@@ 586 37 08 22@#@@@@ 2 40 30 YH )@@G@@30 @F@@@@ V'S YSCALE=$1H8,S40,H+Y VALUES SCALED BY A FACTORYI )@@G@@ + , @^@@@@ 559 20 09 29@[@@@@4 $Y 4@^@@@@ REAYJ )@@G@@D I; @^@@@@$EXECUTE IBJOB @^@@@@ WRITE (6,175) @ @@@@YK )@@G@@STRING ALPHA(26),BLANK(1); @#@@@@STRING NUM(10); @]@@@@INTEGER I; YL )@@G@@@#@@@@ BOOLEAN NUMBER; @#@@@@LOCAL PROCEDURE T;@#@@@@ Y := Y - 1; YM )@@G@@@]@@@@ J := 0; @G@@@@ FOR I := -1,-1,-1,-1,-1,-1,-1,9,0,-1,12,0,14,1YN )@@G@@5,-1,-1,-1 DO BEGIN @B@@@@ J := J + 1; ALTERNATE[J] := I; END; YO )@@G@@@^@@@@ EX1 = EVAL( EX) @^@@@@ + N @[@@@@*END YP )@@G@@@I@@@@002100 77 DIS-4 PICTURE +ZZ,ZZ9.99. YQ )@@G@@ PROBLEM2 @C@@@@ 02 ACCOUNT-STATUS PICTURE A(20).YR )@@G@@@C@@@@ 02 FILLER PICTURE X(5). @#@@@@C48993070035YS )@@G@@500 @B@@@@ AXR$ . @^@@@@ L,YT )@@G@@U R3,9@[@@@@*END @ @@@@ABCDEFGHIJKLMNOPQRSTUVWXYZ @#@@@@ YU )@@G@@Y4=Y4+S @I@@@@001010 IDENTIFICATION DIVISION. YV )@@G@@ PROBLEM2 @B@@@@ 5230 GOSUB 13500 @PRINT YARDAGE YW )@@G@@RESULT@H@@@@ A(4,8)=28837.*XOLD(1)+139009.*XOLD(2)+78213.*XOLD(3)-1YX )@@G@@8927.*XOLD(4) @I@@@@001020 PROGRAM-ID. PROBLEM-2. YY )@@G@@ PROBLEM2 @#@@@@'OK$Q (YES OR NO)'@[@@@@FINISHYZ )@@G@@@]@@@@ A(4,Z @^@@@@ 5 B(J)=ZT(J)+ZTA @[@@@@BEGIN @ @@@@ IFZA )@@G@@ C EQL 'I' THEN BEGIN @^@@@@ GYOYO[Y]:=GOAL; @^@@@@ SYOYO[YZB )@@G@@]:=SOURCE; @^@@@@ CYOYO[Y]:=CHAR; @]@@@@GO TO START;@[@@@@BEGIN ZC )@@G@@@ @@@@ IF C EQL RPAREN THEN BEGIN@C@@@@ FETCH; COMMENT THIZD )@@G@@RD ALTERNATE; @D@@@@ W'R THRUS(PLACE,I).NE.CARD(I),FLAG1=1ZE )@@G@@B @#@@@@ E$TIME @^@@@@CAT '@CAT,PR &'@A@@@@ ZF )@@G@@ L A0,(0305,IMAGE) @^@@@@ NUMBER := FALSE;@[@@@@END; ZG )@@G@@@^@@@@PROCEDURE POPUP(N); @^@@@@ VALUE N; INTEGER N;@C@@@@ ZH )@@G@@ (NOTE: THE SCAN IS FROM THE RIGHT); @[@@@@BEGIN @A@@@@ THEN OPZI )@@G@@ERATOR := LOOKFOR[I]; @[@@@@ END;@]@@@@ N = 1@^@@@@ 420 20ZJ )@@G@@ 14 29@F@@@@ ROP = '.GT.' / '.LT.' / '.EQ.' / '.GE.' / '.LE.ZK )@@G@@' / '.NE.' @A@@@@ W'R .NOT. C( 7), P'T XG @A@@@@ WZL )@@G@@'R .NOT. C(11), P'T YG @ @@@@ PRINT FORMAT PAGEUP@B@@@@ ZM )@@G@@ THROUGH S1, FOR I=0,1,I.G.10 @E@@@@1.757850E+001.016904E-011.1245ZN )@@G@@76E+019.487910E+00 0.0000 @ @@@@901 FORMAT(' BM=',E14.8) @B@@@@ZO )@@G@@ 150 FORMAT(//,10X,4HBETA,20X,4HDBDS,//) @ @@@@ COMMON / KEEP /FUNZP )@@G@@C1 @ @@@@ COMMON / KEEP /FUNC1 @B@@@@ MOVE TOT-UNDEZQ )@@G@@R TO ED-UNDER. @^@@@@$G NEXT2 # $I(INPUT) @ @@@@ IF N EZR )@@G@@QL 1 THEN @]@@@@C2:INP $S $"@^@@@@ EX2 = EVAL( EX) @^@@@@$G C1 ZS )@@G@@$I(INP[1] $= ' ') @^@@@@ DO 912 J=2,KP @#@@@@ E'L ZT )@@G@@@^@@@@ INDX=INDX*MDIV+2 @E@@@@C-- DECLARED IN WHICH ARE SUPERIOR TZU )@@G@@O THIS BLOCK. OFFSET IS@^@@@@$IBCBC ISM101 NODECK @ @@@@*INCREMENT ZZV )@@G@@ FROM S TO [Q] @[@@@@$F @]@@@@#I=I+I*N# @C@@@@ 02 FILZW )@@G@@LER PICTURE X(51).@]@@@@$F REDO @^@@@@ E$CHAR ZX )@@G@@ '*' @ @@@@ ER PRINT$ @ @@@@*IF [Q,Z,3,1]=5 OR [Q,Z,ZY )@@G@@3,1]=6@[@@@@*ELSE @ @@@@ L,U R4,11 @I@@@@003040 ZZ )@@G@@ DISPLAY ' 'PROBLEM2 AA )@@G@@@B@@@@ CALL PAR(0.0,-3.0,6.0,1.5,0.0,5) @B@@@@ CALL PAR(6.0AB )@@G@@,-3.0,6.0,1.5,90.0,5) @#@@@@C3:'TRY AGAIN$Q' @#@@@@$G C4 # $I(INPUT) AC )@@G@@@[@@@@$F @I@@@@003050 ' REID ELLIS SECTION 7 ' AD )@@G@@UPON SYSOU1. PROBLEM2 @ @@@@ PRINT COMMENT $ $ @^@@@@AE )@@G@@ DO 912 J=1,KP @ @@@@ INPUT-OUTPUT SECTION. @E@@@@ AF )@@G@@ FILE-CONTROL. SELECT TRANS-FILE ASSIGN TO SYSIN1. @#@@@@X3N $S $E X3AG )@@G@@DO @#@@@@X4N $S $E X4DO @I@@@@ STA STA1 AH )@@G@@ .719.GWB @I@@@@ STA STAAI )@@G@@2 .719.GWB @I@@@@AJ )@@G@@ CLA 2,4 AK )@@G@@.719.GWB @I@@@@ STA STA3 AL )@@G@@ .719.GWB @#@@@@ 5410 LET L=0 @[@@@@ END; @]@@@@AM )@@G@@ BEGIN @I@@@@ STA STA4 AN )@@G@@ .719.GWB @I@@@@ STA STA5 AO )@@G@@ .719.GWB @I@@@@ STA STAAP )@@G@@6 .719.GWB @I@@@@AQ )@@G@@ STA STA7 AR )@@G@@.719.GWB @I@@@@ STO I AS )@@G@@ .719.GWB @I@@@@ SUB HOLD AT )@@G@@ .719.GWB @I@@@@080040 CLOSE IAU )@@G@@NFILE. M6301380 @B@@@@AV )@@G@@ L,U A10,'Z' . @[@@@@C @C@@@@ 1 05 10 AW )@@G@@10 10 10 10 10 10 10 10 05 @#@@@@ 2 50 25 25 @ @@@@ 5075 AX )@@G@@GOSUB 12500 @TIME @[@@@@*. @[@@@@*. @F@@@@*. THE OPTIONS OF AY )@@G@@/Q , HEADINGS , AND START 'N' CAN BE INTERMIXED @^@@@@CHANGE[5] $S INP[2AZ )@@G@@] @#@@@@$GR6#$I(INPUT) @#@@@@'WHICH ONE$Q' @B@@@@ TBA )@@G@@HROUGH L1, FOR I=0,1,I.G.NDATA@I@@@@002148 ADD 1 TO NO-OF-NOS. BB )@@G@@ PROBLEM2 @B@@@@ LMJ BC )@@G@@ A0,L($+1) . @F@@@@ DIMENSION XREF(NC,3),YREF(NC,3),F(NCBD )@@G@@),XTEST(100),YTEST(100) @ @@@@ END OF FUNCTION @A@@@@ BE )@@G@@ MOVE DIFF TO PCT-OVER. @I@@@@020180 02 UNAMEO PBF )@@G@@ICTURE X(10). M6300430 @^@@@@15100 REM 5 MAN,10BG )@@G@@-30 @ @@@@C INDX=INDX*(NUSE+1)+2 @E@@@@15000 REM RUNNING PLBH )@@G@@AYS 2 CARDS PER LINE PER YARDAGE @]@@@@X3 $S X3I @^@@@@ SBI )@@G@@TOP RUN. @]@@@@3 1 $R ' ' @[@@@@*. @A@@@@ 1 H+OF 10 TO TBJ )@@G@@HE +, I3*$ @^@@@@ GOAL:=GYOYO[Y]; @B@@@@ L,U A7,'BK )@@G@@0'-1 . @ @@@@ DIMENSION ARRAY(1000) @ @@@@C1 THIS ABL )@@G@@LGORITH OUTPUTS OM@A@@@@ SOURCE-COMPUTER. IBM-7094. @A@@@@ BM )@@G@@ OBJECT-COMPUTER. IBM-7094. @B@@@@ SPRAY.($ $,OUT(0)...OUT(7BN )@@G@@1)) @]@@@@I := 80; @]@@@@TEST: FETCH;@A@@@@IF C NEQ BLANK THEN GO TBO )@@G@@O CALL; @G@@@@IF I LEQ 4 THEN GO TO START; COMMENT LESS THAN SHORTESBP )@@G@@T POSSIBLE STRING;@]@@@@GO TO TEST; @E@@@@6.830000E+021.402353E+036.9068BQ )@@G@@34E+020.003400E+007.680000E+00@[@@@@C @G@@@@PROBLMOV 3 4 2 BR )@@G@@ 2 2 2 1@I@@@@070120 MOVE IDBS )@@G@@ATE TO IDATEO. M6301210 @#@@@@BT )@@G@@F11804505045050 @#@@@@A20405005054000 @I@@@@020060 02 ILTIMEX BU )@@G@@ PICTURE 9(5). M6300310 @#@@@@ BV )@@G@@ BUFFER P @ @@@@ END OF CONDITIONAL @ @@@@ SUBROUTINE BBW )@@G@@EGIN(ARRAY) @[@@@@$(0). @@@@@@@C@@@@ IF(J.EQ.1) DUM(J)=-(B(1)-B(2))BX )@@G@@/TANH(DS) @ @@@@ W'R CARD(I).NE.$ $ @A@@@@*. ELT ASM COB RALBY )@@G@@PH ALG MAP DOC PDP@A@@@@C SINGLE VARIABLE SUBSCRIPTS@D@@@@END OFBZ )@@G@@ CARD ENCOUNTERED BEFORE END OF STRING (ERROR 7)@E@@@@MISMATCHED PARENTHCA )@@G@@ESES--TOO MANY RIGHT PARENTHESES (ERROR 8)@B@@@@ N REPRESENTS ANCB )@@G@@Y LEGAL NUMBER; @ @@@@ PRINT COMMENT $8 $ @[@@@@*. @[@@@@CC )@@G@@*. @I@@@@070060 P6. ENTER COBOL. CD )@@G@@ M6301150 @#@@@@G18119300094000 @ @@@@C4:'INPUT EXPRESSICE )@@G@@ON FOR ';INP@G@@@@1 CF )@@G@@ 8 20@]@@@@ I=I+1 @^@@@@ + 0 @I@@@@CG )@@G@@HOLD ERAS 1000 CH )@@G@@.719.GWB @I@@@@EESORT CLA 1,4 CI )@@G@@ .719.GWB @I@@@@ SXA RETURN,4 CJ )@@G@@ .719.GWB @]@@@@ N = 2@C@@@@CK )@@G@@NEXT EQ( STRING, '69' ) :S(END) F(IN) @I@@@@STA1 CLA ** CL )@@G@@ .719.GWB @I@@@@CM )@@G@@ STO HOLD CN )@@G@@.719.GWB @I@@@@ PXA ,, CO )@@G@@ .719.GWB @A@@@@ CALL GOT(TRIPLE(NEXT,3),UA2) CP )@@G@@@B@@@@2 ADDR(CODE(B1)) = ORIGIN + I + 1 @#@@@@ ANMB=NOIN-2 CQ )@@G@@@C@@@@ 1 10 05 05 05 05 05 05 0 10 30 20 @D@@@@ 0CR )@@G@@2 PCT-UNDER PICTURE ZZZ.99. @F@@@@ DISPLAY 'NUMBCS )@@G@@ER ', 'STATUS ', @#@@@@ GO TO 1 @I@@@@CT )@@G@@ WRITE (6,100) NAME, IDATE, ITIME CU )@@G@@M6301590 @E@@@@ 77 RUN-UNDER PICTURE 99999V9CV )@@G@@9. @^@@@@ 440 34 12 29@I@@@@ TTR *+2 CW )@@G@@ .719.GWB @I@@@@BACK2 CLA CX )@@G@@ J .719.GWB CY )@@G@@@#@@@@$IBJOB GO @#@@@@ ERROR(4); @ @@@@ CALL PLOTS(ACZ )@@G@@RRAY,1000) @ @@@@ CALL PLOTC(6.0,-11.0,-3)@^@@@@A5 CONTINUDA )@@G@@E @^@@@@ Y(I)=Y(I+1) @G@@@@ FOR I := 2,3,4,5,0,0,8,7,7,1DB )@@G@@1,10,10,0,0,16,17,0 DO BEGIN J := J + 1; @A@@@@ EXTERNAL FUNCDC )@@G@@TION (X,Y) @I@@@@070020 P5. ENTER LINKAGE-MODE. DD )@@G@@ M6301110 @D@@@@TYPE I ANOVA. RECALL SCORES DE )@@G@@ B IS 1SE VS 3ME @@@@@@@I@@@@003140 DISPLAY ' ' UPON SYSOU1. DF )@@G@@ PROBLEM2 @I@@@@003150 DISPLAY ' DG )@@G@@ ' UPON SYSOU1. PROBLEM2 @#@@@@X2N $SDH )@@G@@ $E X2DO @G@@@@ DIMENSION SCALE(NPLT,2),XRATE(NPLT),REF(NPLT,3),DI )@@G@@DIG(100),X(200) @B@@@@ XLOG=(Y(I)-YBAR)/YGRID+50.5 @ @@@@DJ )@@G@@BLACK ROW(XLOG)=CHAR @ @@@@ INTEGER PROCEDURE IDENTIFIER;@#@@@@DK )@@G@@ BEGIN INTEGER I; @#@@@@ BEGIN INTEGER I; @[@@@@$G C2 @#@@@@'INPUT YES ODL )@@G@@F NO' @I@@@@002110 77 DIS-5 PICTURE +ZZ9.99. DM )@@G@@ PROBLEM2 @[@@@@$F @E@@@@ MOVE 'ACTUAL OVER BDN )@@G@@UDGET' TO ACCOUNT-STATUS. @]@@@@PROCEDURE P;@I@@@@060090 A2. MOVE IPDO )@@G@@RONOX TO IPRONO. M6300920 @ @@@@DP )@@G@@ 5540 GOSUB 12500 @TIME @ @@@@STRING ARRAY MSG(80:1:9); @C@@@@DQ )@@G@@COMMENT FUNCTION TO FIT P::= I \ N \ (E); @ @@@@ PROCEDURE DDR )@@G@@IVISION. @[@@@@*. @I@@@@ GO TO 10 DS )@@G@@ M6301610 @^@@@@$G LOOP# $I(DTEMP=4) DT )@@G@@@ @@@@ END OF FUNCTION @#@@@@ CALL ENDPLT @ @@@@ DU )@@G@@ FUNCTION RETURN Z @ @@@@ SUCCESSOR[J] := I; END; @#@@@@PROCEDDV )@@G@@URE FETCH; @^@@@@ SOURCE:=SYOYO[Y]; @F@@@@*. THE /Q IN SPEC 2 SPECDW )@@G@@IFIES THAT ALL ELEMENTS IN TPF$ ARE TO BE @E@@@@*. LOOKED AT. IF IT IS DX )@@G@@DESIRED TO DO ONLY CERTAIN ELEMENTS @#@@@@ H=N/R @D@@@@ DY )@@G@@ DISPLAY 'TOTAL OVER IS ' DIS UPON SYSOU1. @^@@@@$IBCBC ISM101 NODDZ )@@G@@ECK @[@@@@*. @]@@@@*EDIT ON @ @@@@ + WEF$,0,0 EA )@@G@@@#@@@@'HOW ABOUT THAT!' @B@@@@ W'R C(4), P'T XSCALE, XLOG*(-1)EB )@@G@@@ @@@@ PROGRAM-ID. PROGRAM-2.@I@@@@ ADD =1 EC )@@G@@ .719.GWB @I@@@@060100 MED )@@G@@OVE CODE1X TO CODE1. M6300930 EE )@@G@@@#@@@@ IF (Y , @^@@@@C--- REPAIR "IF" BRANCH @]@@@@$G NEXT EF )@@G@@@ @@@@TEN L,U R4,11 @ @@@@C1: $G C3 # $I(($R INP) > 2) EG )@@G@@@#@@@@BAD: 'TRY AGAIN' @D@@@@ V'S AXIS=$1H9,S23,10(10HI++++++EH )@@G@@+++),1HI * $@F@@@@ V'S XB=$1H ,S50,H+ EMPLOT HAS CALCULATED XBEI )@@G@@AR +*$ @#@@@@$* PLOT AFTER RUN@[@@@@C @#@@@@X[$IT;] $S XI EJ )@@G@@@#@@@@Y[$IT;] $S YI @I@@@@010080 FILE-CONTROL. EK )@@G@@ M6300120 @C@@@@ 1 25 EL )@@G@@50 25 @#@@@@ 2 20 20 60 @ @@@@OUT $S (MAXYR-INITEM )@@G@@YR+1,9) $R 0@[@@@@$F @I@@@@040150 02 ITIME USAGE COMPUTATIONAL SYEN )@@G@@NCHRONIZED RIGHT PICTURE 9(6).M6300690 @C@@@@ P'T $(1H ,72AEO )@@G@@1)*$,CARD(0)...CARD(71) @B@@@@YDO[4;] $S '35 $L X[1;T-1] $L X[4;T-1]' EP )@@G@@@[@@@@$F @#@@@@ X3=R+X2 @^@@@@ T'O READ @^@@@@EQ )@@G@@ EX3 = EVAL( EX) @[@@@@A $S 5@]@@@@B $S 10 @^@@@@ FORMATER )@@G@@(3F6.0) @^@@@@X3DO$S 'X3+1#(Y2N-Y3N)' @ @@@@X4DO $S 'X4 + 1 # (Y3N-YES )@@G@@4N)' @^@@@@ M25=MULT*25 @^@@@@ M50=MULT*50 @ @@@@ET )@@G@@ CHAR=676060606060K @I@@@@060080 READ INFILE AT END MOVE AEU )@@G@@LL '9' TO IPRONOX AND GO TO A2. M6300910 @]@@@@$F REDO @F@@@@EV )@@G@@C INCREMENT THE POINTER TO THE NEXT WORD IN THE GENERATED CODE @[@@@@EW )@@G@@T $S 1@E@@@@ NAME = SPAN('ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890.-')EX )@@G@@@[@@@@C @ @@@@ CODE(I)=OFFSET(TRIP) @#@@@@ 58036 EY )@@G@@@A@@@@ MOVE ZERO TO PCT-UNDER. @^@@@@ A(I+77K)=A(I)EZ )@@G@@@B@@@@ ADD RUN-UNDER TO TOT UNDER. @A@@@@ IF NOT OPERATOFA )@@G@@R THEN ERROR(9); @^@@@@ FORMAT O(S50,A1.1); @A@@@@ WRITE AFB )@@G@@CCT-ANALYSIS. @I@@@@002070 77 DIS-1 PICTURE +ZZ9.99. FC )@@G@@ PROBLEM2 @I@@@@002080 77 DIS-2 PICTUFD )@@G@@RE +ZZ9.99. PROBLEM2 @]@@@@ N = 3FE )@@G@@@C@@@@ WHENEVER YLOG.G.4 .OR. YLOG.L.-3 @C@@@@ TFF )@@G@@HROUGH LPS2, FOR I=0,1,I.G.NDATA @^@@@@ DO 912 J=1,KP @^@@@@FG )@@G@@ 487 35 15 31@#@@@@ 5290 GO TO 5170 @[@@@@-29 @]@@@@ FH )@@G@@NO=2 @]@@@@,2;590. @G@@@@1 FI )@@G@@ 7 60@B@@@@C DECREASE THE PREDECESSOR COUNTFJ )@@G@@ BY 1 @H@@@@SGEOG411 0101030000030MWF11 Q 209 FK )@@G@@ 03 @A@@@@ WORKING-STORAGE SECTION. @^@@@@ 541FL )@@G@@ 18 10 23@^@@@@ 340 34 13 33@ @@@@ ACT-UNDER-BFM )@@G@@GT-ROUTINE. @E@@@@ MOVE 'ACTUAL UNDER BUDGET' TO ACCOUNT-STATUFN )@@G@@S. @I@@@@080140 T2. EXIT. FO )@@G@@ M6301480 @#@@@@ GO TO 10 @#@@@@ GO TO 410 FP )@@G@@@ @@@@402 CALL GEN(LMJ,0,X11,0,X1)@A@@@@C GENERATE CODE FOR END OF JOFQ )@@G@@B @F@@@@ 3 10 05 05 05 05 05 20 05 05 05 05 05 05 05 FR )@@G@@10 @D@@@@ FD BUDGET-ANALYSIS DATA RECORD ACCT-ANALYSIS @D@@@@FS )@@G@@ 02 FILLER PICTURE X(5). @D@@@@ 0FT )@@G@@2 ACCOUNT-STATUS PICTURE A(20). @F@@@@ DIMENSION YSCALE(NFU )@@G@@PLT,2),YREF(NPLT,3),XREF(NPLT,3),NSIGN(2) @A@@@@ X$DUMP ECSAV6,7,'FV )@@G@@O','XAR' @I@@@@080030 DISPLAY ' '. FW )@@G@@ M6301370 @ @@@@L2 YBAR=YBAR+Y(I) @ @@@@FX )@@G@@ YBAR=YBAR/NDATA @^@@@@SGEOG202 030101040000040@#@@@@CGEOL1FY )@@G@@00 GEOLOGY @E@@@@0.241000E+00 0.0000 1.643938E+000.002938E+001.4000FZ )@@G@@00E+00@B@@@@A2 WHENEVER C(7), TRANSFER TO A3 @]@@@@)DEBUG 0 GA )@@G@@@A@@@@ LABEL RECORD OMITTED. @^@@@@TFREN 0101MONCHOUX GB )@@G@@@F@@@@ V'S XG=$1H ,S50,H+ EMPLOT HAS CALCULATED XGRID +*$ GC )@@G@@@F@@@@ V'S YG=$1H ,S50,H+ EMPLOT HAS CALCULATED YGRID +*$ GD )@@G@@@G@@@@ EXTERNAL FUNCTION(X,Y,NDATA,XGRID,YGRID,XBAR,YBAR,MULT,GE )@@G@@CNTRL)@B@@@@ DIMENSION H(20), ROW(101),C(20)@A@@@@$G BAD # $I(GF )@@G@@$A/'YES'=(3^A,' ') @I@@@@040180 02 IATIME USAGE COMPUTATIONAL SGG )@@G@@YNCHRONIZED RIGHT M6300720 @I@@@@070230 11. IF IPRONO = 9GH )@@G@@9999999, GO TO THATS-ALL ELSE GO TO B2. M6301320 @^@@@@ IFGI )@@G@@ C EQL MINUS OR @^@@@@ C EQL PLUS OR @A@@@@ ADD RUNGJ )@@G@@-OVER TO TOT-OVER.@C@@@@ NOP . WAIT FOR IT TO HAPPEN GK )@@G@@@C@@@@ HJ L($+1) . STOP @C@@@@ XGL )@@G@@GRID =(X(NDATA)-X(0)) /(MULT*50.) @D@@@@ BEQ = BEX B ARBNO(('.ANGM )@@G@@D.' / '.OR.') B BEX B @ @@@@A3 W'R C(11), T'O A4 @#@@@@ GN )@@G@@ TG,U @A@@@@ V'S MASK=777777000000K @C@@@@C COPY A FGO )@@G@@AKE HEADER LABEL WHICH WILL BE REL @F@@@@ LMJ A1,L($+1) GP )@@G@@ . GET LEFT HALF OF PATTERN @ @@@@CHANGE $S 'XDO[1;] $S $"' GQ )@@G@@@#@@@@100 CONTINUE @ @@@@ CALL PLOTC(X3,Y3,I) @ @@@@ GR )@@G@@CALL PLOTC(X4,Y4,2) @ @@@@ IF (P.LT.360.0) GO TO 20@^@@@@ GS )@@G@@DO 100 I=2,NAX @A@@@@ 1 H+OF 10 TO THE +, I3*$ @B@@@@$ID GT )@@G@@ MON,FEEJING *356/18/752*10S*NODECK$@#@@@@FILL C'E @ @@@@ 69GU )@@G@@ 0 0 0 0@G@@@@007110 01 C-T-HOLD PIGV )@@G@@CTURE X(20), VLAUE IS SPACE. @#@@@@ CODE(I)=0 @#@@@@ REL=ORGW )@@G@@IGIN+I@G@@@@ DISPLAY ' ' GX )@@G@@UPON SYSOU1.@ @@@@ B'N FLAG,FLAG1 @[@@@@B $S 1@^@@@@ 414GY )@@G@@ 38 12 35@I@@@@080150 ZZ. DISPLAY 'MERGE TAPE NOW COMPLETE ON AGZ )@@G@@3'. M6301490 @ @@@@BOOT L,U A0,OUT HA )@@G@@@A@@@@401 CALL GEN(LX,0,WREG,REGTOP,0) @F@@@@C-- THE POSITION IN THE HB )@@G@@RUN-TIME DISPLAY OF THE VARIABLE. LINE @E@@@@ 77 DIFF HC )@@G@@ PICTURE 99999V99. @B@@@@ TE,U A3,L(END) HD )@@G@@ . @I@@@@070160 MOVE ILTIME TO ILTIMEO. HE )@@G@@ M6301250 @F@@@@ 77 TOT-OVER PIHF )@@G@@CTURE 99999V99 VALUE ZERO. @E@@@@0.008362E+00 0.0000 2.717015E+00HG )@@G@@2.708653E+00 0.0000 @B@@@@ 5380 PRINT 'PICKED UP BY ;N(T); ' FOR'; HH )@@G@@@]@@@@ I=I+1 @ @@@@ CALL GEN(TNE,0,A1,UA2,0)@ @@@@ CALL GHI )@@G@@EN(J,0,0,0,0) @^@@@@ 151 FORMAT(2F20.10) @A@@@@ C(14)=.HJ )@@G@@NOT.C(2).AND.C(13)@ @@@@XDO $S YDO $S 4 72 $R ' ' @B@@@@EA3 EQHK )@@G@@U EA0+2 . @I@@@@100 FORMAT (1H , A6, A5, I8, I8) HL )@@G@@ M6301640 @^@@@@ 10 CALL WHERE(WHM )@@G@@,Z) @ @@@@ CALL PLOTC(X1,Y1,3) @ @@@@ F=3.14159/180.0*ANHN )@@G@@GLE @I@@@@010140 DATA RECORD IS INREC. HO )@@G@@ M6300190 @G@@@@1 HP )@@G@@ 6 20@[@@@@IF @[@@@@C @I@@@@001110 FILE HQ )@@G@@SECTION. PROBLEM2 HR )@@G@@@]@@@@C--- GO TO @I@@@@003170 DISPLAY ' ' UPON SYSOU1. HS )@@G@@ PROBLEM2 @I@@@@003180 DISPLAY ' ' UPHT )@@G@@ON SYSOU1. PROBLEM2 @C@@@@ AAHU )@@G@@IJ 0,X1 . CONTINUE@^@@@@ 5370 LET B = 100 - B @I@@@@HV )@@G@@003210 PAR-9. DISPLAY 'YOU FORGOT THE DATA, DUMMY ' UPON SYSOU1. HW )@@G@@PROBLEM2 @B@@@@ IF N EQL 1 THEN FACT=1 ELSE@[@@@@$DATA HX )@@G@@@#@@@@C CONSTANT TABLE @E@@@@ SUBROUTINE GVRATE(SCALE,REF,NPLT,NSEHY )@@G@@CT,XMIN,XRATE) @G@@@@ DIMENSION SCALE(NPLT,2),XRATE(NPLT),REF(NPHZ )@@G@@LT,3),DIG(100),X(200) @E@@@@ SUBROUTINE GVESZE(REF,NPLT,NSECT,XMAIA )@@G@@X,XMIN,SCALE) @B@@@@ 5510 GOSUB 11000 @ ANALYZE PENALTY @H@@@@IB )@@G@@010090 SELECT INFILE ASSIGN TO UNISERVO D. IC )@@G@@UNIVAC@^@@@@ A(I)=I.LS.30 @I@@@@020100 02 JOBNOX ID )@@G@@ PICTURE X(5). M6300350 @I@@@@050030 0IE )@@G@@2 ITTIME USAGE COMPUTATIONAL SYNCHRONIZED RIGHT M6300800 IF )@@G@@@G@@@@C THIS ALGORITH OUTPUTS ONE PIECE OF INFORMATION PER LINE, TRAIG )@@G@@VEF @H@@@@C THIS ALGORITH OUTPUTS ONE PIECE OF INFORMATION PER LINIH )@@G@@E, TRAVERSING @E@@@@ DO 3 , LMJ X1,L(MEMPAR) . MER 2,3,II )@@G@@4 FAULTS @^@@@@ DO 912 J=1,KP @I@@@@040090- . IJ )@@G@@ M6300630 @C@@@@P=1,2,IK )@@G@@3,4,5,6,7,8,9,10,Q=1,2,3,4,5,6,7,8,9,10* @[@@@@END; @]@@@@ END;IL )@@G@@@ @@@@SOURCE := ALTERNATE[SOURCE]; @]@@@@GO TO SET; @#@@@@ INTEGER COIM )@@G@@DE; @I@@@@040120 02 UNAME PICTURE X(10) SYNCHRONIZED LEFT. IN )@@G@@ M6300660 @B@@@@ SUBROUTINE NWPLTR(XREF,NPLT,NUMPLT)IO )@@G@@@I@@@@050050 02 JOBNO PICTURE X(5) SYNCHRONIZED LEFT. IP )@@G@@ M6300820 @D@@@@15080 DATA 55,22,2611,4,7,3,5,2,3,2,0,1,9,2602,8IQ )@@G@@,8,5,5@G@@@@15090 DATA 3, 3,2602,0,-3,-3,0,-4,-3,-5,-5,-6,-2607,-8,2701,IR )@@G@@2705,-6,2199@D@@@@ 77 DIS PICTURE $$$$$$.99. IS )@@G@@@#@@@@ I = I+1 @]@@@@ RETURN@#@@@@S10002050030000 @I@@@@IT )@@G@@010170 02 CODE1X PICTURE X. IU )@@G@@M6300220 @[@@@@*. @F@@@@*. HEADINGS ARE PRODUCED FOR EACH ELEMENT.IV )@@G@@ IF IT IS DESIRED THAT @G@@@@*. TEXT BE INCLUDED FOR CERTAIN ELEMENTS, IW )@@G@@PREPARE AN ELEMENT OF THE @]@@@@*. FORM: @I@@@@002210 MOVE LEIX )@@G@@AST-NO TO DIS-2. PROBLEM2 @I@@@@IY )@@G@@002220 MOVE NO-OF-NOS TO DIS-3. IZ )@@G@@PROBLEM2 @I@@@@002230 MOVE SUM-OF-NOS TO DIS-4. JA )@@G@@ PROBLEM2 @I@@@@003010 MOVE MEAN-OF-NOS TO DIS-5JB )@@G@@. PROBLEM2 @I@@@@003020 DISPLAYJC )@@G@@ ' 'PROBLEM2 @ @@@@JD )@@G@@ END OF PROGRAM @D@@@@ AN A0,A1 .JE )@@G@@SET A0 = INDEX @ @@@@ DDELT= -A(3,KF)-B(3,KF)@I@@@@040080 0JF )@@G@@2 IPRONO USAGE COMPUTATIONAL SYNCHRONIZED RIGHT PICTURE 9(8)M6300620 JG )@@G@@@ @@@@ CALL PLOTC(X1,Y1,I) @E@@@@ 77 ED-UNDER JH )@@G@@ PICTURE $ZZ,ZZZ.99. @ @@@@ ADIV=ANMB/FLOAT(NDIV) @]@@@@JI )@@G@@X3 $S X3N @]@@@@X4 $S X4N @#@@@@ CODE(I)=0 @#@@@@ REL=ORJJ )@@G@@IGIN+I@^@@@@ D'N OUT(71) @ @@@@C TME(T)( UNITS LATER. JK )@@G@@@]@@@@PUSHDOWN; @ @@@@ INT = SPAN(1234567890) @^@@@@ 8 FORMATJL )@@G@@ (1H0,( @I@@@@010030 ENVIRONMENT DIVISION. JM )@@G@@ M6300070 @^@@@@006100 02 BSEC-N/ @^@@@@006060JN )@@G@@ 02 RECR @^@@@@ MDIV=ADIV+0.5 @B@@@@ W'R .NOJO )@@G@@T. C(8) .AND. I.NE. 101 @E@@@@C CHECK IF DESIRED ITEM IS A CONSTANT ANDJP )@@G@@ THEREFORE IN THE @A@@@@T;' ';X1;X2;X3;X4;Y1;Y2;Y3;Y4 @]@@@@T $S TJQ )@@G@@+1 @ @@@@ CALL PLOTC(X4,Y4,3) @ @@@@$G LOOP # $I (T $> MAXYRJR )@@G@@) @^@@@@ 384 29 12 25@^@@@@ 439 36 12 34@ @@@@JS )@@G@@ PRINT COMMENT $ $ @]@@@@ GOTO L2> @ @@@@ GO TO RJT )@@G@@EAD-A-REC. @B@@@@BAD LSL EA3 . @]@@@@$COMPIJU )@@G@@LE MAD@]@@@@#I=I+N# @^@@@@ 5320 LET B = B + P8 @[@@@@C @A@@@@JV )@@G@@ MOVE BUD-ALLOW TO BUDGET.@E@@@@ COMMON/G3/VARTBL(MXVARS)JW )@@G@@,BACKCN,OFSET,BLKTBL(MXBLKS), @D@@@@ST9 T'H ST9, FOR XLOG=101,-1,JX )@@G@@XLOG.L.1 .OR. @#@@@@ E'L @ @@@@ START = STARTJY )@@G@@ +1 @H@@@@SGEOG202 0301040000040TUTH8-9.15 Q 210 JZ )@@G@@ 03 @A@@@@ SUBROUTINE NWPLTR (X,NUMPLT) @A@@@@ KA )@@G@@EM=(RML*RML-RMP*RMP)/(2.0*RML)@I@@@@040170 PICTURE 9(5). KB )@@G@@ M6300710 @ @@@@16 TRIPLE(NEXT,KC )@@G@@1)=I+ORIGIN @#@@@@ I=I+1 @^@@@@LOOP CONTINUE @B@@@@KD )@@G@@ D'N THRUS((0...500)*(0...5)) @[@@@@#N=I# @I@@@@040220 0KE )@@G@@2 IETIME USAGE COMPUTATIONAL SYNCHRONIZED RIGHT M6300760 KF )@@G@@@]@@@@TOP:A $S $" @#@@@@$G OK # $I(4>$RA) @[@@@@$I 0 @B@@@@ TKG )@@G@@'H ST4, FOR J=1,1,J.G.XLOG @^@@@@ Y2=SIDEL*SA+Y1 @A@@@@ KH )@@G@@ DO 16 , LMJ X1,L(IGNORE) @[@@@@$I 0 @ @@@@LPS X(I)=X(I)/10.KI )@@G@@P.XLOG@D@@@@ LMJ X2,L(BAD) . GO DISPLAY ADD@B@@@@KJ )@@G@@ YGRID = (YLARGE-YSMALL)/101. @^@@@@ A4 CONTINUE KK )@@G@@@ @@@@ READ (6,2) X(I) I=1,N @A@@@@*. HDG ELEMENTNAME TEXT TEXT TKL )@@G@@EXT...@^@@@@#I=I+(((I*N+N)/I)+N# @[@@@@BEGIN @#@@@@LOCAL LABEL EOF; KM )@@G@@@^@@@@ 424 21 14 32@^@@@@PROCEDURE ERROR(N); @]@@@@ ENKN )@@G@@D; @#@@@@ IDENTIFIER := 0;@B@@@@ FOR I := 1 STEP 1 UNTIL CODE DO BKO )@@G@@EGIN @]@@@@ I=I+1 @E@@@@ SUBTRACT BUD-ALLOW FROM ACT-EXPKP )@@G@@ GIVING DIFF. @C@@@@ IF(INDX.GT.NOIN.OR.INDX.LT.1) INDX=NOIN KQ )@@G@@@[@@@@$DATA @F@@@@ 3 10 05 05 05 05 05 20 05 05 05 05 05 05KR )@@G@@ 05 10 @#@@@@ 68110 @B@@@@ T'H SHIFT,FORI=0,1,KS )@@G@@I.G.130 @]@@@@Y1 $X Y1N @I@@@@040160 02 ICTIME USAGE COMPUTATIKT )@@G@@ONAL SYNCHRONIZED RIGHT M6300700 @B@@@@*. HDG ELEMENTNAMEKU )@@G@@1 TEXT TEXT TEXT TEXT...@[@@@@$G TOP@A@@@@OK: $G 0 #$I($A/'NO '=(3^A,' KV )@@G@@ ') @I@@@@080100 IF INDEX = 0 GO TO ZZ ELSE NEXT SENTENCE, KW )@@G@@ M6301440 @B@@@@ XBAR = ROUND.(XBAR, XGRID) KX )@@G@@@A@@@@ YBAR = ROUND.(YBAR,YGRID)@I@@@@080120 T1. MOVE 99999999KY )@@G@@ TO IPRONOO. M6301460 @A@@@@ KZ )@@G@@ MOVE NUMBER TO ACCT-NUM. @]@@@@$G NEXT1 @]@@@@ END;@D@@@@LA )@@G@@ IDENTIFIER; COMMENT FIRST TWO ALTERNATES; @ @@@@INTEGER GOALLB )@@G@@, SOURCE,CHAR,Y; @]@@@@NEXT2: REDO @[@@@@$CBEND@^@@@@007010 03LC )@@G@@ MS @^@@@@006200 03 S @E@@@@0.330000E+00 0.0000 3.8951LD )@@G@@54E+010.621540E+003.800000E+01@A@@@@ MOVE TOT-UNDER TO DIS. LE )@@G@@@I@@@@003190 DISPLAY 'THE MEAN OF NUMBERS IS ' DIS-5 UPON SYSOULF )@@G@@1. PROBLEM2 @#@@@@ GO TO 50 @]@@@@ X=6.0 @#@@@@ RELG )@@G@@TURN: END; @]@@@@#I=N*+I# @#@@@@ 5550 GO TO 1000 @#@@@@ GO TO LH )@@G@@1 @D@@@@INTEGER ARRAY GYOYO(1:100),SYOYO(1:100),CYOYO(1:100); @ @@@@LI )@@G@@SET: GOAL := TYPECODE[SOURCE];@#@@@@ CT=CY @I@@@@060220 MLJ )@@G@@OVE JOBNOX TO JOBNO. M6301050 LK )@@G@@@F@@@@ IF N(THE ERROR NUMBER) IS NEGATIVE, THE ROUTINE RETURNS,LL )@@G@@@^@@@@ 457 26 14 34@B@@@@ OTHERWISE IT GOES TO STARTLM )@@G@@; @ @@@@ 1 QUOTE BREAK(QUOTE) @]@@@@X2 $S X2N @^@@@@ LN )@@G@@ END BOOT@^@@@@ DATA NUMPLT/0/ @F@@@@- DIMENSION XRLO )@@G@@EF(ND,3),YREF(ND,3),F(ND),XTEST(100),YTEST(100) @D@@@@#I=(((((I+N)*((I*NLP )@@G@@+N)/N)+(I+N)*N)/N)+(I/N))+I*I)# @E@@@@LOOP JK 1,L(START)LQ )@@G@@ . GO CHANGE PATTERN @G@@@@ 1 L N,9X,18H WAVE FUNCTLR )@@G@@ION ,16H DEFECT FUNCTION ) @#@@@@ 4281R @I@@@@020080LS )@@G@@ 02 IUTIMEX PICTURE 9(5). M63003LT )@@G@@30 @F@@@@ DIMENSION XREF(NC,3),YREF(NC,3),F(NC),XTEST(100),YTESTLU )@@G@@(100) @E@@@@ 77 DIS-A PICTURE $ZZ,ZZ9.99. LV )@@G@@@#@@@@H94553402033580 @I@@@@002170 PAR-4. COMPUTE SUM-OF-NOS = SUM-OFLW )@@G@@-NOS + NO-1. PROBLEM2 @I@@@@002180 GO TO PAR-3. LX )@@G@@ PROBLEM2 @]@@@@(3F6.0LY )@@G@@) @G@@@@ COMPUTE PCT-OVER ROUNDED = ((ACT-EXP - BUD-ALLOW)LZ )@@G@@ / BUD-ALLOW@B@@@@PSR PSRFRM 0300,0,0,037,040 . @#@@@@ MA )@@G@@G= -2.0 @I@@@@040190 PICTURE 9(5). MB )@@G@@ M6300730 @^@@@@006060 02 RECORD @F@@@@ MC )@@G@@ ) * 100, ON SIZE ERROR DISPLAY 'OVERFLOW' UPON SYSOU1. @G@@@@ MD )@@G@@DIMENSION BS(5,5,5), AM(10,10), BM(10,10), KS(5,5,5),X(10,1) @I@@@@ME )@@G@@080070 COMPUTE TEST = SWITCH1 / 10. MF )@@G@@M6301410 @B@@@@ DEFINE XFIELD=FLD(14,4,CODE(I)) @B@@@@ MG )@@G@@DEFINE HFIELD=FLD(18,1,CODE(I)) @I@@@@080080 COMPUTE TEST1 = TESMH )@@G@@T * 10. M6301420 @B@@@@ LMMI )@@G@@J A1,L($+1) . @F@@@@C TO THE DRIVER ROUTINE SO AS TO BEMJ )@@G@@GIN NEXT COMPLIATION IF ANY @A@@@@ CALL GEN(LX,0,WREG,REL,0) MK )@@G@@@^@@@@CGEOG4 SEM GEOG AFRICA@^@@@@ 5000 REM RUNNING PLAY @C@@@@OPN ML )@@G@@ OPN = X / NULL :(RETURN) @[@@@@*. @B@@@@ TMM )@@G@@'H SQUEEZ, FOR I=11,1,I.G.71 @#@@@@ E'L @F@@@@ WMN )@@G@@HENEVER YLARGE.NE.0., YLARLG=.434*ELOG. (.ABS.YLARGE) @[@@@@*. @[@@@@MO )@@G@@*. @[@@@@*. @#@@@@ FETCH;@^@@@@ WRITE(ACCEPT,CARD); MP )@@G@@@G@@@@ 77 BUD-TOT PICTURE 99999V99 VALUE ZEROMQ )@@G@@. @C@@@@ WHENEVER XNLOG.G.XLOG, XLOG=XNLOG @ @@@@ 51MR )@@G@@ 0 0 0 0@ @@@@ 59 0 0 0 0@^@@@@$G ENDMS )@@G@@ # $I (INPUT) @#@@@@F88112500020000 @C@@@@ R AND NOW FOLKMT )@@G@@S WE INCLUDE BADPLT. @H@@@@010060 SOURCE-COMPUTER. UNIVAC-1108. MU )@@G@@ UNIVAC@ @@@@ FUNCTION RETURN N MV )@@G@@@E@@@@*. THIS SAYS TO START LOOKING AT THE ELEMENT WITH SEQUENCE @I@@@@MW )@@G@@080170 GO TO B2. MX )@@G@@M6301510 @C@@@@ THROUGH S4, FOR I=START,1,I.G. NDATA @C@@@@MY )@@G@@ 1.79120+00 1.01927-01 1.12776+01 9.48640+00@[@@@@/ @I@@@@001070MZ )@@G@@ OBJECT-COMPUTER. IBM-7094. PROBLENA )@@G@@M2 @ @@@@ CHANGE=CHANGE-5 @#@@@@/[[#1],I,3,1]& @G@@@@NB )@@G@@*. PROCESS GENERATES PROCESSOR CALL CARDS FOR EACH TYPE (DOC, ASM...) NC )@@G@@@C@@@@NEXT T'H MATCH, FOR I=0,1,I.G.5.OR.FLAG1 @F@@@@ WND )@@G@@'R WORD(0).E.$ENDOFC$.OR.(WORD(0).A.MASK).E.$E'L@@@$ @#@@@@ READ-NE )@@G@@A-REC.@A@@@@*. CALL IS *PROCESS PROCESS TYPE @]@@@@'Y4: ';Y4DO@I@@@@NF )@@G@@001140 02 FILLER PICTURE X(9). NG )@@G@@PROBLEM2 @#@@@@ 77 FORMAT(F8.5)@[@@@@*. @B@@@@ 10 IF((ABS Y-INH )@@G@@) .LE. .1E-8) GO TO 200 @D@@@@ 'PCT OVER ', 'PCT UNDER'UPON NI )@@G@@SYSOU1. @H@@@@ 91 FORMAT (3X,F4.1,4X,F10.6/3X,F491,4X,F10.6/3X,F4NJ )@@G@@.1,4X,F10.6/3X,F4.1, @^@@@@ WRITE(F1,M,ANS)$ @[@@@@*. @[@@@@NK )@@G@@*END @D@@@@ 02 ACT-EXP PICTURE 999V99. @I@@@@NL )@@G@@001160 02 FILLER PICTURE X(66). NM )@@G@@PROBLEM2 @#@@@@X95231261515020 @ @@@@ 75 0 0 0 0NN )@@G@@@E@@@@ CALL BAMWRD (JND,IBUFR(2),MXENT,LENT,NFLE,,NFSCTD,IND)@ @@@@NO )@@G@@ 39 0 0 0 0@I@@@@002020 77 GRTST-NO PICTURE S9NP )@@G@@99V99, VALUE ZERO. PROBLEM2 @#@@@@ ERROR(3); NQ )@@G@@@A@@@@ IF NUMBER THEN ERROR(5); @D@@@@ T'H FILLIN, FNR )@@G@@OR I=MARGIN+TEMP,1,I.G.71 @A@@@@ W'R I.G.J,CARD(I)=$ $ NS )@@G@@@]@@@@ END; @F@@@@ W'R WORD(0).E.$WHENEV$.OR.(WORD(0).A.NT )@@G@@MASK).E.$W'R@@@$ @^@@@@ FLAG1=0B @]@@@@GO TO TAST; @F@@@@NU )@@G@@*. @SSG SKEL,,,,,,SGS/1,Q*F.E (THE HEADING SPECIFICATIONS @ @@@@NV )@@G@@ 82 0 0 0 0@^@@@@FUNNYBOX: GO TO ANYWAY; @#@@@@C REGNW )@@G@@ISTER STACK @]@@@@ANS $S 1 @#@@@@TOP: INP $S $" @A@@@@$G 0 # $I($ANX )@@G@@/'NO '=(3^INP,' ')) @^@@@@ TEMP=TEMP-5 @^@@@@*PROCESS HDGNY )@@G@@ [#1] [*I] @#@@@@FORMAT DIG(A,S10);@[@@@@*END @#@@@@ J=J+1 NZ )@@G@@@I@@@@010150 01 INREC. OA )@@G@@ M6300200 @I@@@@C MAIN PROGRAM TO 'TALK' WITH COBOL BLK-IO OB )@@G@@ROUTINE. M6301550 @ @@@@ W'R CARD(I).NE.$ $ OC )@@G@@@ @@@@ WORD(1)=CARD(I) @ @@@@ FILL.(WORD(0)) OD )@@G@@@ @@@@ OUT(I)=CARD(J) @#@@@@ J=J+1 @H@@@@010130OE )@@G@@ LABEL RECORDS ARE LAB-1 UNIVACOF )@@G@@@F@@@@RUNID MIKE FILE PU@000MIKE PART NO 000 DATE 111870 UNIT CP1 OG )@@G@@@D@@@@ COMPUTE TOT-OVER ROUNDED = TOT-OVER + DIFF.@^@@@@*. IN OH )@@G@@ANY COMBINATION. @^@@@@ CHANGE=0 @]@@@@ V; @[@@@@OI )@@G@@*. @B@@@@COMMENT -- QUICK AND DIRTY INITIALIZATION;@#@@@@#I=I+(I*N-N)OJ )@@G@@+I*I# @C@@@@ IF C EQL BRACKET THEN GO TO ACCEPT; @]@@@@'Y2: OK )@@G@@';Y2DO@^@@@@$EXECUTE IBJOB @I@@@@050020 PICTURE 9(5). OL )@@G@@ M6300790 @C@@@@ PART1OM )@@G@@ = ( $LETTER * '10000' ) / TOTAL @D@@@@ $LETTER = '0' ON )@@G@@ /(DELETE) @C@@@@BEGIN TEXT = SYSPIT /FOO )@@G@@(END) @G@@@@*. SGS SPEC7 AND 8 ARE ALWAYOP )@@G@@S OPTIONAL) @#@@@@ 00554 @^@@@@ TEXT = FILLER @C@@@@OQ )@@G@@ FLAG = '0' /(IN1) @^@@@@NEXT ALPHABET = OR )@@G@@SAVE @#@@@@ TOTAL = '0'@#@@@@ E'L @#@@@@IN FLAG OS )@@G@@= '1' @]@@@@#I=I+I*N# @#@@@@ ACCEPT: END; @#@@@@LOCAL LABEL DONE; OT )@@G@@@]@@@@GO TO TEST; @ @@@@*INCREMENT I FROM 1 TO [[#1]] @E@@@@ J OU )@@G@@ OK . YES, GO SET NEW ENTRY POINTER @^@@@@FORMAT INPUT(A,S80OV )@@G@@); @D@@@@FORMAT AOK(S80,A1,' IS AN ACCEPTABLE STRING.',A1.2); @[@@@@OW )@@G@@C @A@@@@*. THE PROCESSOR CALL CARD, I.E. @B@@@@ PRINT FOX )@@G@@ORMAT SCALE, H...H(10) @D@@@@EC0120 NOP . ****** TEMP ****** TO TESOY )@@G@@T ALGORITHM @I@@@@ STOP OZ )@@G@@ M6301630 @[@@@@*. @C@@@@*. COPY EVERYTHING YOU WPA )@@G@@ANT LISTED INTO TPF$ @B@@@@ 5300 GOSUB 11000 @ ANALYZE PENALTY PB )@@G@@@#@@@@ END @I@@@@060210 MOVE ITTIMEX TO ITTIME. PC )@@G@@ M6301040 @I@@@@ SUB HOLD PD )@@G@@ .719.GWB @ @@@@IN PE )@@G@@ STRING = TRIM(INPUT) @I@@@@ TZE *+2 PF )@@G@@ .719.GWB @B@@@@ E$MSG CAT PG )@@G@@ . @C@@@@ E; COMMENT PRECEEDED BY AN 'E'; PH )@@G@@@#@@@@ JFIELD=J1 @B@@@@ WHENEVER X(I).L.XLO,X(I)=XLO PI )@@G@@@^@@@@*IF [[#1],[#2],3]>0 @C@@@@ THROUGH S3, FOR IPJ )@@G@@=0,1,I.G.100@B@@@@ THROUGH ST1, FOR I=10,10,I.G.99@^@@@@ 641PK )@@G@@ 29 09 22@A@@@@ IDENTIFICATION DIVISION. @ @@@@ 5250 PL )@@G@@IF Y2 = 26 THEN 5075 @ @@@@$* RELEASE TAPE AFTER PLOT @^@@@@$G BADPM )@@G@@ $I # (3 $> $R A) @E@@@@ HJ L($+1) . GET MAX PN )@@G@@ADDRESS @^@@@@ 449 31 12 28@F@@@@*. IF IT IS NOT DESIRED PO )@@G@@TO START AT THE BEGINNING OF TPF$. THE @ @@@@Y4DO $S '35 $L (X1 $L X4PP )@@G@@)' @B@@@@*. STARTING ELEMENT CAN BE SPEICFIED. @I@@@@002090 77 DPQ )@@G@@IS-3 PICTURE 99. PROBLEM2 PR )@@G@@@[@@@@C @ @@@@ DIMENSION XREF(NPLT,3) @^@@@@ W'R C(1PS )@@G@@3) @#@@@@ 3472Q @#@@@@ 7920Q @#@@@@'WHICH ONE$QPT )@@G@@' @E@@@@'INPUT ''THING TO BE CHANGE IMMEDIATELY FOLLOWED BY AN I''' PU )@@G@@@G@@@@1 PV )@@G@@6 10@I@@@@060030 ENTRY POINT IS 'READR' PW )@@G@@ M6300860 @]@@@@#I=I*N)# @]@@@@#I+N*I# @#@@@@ PX )@@G@@ FETCH;@]@@@@C1 THIS @#@@@@BAD:'TRY AGAIN' @#@@@@#I=(I+I)(I/NPY )@@G@@)# @D@@@@ DISPLAY 'TOTAL UNDER IS ' DIS UPON SYSOU1. @]@@@@PZ )@@G@@#I=(I+N)I# @[@@@@#I=I @E@@@@ SUBROUTINE YAXIS(YSCALE,YREF,XREF,NPQA )@@G@@LT,NAX,NSIDE) @ @@@@ GO TO RETURN; @#@@@@ QB )@@G@@END; @#@@@@#I=I+(I*N-N)+I*I# @#@@@@ PLACE=0@#@@@@ CODE(IQC )@@G@@)=0 @E@@@@ WRITE ACCT-ANALYSIS FROM ACCT-ANALYSIS-WORK. QD )@@G@@@A@@@@ NBEX = OPN('.NOT.') B BEQ @I@@@@001050 CONFIGURATION SECQE )@@G@@TION. PROBLEM2 @I@@@@020110QF )@@G@@ 02 IRESTX PICTURE X(8). M63003QG )@@G@@60 @I@@@@ WRITE (6,80) IN,IX,ITEM QH )@@G@@ ******** @G@@@@1 QI )@@G@@ 5 10@C@@@@ 1 25 50 QJ )@@G@@ 25 @#@@@@ 2 20 20 60 @I@@@@003220 CLOSE DATA-FILE-1. QK )@@G@@ STOP RUN. PROBLEM2 @[@@@@$CBEND@#@@@@QL )@@G@@ XFIELD=XX1 @^@@@@ WRITE(N,TOT)> @F@@@@ 77 TOT-UNDQM )@@G@@ER PICTURE 99999V99 VALUE ZERO. @#@@@@ ERROR(5); QN )@@G@@@[@@@@$DATA @B@@@@ DIMENSION REF(NPLT,3),SCALE(NPLT,2) @B@@@@XDO[4;QO )@@G@@] $S 'X[4;T-1] + DT#(Y[3;T]-Y[4;T])'@C@@@@YDO[1;] $S '((T=15)#30) + (T $QP )@@G@@= 15) # T+ 19' @C@@@@ W'R C(11).AND.C(7), TRANSFER TO A5 QQ )@@G@@@^@@@@ YSMALL=Y(0) @E@@@@ 0.33000+00 0.0000 3.89535+01QR )@@G@@ 0.62350+00 3.80000+01@B@@@@ DIMENSION REF(NPLT,3),SCALE(NPLT,2) QS )@@G@@@D@@@@ NUM = OSG OPN( 'E' INT ) OPN( 'E' OSG INT ) @I@@@@080160QT )@@G@@ CLOSE OUTFILE. M63015QU )@@G@@00 @#@@@@ P=P+11.25 @B@@@@ HJ L(START) QV )@@G@@ . @^@@@@WEF 'BOOTAPE' @#@@@@ GO TO 5 @[@@@@15 QW )@@G@@@I@@@@060140 MOVE IDATEX TO IDATE. QX )@@G@@ M6300970 @C@@@@ THROUGH LPS, FOR I=0,1,I.G.NDATA QY )@@G@@@^@@@@ 529 38 11 23@^@@@@ 496 20 12 25@[@@@@B $S 0QZ )@@G@@@D@@@@'AND FOLLOW THAT WITH $S AND THE NEW INITIAL VALUE' @[@@@@$E $" RA )@@G@@@^@@@@ ROW(J)=CHAR @#@@@@ 5500 GO TO 5170 @ @@@@ 0RB )@@G@@00142200016000 @#@@@@#I=I+(I*N-N)+(I*I#@[@@@@#I=N# @]@@@@ VALUE N;RC )@@G@@@B@@@@S3 ROW(I)=600000000000K @[@@@@-45,48@A@@@@ RD )@@G@@ ADD BUD-ALLOW TO BUD-TOT.@D@@@@ 77 DIFF PIRE )@@G@@CTURE 999V9999. @#@@@@ INTEGER N; @]@@@@Y2 $X Y2N @]@@@@Y3 $S RF )@@G@@Y3N @A@@@@ THEN IDENTIFIER := LOOKFOR[I]; @D@@@@ 02 FILRG )@@G@@LER PICTURE X(5). @^@@@@ XGR2=XGRID/2.@#@@@@RH )@@G@@ 0751K @G@@@@15180 DATA 2,2,-1,-2,-6,0,-7,-2604,-8,-6,-9,-8,-RI )@@G@@11,7701,-4,-2103,-2203 @#@@@@ X3=X3+R @#@@@@ Y3=Y3+S RJ )@@G@@@F@@@@ 3 10 05 05 05 05 05 20 05 05 05 05 05 05 05 10 RK )@@G@@@#@@@@ X4=R+X1 @]@@@@Y4I $S 20 @]@@@@X1I $S 20 @F@@@@ RL )@@G@@ VECTOR VALUES MKLINE=$1H9,S12,F8.3,3H --,101C1,3H-- *$@]@@@@ ENDRM )@@G@@; @G@@@@1 RN )@@G@@ 6 10@E@@@@ VECTOR VALUES LINE=$1H9,S22,1H+,101C1,1H+, RO )@@G@@*$ @ @@@@ END OF CONDITIONAL @^@@@@ORDER CONTINUE RP )@@G@@@]@@@@Y4 $S Y4N @G@@@@ IF TERMINAL[I] AND ALPHABETIC(TYPE[I]) AND TRQ )@@G@@YPE[I] EQL CARD[CHAR] @^@@@@ GO TO ACCEPT; @]@@@@ END; RR )@@G@@@A@@@@ IF N GTR 0 THEN GO TO START; @ @@@@ D'N SQUASH(12RS )@@G@@) @^@@@@ EX4 = EVAL( EX) @]@@@@X2I $S 100 @#@@@@'INPUT YES ORT )@@G@@R NO' @#@@@@$G NEXT# $I(INPUT)@]@@@@'X1: ';X1DO@I@@@@070040 RECEIVERU )@@G@@ IPRONO, CODE1, UNAME, IDME, IDATE, ITIME, ICTIME, M6301130 @#@@@@RV )@@G@@ BLOCK-6. @A@@@@ ADD ACT-EXP TO ACT TOT. @#@@@@ RW )@@G@@INTEGER N$ @I@@@@020170 02 CODE1O PICTURE X. RX )@@G@@ M6300420 @ @@@@ IF C EQL 'N' THEN BEGIN @^@@@@RY )@@G@@ NUMBER := TRUE; @^@@@@ STOP RUN. @#@@@@B28882005021RZ )@@G@@015 @I@@@@030010 02 IUTIMEO PICTURE 9(5). SA )@@G@@ M6300510 @^@@@@15250 REM 9 MAN,0-9 @I@@@@020120 FD OSB )@@G@@UTFILE BLOCK CONTAINS 10 RECORDS, M6300370 SC )@@G@@@C@@@@ 1 10 10 50 20 10 @ @@@@ WRITE SD )@@G@@(F1,N,FACTORIAL) @[@@@@C @[@@@@-52 @#@@@@ N1 = J/5+1 @ @@@@SE )@@G@@ 122 0 0 0- 32@^@@@@15190 REM 7 MAN,0-9 @ @@@@ SF )@@G@@ R = SIZE(PART1) - '2' @A@@@@ PART1 *WHOLE/R* *PART/'2'* @F@@@@SG )@@G@@C-- USED DURING THE REMAINDER OF THE PROCESS. CODE INDICATES @#@@@@SH )@@G@@ J=3 @]@@@@'Y3: ';Y3DO@B@@@@ W'R I.E.72,CHANGE=CSI )@@G@@HANGE+5 @ @@@@ 42 0 0 0 0@B@@@@$ID ELLIS,REID SJ )@@G@@ *403/15/102*10S*NODECK$@#@@@@POP2: POPUP(2); @A@@@@IF SOURCE EQL 0 THSK )@@G@@EN GO TO EXIT; @ @@@@D1234 FORMAT(5X,9(O12,1X)) @I@@@@040210 PSL )@@G@@ICTURE 9(5). M6300750 SM )@@G@@@B@@@@ 11 FORMAT (1H0,'ITERATION ',I2,/) @E@@@@ COMMON/G1/CLSN )@@G@@ASS,SYMBOL,POINT,ZEND,CARD(80),SRCLIN @A@@@@ Y=YREF(I,J)+DEL*FLSO )@@G@@OAT(I-1) @ @@@@ END OF FUNCTION @#@@@@ J=J-1 SP )@@G@@@#@@@@ J=0 @]@@@@A1 $S 10 @A@@@@*. @SSG SKEL,/Q,,,,,SGSSQ )@@G@@/1,FILE.EL @ @@@@ W'R J.LE.0,T'O QUIT@#@@@@ TEMP=0 SR )@@G@@@ @@@@ 102 0 0 0 0@ @@@@ IMPLICIT INTEGER (A-Z) SS )@@G@@@#@@@@ UFIELD=U1 @[@@@@ 2 @#@@@@ FLAG=0B@#@@@@ ST )@@G@@ FETCH; @^@@@@ WRITE(REJECT,CARD); @#@@@@ GO TO START; @ @@@@SU )@@G@@ CODE(I)=BCKCNT(TRIP) @]@@@@ I=I+1 @ @@@@ CODE(I)=OFFSSV )@@G@@ET(TRIP) @A@@@@ELAPD 'ELAPSED TIME IS NOW : &' @#@@@@ ERROSW )@@G@@R(2); @]@@@@ END;@F@@@@ SYSPOT = '0 THE CHARACTER ' LETTER SX )@@G@@' APPEARED ' $LETTER @D@@@@ READ TRANS-FILE AT END GO TO WRSY )@@G@@ITE-TOTALS. @[@@@@BEGIN @A@@@@ IF C NEQ BRACKET THEN ERROR(1) @]@@@@SZ )@@G@@ N = 4@^@@@@$G NEXT # $I (INPUT) @A@@@@ 5040 GOSUB 12000 @ANATA )@@G@@LYZE PLAY @ @@@@ JGD R4,FILE @[@@@@*. @B@@@@ TB )@@G@@ + N . @#@@@@R91118507590000 @E@@@@. TC )@@G@@ ' TIMES, OR ' WHOLE '.' PART ' PERCENT.' /(NEW) @ @@@@ 84 0TD )@@G@@ 0 0 0@A@@@@ MOVE NUMBER TO ACCT-NUM. @]@@@@END TE )@@G@@ START@#@@@@MATCH C'E @A@@@@*. GENERATE CONTROL CARDS BY TYPE TF )@@G@@@[@@@@*. @[@@@@*. @ @@@@ END START @ @@@@ TG )@@G@@ E$MSGR TRAILR @B@@@@#[[#1],I,1,1],[[#1],I,1,2] [[#1],I,2,1]& TH )@@G@@@B@@@@ TE,U A3,L(END) . @#@@@@POP3: POPUP(3); TI )@@G@@@B@@@@ T'H PRINT ,FOR J=0,1,I.G.130000@#@@@@ E'L TJ )@@G@@@ @@@@ 114 0 0 0 0@D@@@@ 02 BUD-ALLOW TK )@@G@@ PICTURE 999V99. @^@@@@ 01 TRANS-RCD. @I@@@@070150 MTL )@@G@@OVE IATIME TO IATIMEO. M6301240 TM )@@G@@@I@@@@003130 DISPLAY 'THE LEAST NUMBER IS ' DIS-2 UPON SYSOU1. TN )@@G@@ PROBLEM2 @^@@@@*PROCESS PROCESS MAP @#@@@@ READ(5,30) PTO )@@G@@@H@@@@SGEOG476 0101018000018MWF1 Q 232 TP )@@G@@ 03 @ @@@@ PARAMETER MXCONS = 100 @]@@@@*. NUMBER 7.@]@@@@TQ )@@G@@PROCEDURE S;@[@@@@C @ @@@@ IF(NAX.LT.2) GO TO 200 @#@@@@D44221TR )@@G@@000010000 @^@@@@IN1 ALPHABET = SAVE @#@@@@ GO TO 1 @F@@@@TS )@@G@@ 3 10 05 05 05 05 05 20 05 05 05 05 05 05 05 10 @C@@@@TT )@@G@@SCAN ALPHABET *LETTER/'1'* = /S(BACK)@I@@@@$ ASSEMBLE TU )@@G@@ EESOR001.719.GWB @E@@@@TV )@@G@@ FLAG '0' /S(PRINT)F(BEGIN) @^@@@@ TW )@@G@@ HOLD=Y(I) @I@@@@9999 9999 9999 TX )@@G@@ 9999 9999 @@@@@@@^@@@@ 630 27 12 25TY )@@G@@@^@@@@FORMAT BET(A,S26,S1); @F@@@@ HJ L($+1) TZ )@@G@@ . GET RIGHT HALF OF PATTERN @ @@@@ SYSPOT = '0' TEXT @C@@@@UA )@@G@@ TEXT *FILLER* '_' /F(IN) @E@@@@COMMA T'H COMUB )@@G@@MA, FOR I=15,1,I.G.71.OR.CARD(I).E.$,$ @C@@@@BACK TEXT LETTER = UC )@@G@@ /F(SCAN)@^@@@@ SYSPOT = '1' @^@@@@ IUD )@@G@@NTEGER I,A @^@@@@ EX = AEX / NBEX @ @@@@$G R8 # $I(INITYR $0 @^@@@@*SET S TO [START,1,1,1] UL )@@G@@@F@@@@ P'T $(1H ,72A1)*$,CARD(0)...CARD(10),OUT(11)...OUT(71) UM )@@G@@@[@@@@*. @ @@@@ 91 0 0 0 0@E@@@@ 1WORD(0)UN )@@G@@.E.$OTHERW$.OR.(WORD(0).A.MASK).E.$O'E@@@$@^@@@@ + 0 UO )@@G@@@#@@@@ E'L @I@@@@060050 ICTIME, IATIME, ILTIME, IETIME,UP )@@G@@ IUTIME, ITTIME, JOBNO, IREST.M6300880 @#@@@@*. WILL GENERATE: @C@@@@UQ )@@G@@ ENTRY PAR(X1,Y1,SIDEL,SIDEW,ANGLE,NO) @C@@@@*. @HDG ** DOC/VERUR )@@G@@SION ** < TEXT IF SUPPLIED > @^@@@@ TEMP=TEMP-5 @B@@@@ US )@@G@@ E$DIT EPKT . @#@@@@SQUISH C'E @^@@@@ 151 UT )@@G@@FORMAT(2F20.10) @#@@@@FILLIN C'E @]@@@@ 5 I=3 @]@@@@ UU )@@G@@END @B@@@@ COMMENT THEN '=', PRECEEDED BY 'V'; @ @@@@ IF C EQLUV )@@G@@ EQUAL THEN BEGIN @F@@@@ SOR = INT / NUM / NAME '(' ******$('EXP' UW )@@G@@N) ')' / NAME / @ @@@@ PTR=TOT=FACT[0:=1>@]@@@@R8: REDO UX )@@G@@@]@@@@ GO L2; @B@@@@ DEFINE IFIELD=FLD(19,1,CODE(I)) @]@@@@UY )@@G@@DO[] $S A @B@@@@ DEFINE UFIELD=FLD(20,16,CODE(I)) @]@@@@'ANYMOUZ )@@G@@RE$Q' @#@@@@$G R2#$I(INPUT) @ @@@@FOR I := 1 STEP 1 UNTIL 9 DO @ @@@@VA )@@G@@ WORD(0)=$ $ @F@@@@ILLEGAL CHARACTER TO LEFT OF POSSIBLVB )@@G@@E SUB-EXPRESSION(ERROR 9) @^@@@@$F ANS $S INPUT;INP @#@@@@ VC )@@G@@ O'E @A@@@@ ROW(J)=600000000000K @E@@@@ SUBROUVD )@@G@@TINE GVRATE(SCALE,REF,NPLT,NSECT,XMIN,XRATE) @]@@@@-+/*)#(= @[@@@@VE )@@G@@*END @^@@@@ OPERATOR := FALSE; @ @@@@*. GENERATE HEADING CARDS VF )@@G@@@^@@@@ INTEGER X,Y,Z@ @@@@ AND,U A0,077 @^@@@@VG )@@G@@ DO 150 I=1,NPLT @E@@@@0.005690E+00 0.0000 3.380728E+003.3750VH )@@G@@38E+00 0.0000 @ @@@@ IF N GTR 0 THEN GO TO EOF; @E@@@@0.004440E+00VI )@@G@@ 0.0000 1.064234E+011.063790E+01 0.0000 @^@@@@ C EQL DIVIVJ )@@G@@DE OR @^@@@@READ(BET,ALPHA,BLANK); @^@@@@ DO 100 I=2,NAX @[@@@@VK )@@G@@*. @]@@@@$G AGAIN @^@@@@PROCEDURE PUSHDOWN; @]@@@@ END;VL )@@G@@@]@@@@ NO=2 @E@@@@ IF(BLKREF(OFFSET(TRIPLE(NEXT,2))).LE.1) GOVM )@@G@@ TO 160 @B@@@@ DN = NAME '(' *** $( 'EXP' N) ')' @A@@@@DOES CVN )@@G@@OMPUTER WORK DRIVE YOU CRAZY? @[@@@@*. @#@@@@*. @SSG SKEL,/Q @^@@@@VO )@@G@@ TYPECODE[J] := I; END;@ @@@@ SQUASH(J)=CARD(I) @C@@@@ VP )@@G@@ 02 FILLER PICTURE X(5). @]@@@@ R @#@@@@ VQ )@@G@@DBDS=-0.76 @ @@@@ 5130 IF Y2 = 26 THEN 5075 @#@@@@READ(DIG,NUM); VR )@@G@@@^@@@@15220 REM 8 MAN,0-9 @F@@@@*. SCAN TPF$ AND GENERATE SGS'S FOR VS )@@G@@ELEMENTS IF SPEC 2 PRESENT @[@@@@*. @ @@@@ TW A9,AVT )@@G@@1 @F@@@@ V'S YB=$1H ,S50,H+ EMPLOT HAS CALCULATED YBAR +*VU )@@G@@$ @ @@@@C--- REPAIR "ELSE" BRANCH @#@@@@ 57244 @#@@@@VV )@@G@@ 60849 @C@@@@ 1 05 10 10 10 10 10 10 10 10 10 05 VW )@@G@@@#@@@@ 2 50 25 25 @]@@@@ BEGIN @B@@@@ IF IDENTIFIER EQL N VX )@@G@@THEN GO TO AOK; @]@@@@*IF [HDG]>0 @[@@@@*END @^@@@@ INTEGERVY )@@G@@ H @ @@@@C DO FINAL LABEL TABLE REPAIR@ @@@@ ENTRY TO ROUNVZ )@@G@@D. @#@@@@ P=P+1.0 @#@@@@ Q=Q+45.0 @^@@@@ IF(NOPWA )@@G@@.GE.4) NN=1 @#@@@@$IBJOB GO @ @@@@$IBFTC CALLPL NODECK,M94,XR7 WB )@@G@@@ @@@@ PARAMETER MXLABS = 100 @I@@@@010010 IDENTIFICATION DIVISIONWC )@@G@@. M6300050 @[@@@@BEGIN @H@@@@WD )@@G@@THE FIRST NON-BLANK CHARACTER ON THE RIGHT HAND END OF THE STRING IS NOTWE )@@G@@ # @D@@@@ABNORMAL LEFT END TERMINATION OF STRING (ERROR 2) @A@@@@WF )@@G@@ W'R .NOT. C( 3), P'T XB @D@@@@*IF COLUMN SEARCH FROM HDG,1,1WG )@@G@@,1 FOR [[#1],[#2],2,1] @#@@@@ E$CHAR @I@@@@10 CALL READR(IWH )@@G@@1, I2, I3, NAME, I4, IDATE, ITIME, I5, I6, I7, I8, M6301570 @G@@@@WI )@@G@@1 4 30WJ )@@G@@@I@@@@060240 P3. ENTER LINKAGE-MODE. WK )@@G@@ M6301080 @#@@@@#I=I+(I*N-N)+(I*I#@ @@@@ READ(INPUT,MSG[1,80:WL )@@G@@I]); @#@@@@READ(INPUT,OPERS);@[@@@@*. @[@@@@*. @[@@@@ END; @B@@@@WM )@@G@@ 6030 LET A1 = P0(I1,A1) @ FROM TABLE @F@@@@15210 DATA 5,4,3,0,0,0,0WN )@@G@@,-1,-2603,-5,-4,-6,-5,-7,-7704,4,2107,-4 @B@@@@ 150 FORMAT(//,10X,4HBEWO )@@G@@TA,20X,4HDBDS,//) @]@@@@X2 $S X2I @I@@@@ ADD =1 WP )@@G@@ .719.GWB @I@@@@ STO WQ )@@G@@ J .719.GWB WR )@@G@@@I@@@@ PAX ,2 WS )@@G@@ .719.GWB @I@@@@ CLA HOLD,2 WT )@@G@@ .719.GWB @I@@@@ TMI BACK3 WU )@@G@@ .719.GWB @C@@@@ PWV )@@G@@'T $(1H ,132A1)*$,A(0)...A(131) @I@@@@020010 02 IDMEX WW )@@G@@ PICTURE X(6). M6300260 @E@@@@1.606782E+01WX )@@G@@2.614842E+012.387630E+017.808480E+00 0.0000 @@@@@@@F@@@@ ANWY )@@G@@,U A0,2 . DONT WIPE LAST ADDR-1 @ @@@@*. LISTINGS WZ )@@G@@INVOKED BY SPEC 2 @B@@@@ E$MSG ELAPD . @E@@@@XA )@@G@@15230 DATA 99,99,2605,3,3,2,3,1,2,0,-1,0,7704,1,6,2606,5,5 @^@@@@ 511XB )@@G@@ 40 16 37@ @@@@#I=I+(I*I-I*N/I+((I+N)-I))# @E@@@@ 77 DXC )@@G@@IS-B PICTURE $ZZ,ZZ9.99. @]@@@@X1 $S X1N @^@@@@XD )@@G@@ Y(I+1)=HOLD @[@@@@C @ @@@@ CALL IOLINK(7,CODE(3)) XE )@@G@@@ @@@@ 000031200607000 @ @@@@ 000041300020000 XF )@@G@@@A@@@@ 5280 PRINT 'ANOTHER FUMBLE!!!' @A@@@@TRAILR '(+1).,F/2/POSXG )@@G@@/2 . &' @]@@@@ E; @B@@@@ IF N EQL 0 THEN FAC=1 ELXH )@@G@@SE @ @@@@ 000051400021000 @E@@@@0.000200E+00 0.0000 XI )@@G@@4.212489E+000.012289E+004.200000E+00@D@@@@ SELECT BUDGET-ANALYXJ )@@G@@SIS ASSIGN TO SYSOU1. @F@@@@ 3 10 10 10 20 20 20 XK )@@G@@ 10 @ @@@@L1 XBAR=XBAR+X(I) @A@@@@ 5490 XL )@@G@@PRINT 'ANOTHER FUMBLE...' @^@@@@ 21 X2=SIDEL*CA+X1 @F@@@@DGEOG4XM )@@G@@98C/TOPICAL INVESTIGATIONS - GEOGRAPHY OF ISRAEL IN THE @ @@@@ XN )@@G@@ XBAR=XBAR/NDATA @ @@@@ L,U R2,99 @#@@@@ XO )@@G@@X=BIG+6.0 @[@@@@$PAUSE@ @@@@ L,U A8,'9' @G@@@@ XP )@@G@@ LMJ X11,RANDOM . INITIALIZE RANDOM ROUNTINNEOID @#@@@@XQ )@@G@@ CODE := 15; @[@@@@*. @[@@@@*. @C@@@@ 1 10 20 17 16 10 XR )@@G@@08 06 06 04 02 01 @I@@@@070030 ENTRY POINT IS 'WRITER' XS )@@G@@ M6301120 @[@@@@END; @#@@@@STRING CARD(XT )@@G@@80); @@@@@@@ @@@@ INTEGER PROCEDURE OPERATOR; @]@@@@Y3I $S 20 @^@@@@XU )@@G@@ CHECK=0B @E@@@@ 'ES BUDGET EXCEEDS ACTUAL), $' XV )@@G@@DIS UPON SYSOU1. @ @@@@ WRITE (6,153) HPC(J) @^@@@@ OUTPUXW )@@G@@T = STRING @B@@@@A1 WHENEVER C(5), TRANSFER TO A2 @#@@@@ XX )@@G@@ YBAR=0.@I@@@@040020 77 SWITCH PICTURE 9(7), VALUEXY )@@G@@ ZERO. M6300560 @[@@@@$(1) @#@@@@ 2 30 40 30 @F@@@@XZ )@@G@@ 3 01 01 01 01 01 03 04 05 08 10 11 12 13 14 15 @A@@@@YA )@@G@@ 138 IF (STDPT(NH).EQ.0) GO TO 141 @A@@@@ 119 IF (WC9EQ.1) WRITE (6,16YB )@@G@@7) @D@@@@ 02 PCT-OVER PICTURE ZZZ.99. @B@@@@YC )@@G@@ THROUGH L2, FOR I=0,1,I.G.NDATA@I@@@@003120 DISPLAY ' YD )@@G@@ ' UPON SYSOU1. PROBLEM2 @B@@@@ RECURYE )@@G@@: IF PTR EQL N THEN GOTO UNSTAK; @A@@@@ + 02000,BEGIYF )@@G@@N @#@@@@'WHCIH ONE $Q' @^@@@@ 20 R=SIDEW*(-SA) @I@@@@040130YG )@@G@@ 02 IDME PICTURE X(6) SYNCHRONIZED LEFT. M63006YH )@@G@@70 @F@@@@ DIMENSION XSCALE(NPLT,2),XREF(NPLT,3),YREF(NPLT,3),NSIYI )@@G@@GN(2) @^@@@@ 5310 IF P8 = 0 THE 5075@ @@@@ UNLI$T . YJ )@@G@@@D@@@@ 02 ACT-EXP PICTURE 999V99.@#@@@@ YK )@@G@@ PAR-OPEN. @I@@@@070220 10. WRITE OUTREC. YL )@@G@@ M6301310 @I@@@@ $I9, I10, I11, IREST) YM )@@G@@ M6301580 @#@@@@FILE GETCHR YN )@@G@@@#@@@@ N=PRT-1> @A@@@@ IF C EQL LPAREN THEN BEGIN @A@@@@YO )@@G@@ MOVE ZERO TO PCT-UNDER.@F@@@@ SUBROUTINE PLOTER(AX,AY,YP )@@G@@NP,NR,NC,XSCALE,YSCALE,XREF,YREF,F) @E@@@@ 77 RUN-OVER YQ )@@G@@ PICTURE 99999V99. @E@@@@ VECTOR VALUES SCALE=$1H9,YR )@@G@@S19,11(F8.3,S2) *$ @E@@@@C BUILD AN 1108 INSTRUCTION ACCORDING TO YS )@@G@@PROPER FORMAT @ @@@@ IF(TRIP.LT.0) GO TO 401 @A@@@@ MYT )@@G@@OVE ZEROES TO PCT-UNDER.@E@@@@ OPEN INPUT TRANS-FILE OUTPUT BUYU )@@G@@DGET-ANALYSIS. @C@@@@ WRITE ACCT-ANALYSIS FROM HEADING. YV )@@G@@@^@@@@ 6000 REM PLUNGE PLAY @C@@@@DGEOG372 2AERIAL PHOTOGRAPHS (03) (PYW )@@G@@-F) /156/ @F@@@@C-- 32 = STRING, 31 = INTEGER, 1 - 29 = OPERATOR. TYPYX )@@G@@E EQUALS @[@@@@20. @^@@@@ E$DIT EPKT@ @@@@ JGYY )@@G@@D R3,TEN @ @@@@ E$MSG ELAPD @[@@@@C @ @@@@YZ )@@G@@ ER TDATE$ @ @@@@ ER PRINT$ @^@@@@ZA )@@G@@ WRITE-A-REC. @F@@@@ DISPLAY 'EXCESSES OF ACTUAL OVEZB )@@G@@R BUDGET, ' ED-OVER @F@@@@ SUBROUTINE PLOTER(AX,AY,NP,NR,NC,XSCZC )@@G@@ALE,YSCALE,XREF,YREF,F) @[@@@@*END @ @@@@ GO TO BLOCK-6. ZD )@@G@@@F@@@@ BLOCK-5. MOVE 'ACTUAL UNDER BUDGET' TO ACCOUNT-STATUS. ZE )@@G@@@F@@@@C-- ZERO EXCEPT IN THE CASE OF NON-TERMINALS, WHICH HAVE TYPE = 1.ZF )@@G@@@H@@@@*CREATE SGS: [PRC,1,TYPE,1] [PRC,1,TYPE,1],[PRC,1,TYPE,2] [Q,Z,1,1ZG )@@G@@] [Q,Z,2,1] @I@@@@-++++0///-AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAZH )@@G@@AAAAAAAAAAAAAAAAAAAAAAAAAA @A@@@@ E ::= E+T \ E-T \ T ZI )@@G@@@[@@@@C @]@@@@T $S INITYR @D@@@@COMMENT ROUTINE TO STEP BACK THRU ZJ )@@G@@A CARD IMAGE. @[@@@@*ELSE @^@@@@*SET TYPE TO [Q,Z,3,1]+8@G@@@@ ZK )@@G@@DIMENSION AX(NR,NC),AY(NR,NC),NP(NC),XSCALE(NC,2),YSCALE(NC,2) @D@@@@ZL )@@G@@ W'R C(17) .AND.C(19) .AND.C(8), T'O S9 @^@@@@X $S Y $S(MAZM )@@G@@XYR,4)$R 0 @I@@@@SCALE 6.94303 1 ZN )@@G@@ CYCLE 2 @ @@@@ IF(F1.GT.70K) GO TO 800 @#@@@@ZO )@@G@@ FFIELD=F1 @ @@@@ 5140 IF ABS(Y2) <> THEN 5300 @#@@@@ 8 L(I)=JZP )@@G@@(I) @]@@@@HUNDRD. @#@@@@ XBAR=0.@F@@@@C CHECK IF THE DEZQ )@@G@@SIRED ITEM IS A TRIPLE WHOSE VALUE IS IN THE @ @@@@200 CALL PLOTC(XZR )@@G@@,-11.0,-3) @]@@@@ GOTOL2; @I@@@@001130 01 NO-RCD. ZS )@@G@@ PROBLEM2 @C@@@@ 1 ZT )@@G@@ 10 10 50 20 10 @ @@@@ CALL GEN(LMJ,0,X11,0,X1)@]@@@@ZU )@@G@@$F CONTINUE @I@@@@070070 B1. ADD 1 TO SWITCH1. IF SWITCH1 = 1 OPEN OUTPUZV )@@G@@T OUTFILE. M6301160 @^@@@@ UPON SYSOU1. @^@@@@ ZW )@@G@@ 01 HEADING. @B@@@@'DO YOU WANT TO DO IT AGAIN$Q (YES OR NO)'@C@@@@ZX )@@G@@ 02 FILLER PICTURE X(3) VALUE SPACE. @]@@@@B $S $" @B@@@@ZY )@@G@@S1 H(10-I)=YBAR-10.*(I-5)*YGRID @#@@@@$G 0 #$I(INPUT) @[@@@@ZZ )@@G@@ END; @@@@@@@#@@@@ 2 40 30 30 @F@@@@ 3 10 05 05 05 05 05 20AA )@@G@@ 05 05 05 05 05 05 05 10 @[@@@@*. @C@@@@*. CALL IS *PROCESAB )@@G@@S HDG TYPE INDEX-INTO-TYPE @A@@@@ MOVE ACT-TOT TO DIS-A. AC )@@G@@@[@@@@$E DO @[@@@@*. DO:@^@@@@ X(I)=X(I+1) @#@@@@ EAD )@@G@@'L @I@@@@040140 02 IDATE USAGE COMPUTATIONAL SYNCHRONIZED RIGHT PAE )@@G@@ICTURE 9(6).M6300680 @^@@@@$IBFTC CALCOM M94,XR7 @#@@@@ 483AF )@@G@@0J @#@@@@ E$TIME @A@@@@ DO 12 , LMJ X1,L(IGNORE) AG )@@G@@@[@@@@$G @^@@@@S2 CONTINUE @ @@@@ PRINT FORMAT AH )@@G@@AXIS @C@@@@$ID ARNOLD KAPLAN*356/13/753*NODECK$TESTA @I@@@@010040AI )@@G@@ CONFIGURATION SECTION. M63000AJ )@@G@@80 @G@@@@15270 DATA 2,1,0,-2,-1,-1,0,-3,-5,-2607,-6,-8,-9,-10,-2,-270AK )@@G@@6,-2107,-8 @#@@@@ SUBPT=UR7 @^@@@@*. ASM ASM,S ELT VER1 @#@@@@AL )@@G@@ 57331 @A@@@@ 26 CALL POP(STACK,TOP,J,$15) @I@@@@070180AM )@@G@@ MOVE IUTIME TO IUTIMEO. M63012AN )@@G@@70 @[@@@@$I 0 @ @@@@ TOTAL = TOTAL + '1' @[@@@@*. @#@@@@AO )@@G@@CONDEL 111111 @C@@@@ $LETTER = $LETTER + '1' /(BACK) AP )@@G@@@A@@@@ IF SOURCE EQL 0 THEN GO TO ERR; @^@@@@PRINT ALPHABET = SAVE AQ )@@G@@@[@@@@ERR: @^@@@@ EX5 = EVAL( EX) @A@@@@ IF(NUMPLT.GT.1) GAR )@@G@@O TO 100 @I@@@@$ PUNCH OBJECT AS )@@G@@ .719.GWB @D@@@@ 02 NU PICTURE X(8) VALUAT )@@G@@E 'ACCT NUM'. @I@@@@* AU )@@G@@ .719.GWB @]@@@@*. @EOF @B@@@@ L,AV )@@G@@U A0,IMAGE . @[@@@@*. @[@@@@C @[@@@@*. ETC@[@@@@AW )@@G@@*. @ @@@@ 75 0 0- 32 0@^@@@@ ER CSF$AX )@@G@@@[@@@@*. @A@@@@ L A0,(0112,IMAGE) @[@@@@*. @ @@@@AY )@@G@@ 000111900018500 @ @@@@ 000122000017000 @ @@@@AZ )@@G@@ 000132100025000 @^@@@@ + 0 @D@@@@STRINGBA )@@G@@ OPERS(80),MINUS(1),PLUS(1),DIVIDE(1),TIMES(1); @E@@@@C DECREASE THEBB )@@G@@ PREDECESSOR COUNT TO OUTPUT THE NODE @[@@@@C @D@@@@R2:'DO YOU WBC )@@G@@ANT TO CHANGE ANYTHING$Q (YES OR NO)' @I@@@@ STO I BD )@@G@@ .719.GWB @I@@@@ BE )@@G@@ PAX ,1 .719.GBF )@@G@@WB @A@@@@ 1.2850 E+04 2.79 E+01 @^@@@@'INPUT EQUATION FOBG )@@G@@R ';A @I@@@@020160 02 IPRONOO PICTURE 9(8). BH )@@G@@ M6300410 @ @@@@ DIMENSION XREF(NPLT,3) @[@@@@DGO BI )@@G@@@B@@@@C ITEMS WERE OUTPUTTED THERE IS A LOOP@E@@@@STRING RPAREN(1),BBJ )@@G@@RACKET(1),LPAREN(1),EQUAL(1),POINT(1); @B@@@@ IF N EQL 3 THEN CHABK )@@G@@R := CYOYO[Y]; @]@@@@*CLEAR TYPE @I@@@@010120 FD INFILE BLOCK CONTAINBL )@@G@@S 10 RECORDS, M6300170 @^@@@@ 5430 IF Y2 BM )@@G@@<> THEN 5470@A@@@@ LABEL RECORD OMITTED. @ @@@@ JGBN )@@G@@D R4,QUAL @#@@@@$G R6#$I(INPUT) @]@@@@R7:CHANGEDO @]@@@@'ANYMOBO )@@G@@RE$Q' @B@@@@ W'R C(6), P'T YSCALE,YLOG*(-1) @C@@@@ PBP )@@G@@RINT FORMAT BLURB , XGRID,YGRID @I@@@@STA2 CLA ,1 BQ )@@G@@ .719.GWB @I@@@@ STO BR )@@G@@ HOLD,1 .719.GWB BS )@@G@@@I@@@@ TTR BACK1 BT )@@G@@ .719.GWB @I@@@@OUT1 CLA =1 BU )@@G@@ .719.GWB @I@@@@ TTR *+3 BV )@@G@@ .719.GWB @I@@@@ CLA BW )@@G@@ I .719.GWB BX )@@G@@@ @@@@GET LMJ X11,RANDOM@I@@@@ STO J BY )@@G@@ .719.GWB @#@@@@*IF [Q,Z,3,2BZ )@@G@@]>0 @^@@@@*SET TYPE TO [Q,Z,3,2] @ @@@@ 125 0 0 0 0CA )@@G@@@I@@@@002147 PAR-3. READ DATA-FILE-1 AT END GO TO PAR-7. CB )@@G@@ PROBLEM2 @I@@@@030020 02 ITTIMEO PICTURE 9(5).CC )@@G@@ M6300520 @#@@@@ ACCEPT: END; @]@@@@*DEFINCD )@@G@@E HDG @#@@@@$G R6 #$I(INPUT) @]@@@@MAXYR $S " @[@@@@*END @[@@@@*. CE )@@G@@@^@@@@*PROCESS PROCESS COB @^@@@@*PROCESS PROCESS ASM @ @@@@ CF )@@G@@ ER EXIT$ @A@@@@ ENTRY COMARG (N,LARG,IARG,JND)@F@@@@CG )@@G@@ DIMENSION XREF(NC,3),YREF(NC,3),F(NC),XTEST(100),YTEST(100) @#@@@@CH )@@G@@DTEMP $S DTEMP+1 @[@@@@$G I4 @C@@@@$G C3 # $I((INP[1] $= 'X') $A (INP[1CI )@@G@@] $= 'Y')) @A@@@@ J=(Y(I)-YBAR)/YGRID+50.5 @]@@@@R5:CHANGEDO CJ )@@G@@@]@@@@ J := 0; @A@@@@ W'R .NOT. C( 5), P'T YB @ @@@@ CK )@@G@@ GO TO BLOCK-6. @A@@@@ T ::= T*P \ T/P \ P @ @@@@CL )@@G@@ P ::= I \ N \ (E) @E@@@@ SUBROUTINE GVRATE(SCALE,REF,NPCM )@@G@@LT,NSECT,XMIN,XRATE) @C@@@@C ITEMS WERE OUTPUTTED SET ERR EQUAL CN )@@G@@-1 @^@@@@R6:'HOW MANY YEARS$Q' @G@@@@1 CO )@@G@@ 6 60@#@@@@ GO TO 1 @]@@@@CP )@@G@@MAXYR $S " @#@@@@'INITAL YEAR$Q' @]@@@@INITYR $S " @ @@@@ MCQ )@@G@@OVE DIFF TO DIS. @I@@@@010180 02 UNAMEX CR )@@G@@ M6300230 @[@@@@$F @#@@@@$F B $S INPUT CS )@@G@@@#@@@@ A(2,5)=2 @ @@@@ PRINT COMMENT $8$ @ @@@@ CT )@@G@@ EXPAT = EX5 RPOS(0) @I@@@@ ADD =1 CU )@@G@@ .719.GWB @I@@@@ STO I CV )@@G@@ .719.GWB @I@@@@ CW )@@G@@ SUB HOLD .719.GCX )@@G@@WB @ @@@@ JGD R2,HUNDRD @I@@@@070080 MOVE IPRONO TCY )@@G@@O IPRONOO. M6301170 @[@@@@$I 0 CZ )@@G@@@B@@@@IMAGE RES 22 . @B@@@@EPKT E$PKT DA )@@G@@ 22,IMAGE . @]@@@@ 2 10 @F@@@@ 3 10 05 05 05 05 DB )@@G@@05 20 05 05 05 05 05 05 05 10 @#@@@@ OPERATOR := 0; @B@@@@DC )@@G@@ FOR I := 1 STEP 1 UNTIL CODE DO BEGIN @]@@@@ I=2 @]@@@@INY:ANDD )@@G@@S $S 0@]@@@@)DEBUG 1 @D@@@@ RES 0200-$ . REDE )@@G@@GISTERS @B@@@@ CALL GEN(LX,0,X4,1,X2) @RESTORE X4 @B@@@@ DF )@@G@@CALL GEN(LX,0,X8,2,X2) @RESTORE X8 @^@@@@DGEOL100 1GEOLOGY (03) @I@@@@DG )@@G@@003160 DISPLAY 'THE SUM OF NUMBERS IS ' DIS-4 UPON SYSOU1. DH )@@G@@PROBLEM2 @A@@@@ DEFINE TYPE = FLD(0,1,TOKEN) @^@@@@ MDI )@@G@@ARGIN=12 @^@@@@ D'N WORD(1) @A@@@@COMMENT ERROR PRINT RDJ )@@G@@OUTINE. @[@@@@BEGIN @I@@@@030030 02 JOBNOO PICTUREDK )@@G@@ X(5). M6300530 @A@@@@ INDX=(FLOAT(INDX-2DL )@@G@@)/ADIV)+0.5 @#@@@@ DO 9 J=1,KP @I@@@@001040 ENVIRONMENT DIVISION. DM )@@G@@ PROBLEM2 @ @@@@ CALL GDN )@@G@@EN(J,0,0,REL,0) @F@@@@15260 DATA 99,99,2604,2,2,1,2,0,1,0,-2,-1,2703,2DO )@@G@@700,2605,4,3,3 @^@@@@CONTINUE:GOAL := 1; @]@@@@SOURCE := 0;@#@@@@DP )@@G@@ ERROR(8); @I@@@@080110 PERFORM T1 INDEX TIMES. GO TO ZZ. DQ )@@G@@ M6301450 @^@@@@ 523 39 12 30@^@@@@DR )@@G@@ 419 30 09 30@D@@@@ 02 PCT-OVER PICDS )@@G@@TURE ZZ9.99.@D@@@@ 02 FILLER PICTURE X(5). DT )@@G@@@B@@@@ MOVE SPACE TO ACCT-ANALYSIS. @A@@@@ DEFINE CODE DU )@@G@@= FLD(1,6,TOKEN) @C@@@@ FORMAT ERR(S80,A1,:I:(X1),'^',A1,S80,A1.1); DV )@@G@@@G@@@@1 DW )@@G@@6 10@H@@@@010100 SELECT OUTFILE ASSIGN TO UNISERVO E. DX )@@G@@ UNIVAC@^@@@@ GO TO ACCEPT; @A@@@@ WRITE(ERR,CHARDY )@@G@@,MSG[ABS(N)]); @B@@@@QUERY: IF TERMINAL[GOAL] THEN GO TO NEXT; @^@@@@DZ )@@G@@ E$DIT EPKT@^@@@@$EXECUTE MAMOS @^@@@@$COMPILE MADEA )@@G@@ ,EXECUTE @B@@@@ R THIS PROGRAM FINALLY MAKES A @C@@@@ EB )@@G@@ R LEGAL CALL OF THE SUBROUTINE EMPLOT.@C@@@@ STRING EXPAT EC )@@G@@ :S(SUCC) F(OOPS) @G@@@@S5 WHENEVER MOD. (Z,5).E.0.AND.Z.NED )@@G@@E.0.AND.Z.NE.M50.AND.C(14) @]@@@@$G AGAIN @[@@@@$F @[@@@@-5,8 EE )@@G@@@#@@@@Y2N $S $E Y2DO @^@@@@ 5530 LET B = B + P8 @#@@@@Y3N $S $E Y3EF )@@G@@DO @#@@@@Y4N $S $E Y4DO @#@@@@ 5110 GO TO 1500 @ @@@@ 5120 REM SOEG )@@G@@METHING HAPPENED @ @@@@$G ENDDOIT # $I(T =MAXYR) @#@@@@X1N $S $E X1EH )@@G@@DO @[@@@@(6X, @E@@@@0.008353E+00 0.0000 2.718493E+002.710140E+00EI )@@G@@ 0.0000 @A@@@@ MOVE TOT-OVER TO ED-OVER.@]@@@@ X=6.0 EJ )@@G@@@I@@@@002150 IF NO-1 GREATER GRTST-NO MOVE NO-1 TO GRTST-NO GO TO PAEK )@@G@@R-4. PROBLEM2 @I@@@@070240 B2. ENTER LINKAGE-MODE. EL )@@G@@ M6301330 @#@@@@ 1 FORMAT (I @A@@@@ 26 EM )@@G@@CALL POP(STACK,TOP,J,$110 @ @@@@ LA,H2 A0,0,A1 . @I@@@@EN )@@G@@040060 77 INDEX PICTURE 9(6). EO )@@G@@M6300600 @D@@@@ 02 PO PICTURE X(8) VALUE 'PCT OVER'. EP )@@G@@@C@@@@ 02 FILLER PICTURE X(4) VALUE SPACE. @D@@@@ 0EQ )@@G@@2 PU PICTURE X(9) VALUE 'PCT UNDER'. @]@@@@ B1 = I@[@@@@*. ER )@@G@@@]@@@@T $S T +1 @#@@@@COUNT $S COUNT+1 @]@@@@DTEMP $S 1 @A@@@@I1: Y[ES )@@G@@T;DTEMP] $S $E YDO[DTEMP;] @^@@@@$G I2 # $I(DTEMP=4) @#@@@@DTEMP ET )@@G@@$S DTEMP +1 @[@@@@$G I1 @#@@@@I2: DTEMP $S 1 @ @@@@I4:X[T;DTEMP] $S $EU )@@G@@E XDO[DTEMP]@[@@@@-17,24@#@@@@ 25007 @]@@@@ R @I@@@@EV )@@G@@070170 MOVE IETIME TO IETIMEO. EW )@@G@@M6301260 @I@@@@040050 77 TEST1 PICTURE 9(7). EX )@@G@@ M6300590 @]@@@@ I=2 @#@@@@X14335400055000 EY )@@G@@@^@@@@15010 REM 4 MAN, 0-69 @^@@@@$EXECUTE IBJOB @^@@@@ EZ )@@G@@S=SIDEW*(-CA) @#@@@@ 2 30 40 30 @ @@@@ IF(NCONS.EQ.0) GO FA )@@G@@TO 14 @ @@@@ REMARKS. ISM 101. @I@@@@080060 THATS-ALL. FB )@@G@@ M6301400 @C@@@@ FC )@@G@@ 02 ACCT-NUM PICTURE X(5). @C@@@@ 02 FILLER FD )@@G@@ PICTURE X(5). @I@@@@070250 RETURN VIA 'WRITER'. FE )@@G@@ M6301340 @D@@@@ 1 18H WAVE FUNCTIONFF )@@G@@ ,16H DEFECT FUNCTION ) @I@@@@020210 02 ITIMEO PFG )@@G@@ICTURE 9(6). M6300460 @^@@@@ ER FH )@@G@@ IOW$@A@@@@$ID BOB CASSELS *001/65/045*10M$@#@@@@$* PLOT TAPE = B5FI )@@G@@@ @@@@ 5520 IF P8 = 0 THEN 5440 @F@@@@ V'S XSCALE=$1H8,S40FJ )@@G@@,H+X VALUES SCALED BY A FACTOR +, @F@@@@*. ELEMENTS WILL BE SORTED BY FK )@@G@@TYPE, PROCS FIRST THROUGH MAPS LAST @B@@@@ ENTRY SQUARE(X1,Y1,SIDELFL )@@G@@,ANGLE) @#@@@@ SIDEW=SIDEL @G@@@@ DISPLAY ' FM )@@G@@ BUDGETARY ANALYSIS' UPON SYSOU1. @G@@@@ VECTOR VALUESFN )@@G@@ BLURB=$ S30,18HX GRID SIZE IS F12.6, S30, @G@@@@ DISPLAYFO )@@G@@ ' ' UPON SYSOU1.@[@@@@FINISH@I@@@@FP )@@G@@080010 B3. ENTER COBOL. FQ )@@G@@M6301350 @C@@@@ LA A1,FBBLOK . AND CURRENT BLOCK @]@@@@FR )@@G@@0 1 1\[1]A @G@@@@ 3002 FORMAT(///4X,3HKK=,I2,3HIK=,I3,4X,3H R=,F12.7//1FS )@@G@@0H L N,9X, @I@@@@ SUBROUTINE REGRES FT )@@G@@ REG00010 @[@@@@C @I@@@@060060 P2. ENTER CFU )@@G@@OBOL. M6300890 @ @@@@FV )@@G@@ HJ L($+1) @C@@@@C CHECK IF JUMP HAS LEFT THE CURRENFW )@@G@@T BLOCK @^@@@@ 01 TRANS-RCD. @D@@@@ 02 NUMBER FX )@@G@@ PICTURE X(5). @E@@@@C THIS SUBROUTINE GENERATES CODE FOFY )@@G@@R LOADING THE VALUE OF @#@@@@500 GO TO 500@G@@@@C BRANCH TO EXECUFZ )@@G@@TE THE COMPILED PROGRAM AND RETURN AFTER EXECUTION @G@@@@1111 FORMATGA )@@G@@(/,5X,27H*END OF FILE ON INPUT TAPE*,/,5X,23H NUMBER OF RES @E@@@@ GB )@@G@@IF (K+2/KK.EQ.4*((K+2/KK)/4)) WRITE (6,3001) KK,IK,R @#@@@@*. SIMPLEST GC )@@G@@CASE @B@@@@'INPUT X1, X2, X3, X4, Y1, Y2, Y3 OR Y4' @]@@@@TRY: A $S $"GD )@@G@@@^@@@@$IBCBC ISM101 NODECK @A@@@@ IDENTIFICATION DIVISION. GE )@@G@@@D@@@@ 02 BUD PICTURE X(9) VALUE 'BUD ALLOW'. @#@@@@ 5270 GF )@@G@@REM FUMBLE @A@@@@ AINDX=ATEM/FLOAT(KMAX-KMIN) @I@@@@002160 IGG )@@G@@F NO-1 LESS THAN LEAST-NO MOVE NO-1 TO LEAST-NO. PROBLEM2 GH )@@G@@@I@@@@060180 MOVE ILTIMEX TO ILTIME. GI )@@G@@ M6301010 @#@@@@ GOTO R1$ @C@@@@ COMPUTE RUN UGJ )@@G@@NDER = ACT-EXP * 0. @E@@@@ SUBTRACT BUD-ALLOW FROM ACT-EXPGK )@@G@@ GIVING RUN-OVER. @D@@@@ IF(K+2/KK. NE. 4*((K+I/KK)/4)) GO TO 20GL )@@G@@0 @C@@@@ PRINT FORMAT LINE, ROW(0)...ROW(100) @I@@@@060231GM )@@G@@ IF IPRONO = 99999999, GO TO WRAPUP. M63010GN )@@G@@70 @[@@@@*. @C@@@@ 1 10 20 17 16 10 08 06 06 04 02 01 GO )@@G@@@D@@@@ILLEGAL CHARACTER ON LEFT END OF EXPRESSION (ERROR 4) @B@@@@ GP )@@G@@ WHENEVER Y(I).L.YLO, Y(I)=YLO @ @@@@ INDX=AINDX*ANMB+2.5 GQ )@@G@@@^@@@@C INDX=(INDX-2)/NUSE@B@@@@ J GET GR )@@G@@ . @]@@@@#I=(I+N)I# @[@@@@#I=I @^@@@@ REL=ORIGIN+I+1 @B@@@@GS )@@G@@MISSING REPLACEMENT OPERATOR (ERROR 3) @ @@@@ PRINT FORMAT GT )@@G@@AXIS @#@@@@ 56789 @]@@@@ NO=2 @F@@@@C-- THE TYPE OF TEGU )@@G@@RMINAL, I.E., 30 = SIMPLE VARIABLE, 34 = ARRAY @C@@@@ WHENEVEGV )@@G@@R YLARLG.G.YLOG, YLOG=YLARLG @B@@@@ IF OPERATOR EQL N THEN GO TO AOKGW )@@G@@; @]@@@@CALL: S; @#@@@@WRITE(AOK,CHAR); @B@@@@ J GX )@@G@@ OUT . @B@@@@ 6020 LET A1 = R1(T,A1) @ FROM RUNNER GY )@@G@@@B@@@@MISSING IDENTIFIER OR NUMBER (ERROR 5) @B@@@@LIMIT WHENEVEGZ )@@G@@R Y(I).G.YHI, Y(I)=YHI@]@@@@GO TO START;@]@@@@DONE: END @#@@@@*IF [[HA )@@G@@#1],I,3]>0 @ @@@@ W'R CARD(I).NE.$ $ @^@@@@PLUS := OPERS[2,1]HB )@@G@@; @C@@@@SUCC OUTPUT = 'THIS IS AN EXP' :(NEXT) @D@@@@ HC )@@G@@ COMPUTE DIFF = DIFF / BUD-ALLOW * 100. @E@@@@*. ASSUMING THIS EHD )@@G@@LEMENT IS CALLED EL AND RESIDES IN FILE, @[@@@@FILL* @[@@@@*END @#@@@@HE )@@G@@ ENTRY ENDPLT@B@@@@ W'R WORD(0).E.$THROUG$,J=7 @E@@@@HF )@@G@@ 0.24100+00 0.0000 4.44395+00 0.00295+00 4.20000+00@A@@@@ HG )@@G@@ THRUS(PLACE,I)=SQUASH(J) @C@@@@ 02 NUMBER PIHH )@@G@@CTURE X(5). @#@@@@ I=0 @]@@@@EOF: END @B@@@@ THI )@@G@@'H LABEL, FOR I=0,1,I.G.9 @[@@@@*. @C@@@@ CLOSE TRANS-FHJ )@@G@@ILE, BUDGET-ANALYSIS. @ @@@@ 68 0 0 0 0@^@@@@LIB LIHK )@@G@@BRARIES$*GATHER. @A@@@@ INTEGER ARRAY FACT[1:N];@C@@@@ HL )@@G@@ DIMENSION P(10),Q(10),X(50),Y(50) @B@@@@OUT L A0,AHM )@@G@@1 . @B@@@@ L,U A9,'A'-1 . @]@@@@HN )@@G@@INTEGER I,J;@]@@@@*. @EOF @ @@@@'DO YOU WANT TO DO IT AGAIN$Q'@#@@@@HO )@@G@@R44803000031050 @[@@@@$I 0 @G@@@@ FOR I := 1,6,7,10,13,1001,1002,100HP )@@G@@3,1004,1005,1006,1007,1008,1009,1010@ @@@@#HDG,P *** [[#1],[#2],2,1]& HQ )@@G@@@F@@@@15050 DATA 49,18,14,7,26,10,5,8,4,6,3,1,2,2712,7704,13,12,9,2608 HR )@@G@@@]@@@@410 RETURN@C@@@@ DO BEGIN J := J + 1; LOOKFOR[J] := I; END; HS )@@G@@@B@@@@ WHENEVER X(I).G.XHI, X(I)=XHI@#@@@@ J=6 HT )@@G@@@ @@@@ DL A0,*0,X11 @D@@@@ 1 BURN(52), HC(7), STDPTHU )@@G@@(14), SNH(7), SNS(7) @I@@@@040030 77 SWITCH1 PICTUREHV )@@G@@ 9(7), VALUE ZERO. M6300570 @G@@@@C THE PARAMETER SPECIEFHW )@@G@@IED AS TRIP INTO THE REG SPECIFIED AS WREG @A@@@@QUIT WORD(0)HX )@@G@@=WORD(0).LSC.(J*6)@#@@@@ 1 GO TO 20 @C@@@@ IF C EQL MINUS OR C HY )@@G@@EQL PLUS THEN BEGIN @I@@@@010115 FILE SECTION. HZ )@@G@@ M6300160 @#@@@@ FETCH; @^@@@@IA )@@G@@ 514 37 16 29@]@@@@ WRITE M; @#@@@@ AXR$ @@@@@@IB )@@G@@@B@@@@ CALL GEN(LX,0,X3,0,X2) @RESTORE X3 @ @@@@ CALL GEN(LX,IC )@@G@@0,X5,UR5,0) @^@@@@DIVIDE := OPERS[3,1]; @^@@@@TIMES := OPERS[4,1]; ID )@@G@@@^@@@@#I=I+(((I*N+N)/I)+N# @]@@@@#I=I*N)# @ @@@@COMMENT START IE )@@G@@OF PROGRAM; @^@@@@ 567 23 12 26@ @@@@BEGIN HJ L(STIF )@@G@@ART) @#@@@@ R=SIDEW*SA @#@@@@ 225 FORMAT(/,' @D@@@@ 0IG )@@G@@2 BUDGET PICTURE $$$$.99. @I@@@@ SUB HOLD,1 IH )@@G@@ .719.GWB @I@@@@ II )@@G@@ TPL BACK4 .719.GIJ )@@G@@WB @I@@@@ TZE BACK4 IK )@@G@@ .719.GWB @I@@@@ TSX SWITCH,4 IL )@@G@@ .719.GWB @I@@@@ TTR BACK4 IM )@@G@@ .719.GWB @I@@@@OUT3 IN )@@G@@ CLA I .719.GIO )@@G@@WB @]@@@@ Y:=Y+1;@]@@@@0123456789 @#@@@@'WHICH ONE$Q' @[@@@@IP )@@G@@$G R5 @^@@@@ PLACE=PLACE-1@I@@@@ TTR *+4 IQ )@@G@@ .719.GWB @I@@@@BACK5 CLA IR )@@G@@ I .719.GWB IS )@@G@@@I@@@@ ADD =1 IT )@@G@@ .719.GWB @^@@@@ T'O NEXT @I@@@@001150 02 NO-IU )@@G@@1 PICTURE S999V99. PROBLEM2 @A@@@@IV )@@G@@BOOLEAN PROCEDURE RECOGNIZE(N); @E@@@@COMMENT TOP-DOWN RECURSIVE IW )@@G@@DESCENT PARSABILITY CHECKER. @ @@@@ PROCEDURE DIVISION. @[@@@@IX )@@G@@*. @F@@@@*. THE SECOND FIELD WITH ITS OPTIONS WILL BE USED TO GENERATIY )@@G@@E @ @@@@ PARAMETER MXBLKS = 50 @#@@@@801 AFIELD=AA1 @#@@@@IZ )@@G@@800 FJFLD=F1 @ @@@@ 66 0 0 0 0@]@@@@*EDIT OFF JA )@@G@@@#@@@@ E'L @B@@@@OOPS OUTPUT = 'OOPS' :(IN) JB )@@G@@@I@@@@ STO I JC )@@G@@ .719.GWB @I@@@@ SUB HOLD JD )@@G@@ .719.GWB @I@@@@ TZE *+2 JE )@@G@@ .719.GWB @#@@@@ FJF )@@G@@LAG=1B@]@@@@#I=N*+I# @^@@@@15130 REM 6 MAN,10-30 @I@@@@ TPL JG )@@G@@ RETURN .719.GWB JH )@@G@@@I@@@@ CLA I JI )@@G@@ .719.GWB @I@@@@ PAX ,1 JJ )@@G@@ .719.GWB @I@@@@060120 MOVE UNAMEX TO UNAMJK )@@G@@E. M6300950 @I@@@@080020 WRAPUJL )@@G@@P. DISPLAY 'AN END OF FILE HAS BEEN SENSED READING A5'. M6301360 JM )@@G@@@]@@@@*EDIT ON @#@@@@A10023445533910 @[@@@@$F @ @@@@ CALL GJN )@@G@@EN(AX,U,X5,1,0) @F@@@@*. THE FIRST FIELD SAYS WHAT TYPE OF ELEMENT IT JO )@@G@@IS. TYPES CAN BE: @E@@@@IS THERE NO FUN IN LIFE NOW THAT COMPUTERS HAVE JP )@@G@@ENTERED IT? @ @@@@ PLACE = PLACE+1 @E@@@@ BLOCK-3. IFJQ )@@G@@ ACT-EXP EQUAL BUD-ALLOW GO TO BLOCK-3A. @A@@@@ MOVE BUD-TOT JR )@@G@@TO DIS-B. @ @@@@ CARD(J)=CARD(I) @E@@@@ CALL GEN(ANXJS )@@G@@,U,X5,BLKREF(OFFSET(TRIPLE(NEXT,2))),0) @ @@@@ CALL GEN(SX,0,X5,UJT )@@G@@R5,0) @]@@@@'X2: ';X2DO@I@@@@ TTR *+2 JU )@@G@@ .719.GWB @I@@@@BACK6 CLA J JV )@@G@@ .719.GWB @I@@@@040100JW )@@G@@ 02 CODE1 PICTURE X SYNCHRONIZED LEFT. M63006JX )@@G@@40 @^@@@@ 6010 LET A1 =ROLL2 @E@@@@15200 DATA 99,2608,7,4,5,3,4,2JY )@@G@@,3,1,0,0,2706,7702,8,7,2606,6 @[@@@@#I=N# @]@@@@#I=I+N# @]@@@@Y1I $SJZ )@@G@@ 20 @[@@@@C @[@@@@*. SGS@D@@@@ 02 FILLER PICTURE X(48)KA )@@G@@ VALUE SPACE. @^@@@@ 587 18 11 20@C@@@@NEXT:'DO YOU WANT KB )@@G@@TO CHANGE ANY EQUATIONS$Q' @]@@@@*. START 7 @]@@@@*. @EOF @]@@@@KC )@@G@@INITIALIZE @]@@@@AGAIN: RESET@[@@@@DOIT @ @@@@ ACT-OVER-BGT-ROUTKD )@@G@@INE. @#@@@@*. @SSG SKEL,/Q @^@@@@ C EQL TIMES OR @I@@@@ KE )@@G@@ ADD =1 .719.GKF )@@G@@WB @I@@@@ STO J KG )@@G@@ .719.GWB @#@@@@ CALL LABPH2 @#@@@@ J=11 KH )@@G@@@I@@@@001030 AUTHOR. REID ELLIS. KI )@@G@@ PROBLEM2 @]@@@@X3I $S 80 @]@@@@X4I $S 100 @#@@@@ 445KJ )@@G@@96 @#@@@@SQUEEZ C'E @#@@@@ WRITE(6,200)@^@@@@ HKK )@@G@@OLD=X(I) @#@@@@G00126250060050 @A@@@@ST1 ROW(I)=200000000000KL )@@G@@K ___@@@*EDIT OFF @#@@@@ E'L @B@@@@OOPS OUTPUT = KM )@@G@@'OOPS' :(IN) @I@@@@ STO I KN )@@G@@*[S@@@*SDFF*@A@@@@ (Q,[1.5]$CQ),$LQ$S&3.1+.1#$I61 @[@@@@$FFUNC@[@@@@KO )@@G@@1 @[@@@@2 @[@@@@3 $F @[@@@@FUNC @[@@@@$FFUNC@]@@@@[2] 22 $F KP )@@G@@@[@@@@FUNC @]@@@@$FFUNC["]$F @]@@@@ )CLEAR @#@@@@$RA$S2 3 4 $R 1 KQ )@@G@@@[@@@@$R+/A @]@@@@$R+/[1]A @]@@@@$R+/[2]A @G@@@@$FFUNC;VERYLONGNAMKR )@@G@@E;ANOTHERVERYLONGNAME;ATHIRDLONGNAME;ANDTHELASTONE$F @^@@@@ )COPY 1 WSKS )@@G@@FNS WIDTH @]@@@@ WIDTH 1000@]@@@@$FMONAD X @#@@@@ 'HELLO ';X$F KT )@@G@@@#@@@@ MONAD MONAD 3 @]@@@@)WIDTH 70 @]@@@@$FFUNC["]$F @^@@@@ "KU )@@G@@$SFLOAT$S%%$I150 @#@@@@ FLOAT+0.123456 @]@@@@ $I200 @[@@@@$FBUSTKV )@@G@@@C@@@@[1] THISISAVERYLONGNAMESOWECANBUST,'^','*' $F @]@@@@ )WIDTH 38KW )@@G@@@]@@@@$FBUST[1"]$F@]@@@@ )WIDTH 40 @]@@@@$FBUST[1"]$F@]@@@@ )WIDTH 37 KX )@@G@@@]@@@@$FBUST[1"]$F@#@@@@ )LOAD 1 HANGMAN @#@@@@$FHANGMAN["]$F @]@@@@KY )@@G@@ )CLEAR @#@@@@ S$MGORK$S2 3 4 @]@@@@ )VARS @[@@@@ GORK@]@@@@KZ )@@G@@$F FUNC @[@@@@ A$S1@[@@@@L:B$S2@[@@@@$F @#@@@@ T$MFUNC$S1 2 LA )@@G@@@[@@@@FUNC @]@@@@1+T$MFUNC @[@@@@ $R$"@[@@@@X @]@@@@ )VARS LB )@@G@@@[@@@@ L @#@@@@)LOAD 1 ADVANCEDEX@[@@@@$Y22 @#@@@@X $S 10000$R'''' LC )@@G@@@[@@@@$Y22 @#@@@@XX$S5000$R'''' @[@@@@$Y22 @[@@@@$F F @[@@@@1 LD )@@G@@@^@@@@LKJLKJLKJLKJLKJLKJLKJK @A@@@@DFRLKJLKJLKJLKJLKJLKJLKJLKJLKJLKJL LE )@@G@@@B@@@@'KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK' @[@@@@$F @[@@@@$Y22 LF )@@G@@@#@@@@KKK$S100$R'''' @[@@@@$Y22 @#@@@@YYY$S40$R'''' @]@@@@ZZZ$S$LG )@@G@@R'''' @]@@@@QQQ$S$R'''' @[@@@@$Y22 @#@@@@HIJ$S30$R'''' @]@@@@ )CLLH )@@G@@EAR @]@@@@ A$S1 2 3 @]@@@@ A[1] @#@@@@ &1.5E200 &1E200@#@@@@LI )@@G@@ A$S 1;B$S 2 @]@@@@ )ERASE A X@[@@@@ )VARS@]@@@@$F ZARF @^@@@@LJ )@@G@@' ARBITRARY FUNCTION' @[@@@@$F @]@@@@ )SAVE ZARF@]@@@@ )CLEAR LK )@@G@@@^@@@@ ZARF $S 1 2 3 4 5 @]@@@@ )COPY ZARF@[@@@@ ZARF@#@@@@ $F LLL )@@G@@ABELTEST @A@@@@ LABEL:'LABELED STATEMENT' $F @]@@@@ LABELTEST LM )@@G@@@[@@@@ LABEL@]@@@@ )WSID TRIG@#@@@@ $F Z $S TRIG Y @#@@@@ "$SZ$SY $TLN )@@G@@ 0.5 @]@@@@ Z$S(-Y)$TZ@[@@@@ $F @]@@@@ $F TRIG ["]@[@@@@ $F @]@@@@LO )@@G@@ )SAVE TRIG@]@@@@ TRIG 0 @]@@@@ TRIG 1 @]@@@@ TRIG 2 @]@@@@LP )@@G@@ TRIG 3 @]@@@@ TRIG 4 @]@@@@ TRIG 5 @]@@@@ TRIG 6 @]@@@@LQ )@@G@@ TRIG 7 @]@@@@ TRIG 8 @]@@@@ )LOAD TRIG@]@@@@ TRIG &0 @]@@@@LR )@@G@@ TRIG &1 @]@@@@ TRIG &2 @]@@@@ TRIG &3 @]@@@@ TRIG &4 @]@@@@LS )@@G@@ TRIG &5 @]@@@@ TRIG &6 @]@@@@ TRIG &7 @]@@@@ TRIG &8 @]@@@@LT )@@G@@ )DROP TRIG@#@@@@ )DROP ZARF @]@@@@ )CLEAR @]@@@@ )WSID TESTLU )@@G@@@]@@@@ 3+" @]@@@@ )SAVE TEST@@@@@@@[@@@@ 5 @]@@@@ )CLEAR LV )@@G@@@#@@@@ )LOAD TEST @]@@@@ 5 @#@@@@ )DROP TEST @^@@@@LW )@@G@@ K$S 10 10 $R $I 100 @[@@@@ $Y22@]@@@@ K$S ' ' @[@@@@ $Y22@#@@@@LX )@@G@@ $F A $S FACTL Y@]@@@@ $G2#Y>A$S1@#@@@@ A$S Y#FACTL Y-1 @[@@@@$F LY )@@G@@@]@@@@ FACTL 4 @^@@@@RANK $S '23456789TJQKA' @B@@@@SUIT $S 4 6 $R 'CLLZ )@@G@@UBS DIMNDSHEARTSSPADES' @#@@@@$F DEAL; HAND @^@@@@HAND $S 13 4 $R 52MA )@@G@@ $Q 52@#@@@@SOUTH $S HAND[;1] @#@@@@WEST $S HAND[;2] @#@@@@NORTH $S HANMB )@@G@@D[;3] @#@@@@EAST $S HAND[;4] @[@@@@$F @#@@@@$F PRINT HAND; I @[@@@@MC )@@G@@I $S 3@ @@@@HAND $S HAND[GRADWN HAND] - 1 @C@@@@SUIT[I+1;];' ';RANK[1+1MD )@@G@@3 $!(I=$L HAND%13)/HAND]@^@@@@$G 3 # 0 $< I $S I - 1 @[@@@@$F @^@@@@ME )@@G@@$F Z $S GRADUP X; I @E@@@@Z $S $I 0 $: SET TEMP RMF )@@G@@ESULT TO NULL @E@@@@Z $S Z, I $S X $I $L / X $: APPEND INDEX OF MG )@@G@@SMALLEST @C@@@@X[I] $S $L / $I 0 $: SET OUT OF RANGE@^@@@@MH )@@G@@$G (($R Z) < $R X) / 2 @[@@@@$F @#@@@@$F Z $S GRADWN X;I@]@@@@Z $S $MI )@@G@@I 0 @^@@@@Z $S Z, I $S X $I $C / X@#@@@@X[I] $S $C / $I 0 @^@@@@$G (($MJ )@@G@@R Z) < $R X) / 2 @[@@@@$F @[@@@@ DEAL@]@@@@ PRINT EAST@]@@@@ )CLEMK )@@G@@AR @[@@@@ $Y22@[@@@@$G @[@@@@$Y22 @]@@@@ Z$S'$S' @]@@@@$F SNAML )@@G@@FU @[@@@@$EZ @[@@@@$F @]@@@@ SNAFU @#@@@@ A$S3 3$R 1 0 0 0MM )@@G@@@#@@@@ B$S3 3$R 1+$I10 @]@@@@ A;B @]@@@@ 2+.#A @]@@@@ 2 4 MN )@@G@@6 +.#A@]@@@@ A+.#B @]@@@@ B+.#A @]@@@@ 2+.#B @^@@@@ B$.MO )@@G@@.+B$S1 5$R$I5 @#@@@@ B+.#5 1$RB @[@@@@ Q$S2@]@@@@ R$S3.3 MP )@@G@@@]@@@@$F Q$SFUNC R@[@@@@Q$S2*R@[@@@@$F @]@@@@ FUNC 3.3 @[@@@@FUNC RMQ )@@G@@@[@@@@$G @[@@@@ A$S"@[@@@@)CLEAR@]@@@@ 1 2 3 @]@@@@ $F GARK L MR )@@G@@@[@@@@'Z'+1 @[@@@@$F @[@@@@ $Y22@]@@@@ GARK 8;13 @[@@@@ $Y22@[@@@@MS )@@G@@$G @[@@@@ $Y22@]@@@@$F GACKER Y @]@@@@$G3#$IY$<0 @]@@@@GACKER Y-1 MT )@@G@@@#@@@@'I'+7;'ARRGH' @[@@@@$F @[@@@@ $Y22@]@@@@GACKER 4 @[@@@@MU )@@G@@ $Y22@[@@@@$G @[@@@@ $Y22@]@@@@ )CLEAR @]@@@@$FZ$SGACK @]@@@@MV )@@G@@'GACKING' $F@[@@@@ GACK@[@@@@1+GACK@#@@@@ GLOB $S $I5 @#@@@@GLAB $MW )@@G@@S 3 3$R$I6 @]@@@@ $F OOO @[@@@@ 'OOO'@#@@@@ GLOB$S%GLOB @[@@@@MX )@@G@@ $F @[@@@@$FAAH @[@@@@ 'AAH'@#@@@@GLAB$S%GLAB $F @]@@@@OOO,AAH MY )@@G@@@]@@@@ GLOB @]@@@@ GLAB @^@@@@ 2;;;;;;;3;;' ';5 @]@@@@MZ )@@G@@)WIDTH 10 @]@@@@5 20 $R '*' @]@@@@)WIDTH 100 @^@@@@5 100 $R '12345678NA )@@G@@9*' @#@@@@ )WIDTH 132 @#@@@@ 132$R'WHURP!'@E@@@@ 'A',0$R1;NB )@@G@@'***';(0$R2),'B';' *** ';(0$R'ABC'),0$R1 2 3 @]@@@@ $E'"$S10'@#@@@@NC )@@G@@'AAAA' $E 'AAAAA' @ @@@@1 1 1 1 1 1 1 $E 1 1 1 1 1 1 1@#@@@@1 2 3 4 5 $ND )@@G@@E 2 4 @#@@@@1.2 2 3 4 5 $E 2 4@^@@@@ A$S'THIS IS A STRING'@#@@@@ $E'NE )@@G@@$EB$S''A''' @[@@@@ A$S1@]@@@@ "$S$RA @]@@@@ A$S$SA @]@@@@ )CLNF )@@G@@EAR @^@@@@ 'ABC' $R 'BOOM' @]@@@@ $I'X' @]@@@@ $I&6 NG )@@G@@@[@@@@ $Y22@[@@@@$Y22 @^@@@@ ((((1+2)+")+10)+40) @[@@@@ 4 @]@@@@NH )@@G@@ )CLEAR @E@@@@ $: *********** TEST INPUT/OUTPUT OPERATORNI )@@G@@S @^@@@@ '*****',$",'*****' @]@@@@ STUFF @#@@@@A $S 2+"$S10NJ )@@G@@0+30 @[@@@@ A @]@@@@ "$S3.1415@[@@@@ $:@]@@@@$F A$S NILAD@]@@@@NK )@@G@@A$S2 $F @#@@@@$K Z $S MONAD Y @]@@@@ Z $S Y $F @^@@@@$F Z $S A DYNL )@@G@@AD NILAD @^@@@@ Z $S 5$RA+NILAD $K @ @@@@ R$S2+MONAD(4 DYAD NILANM )@@G@@D)[3] @[@@@@2 * 3 @]@@@@2.5 * 3.5 @]@@@@2.5 * &3.5 @]@@@@&2.5 * 3.5 NN )@@G@@@]@@@@&2.5 * 3.0 @]@@@@&2.5 * &3.5 @[@@@@ &@]@@@@ &1.2 @]@@@@NO )@@G@@ &.2 @]@@@@ &. @]@@@@ & 21 @#@@@@ ZEA $S 1+"+4 NP )@@G@@@#@@@@ BEA $S 10+"+40@^@@@@ CEA $S 100+"+400 @^@@@@ CEA $SNQ )@@G@@ 1000#"$O1 @]@@@@ 4 @]@@@@ 4 @#@@@@ ZEA;BEA;CEA NR )@@G@@@B@@@@ 55555555555 5555555555 555555555555 @B@@@@ +ZZZ$S4444444444 NS )@@G@@44444444444 444444444444@B@@@@$: FORCE STACK OVERFLOW AND FLUSH TO CORENT )@@G@@@F@@@@(((((((((((((((1+2)+3)+4)+5)+6)+7)+8)+9)+0)+1)+2)+3)+4)+5)+6)+7 NU )@@G@@@D@@@@ (L,L)$R,((L,1+L$S$RN)$R' ')[;1]$SN$S'STUFF' @B@@@@ NV )@@G@@GRONK+GRONK;' ** ';GRONK$S3$R123456 @]@@@@ 8.9E307 @]@@@@ 8.9E308 NW )@@G@@@]@@@@ 2.2E&325 @A@@@@ALFA $S 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'@#@@@@ )NX )@@G@@ORIGIN 0 @#@@@@ALFA $I 'ABC' @^@@@@ ALFA[ALFA$I'STRING'] @#@@@@NY )@@G@@ )ORIGIN 1 @#@@@@ALFA $I 'ABC' @^@@@@ ALFA[ALFA$I'STRING'] NZ )@@G@@@#@@@@JUNK $S 'ABCDK' @^@@@@TEST $S JUNK,UNDEFINED @]@@@@ )CLEAR OA )@@G@@@C@@@@ $: TEST ACCESSING OF SUBSCRIPTED ARRAYS-- @B@@@@ Q $S 'OB )@@G@@ABCDEFGHIJKLMNOPQRSTUVWXYZ' @^@@@@ Q[1 3 7] $S '135' @ @@@@ OC )@@G@@Q;Q[16 18 12 14] $S ' ' @^@@@@ L $S 2 4 $R $I25 @ @@@@ $R Z $OD )@@G@@S L[2 1;2 2$R $I4]@]@@@@ Z @^@@@@ Z[1 2;1;1] $S $T1 @]@@@@OE )@@G@@ Z @]@@@@ )CLEAR@B@@@@ (6 3 $R 14.3 12 6.1 3.4 ,$T1) $E OF )@@G@@&1 12 @ @@@@ 1 2 3 4 5 6 $E 9 8 7 4 5 6 0@ @@@@'ABCDEFGH' $E 'ASDFGHJKLOG )@@G@@' @B@@@@ 'ABCDE'='D';' FILLER';'E'$='EEFRTDEGH' @C@@@@ 6 10 23 4 OH )@@G@@91 + 1 1 1$R5;' '; (1$R57.3)-$I4 @B@@@@ 'ABC'='CBA' ;' FILLER ';'ABOI )@@G@@C'$='CBA' @F@@@@ 3.3 4.4 5.5 = 3.3 4.1 5.5;' FILLER ';65E77 &12 2.00 OJ )@@G@@= 1 &12 2 @#@@@@ +AMULT$S60#60 @#@@@@ AMULT#AMULT @#@@@@ OK )@@G@@60#60#60#60 @D@@@@$C FLOATVECTOR $S 1293 &55.23 637E&20 205.92E65 17 OL )@@G@@@ @@@@$L HALFVECTOR$S 22 56 21 8 @^@@@@ HALFSCALAR $S 5264 @ @@@@OM )@@G@@ FLOATSCALAR$S 1.555247 @A@@@@ $CHALFSCALAR;' : ';$LFLOATSCALAR ON )@@G@@@D@@@@ A $O B ; ' MARK '; (A $S 1 1 0 0 ) $A B $S 1 0 1 0 @^@@@@ A @AOO )@@G@@ B ;':'; A @O B @E@@@@A < B;':';A $< B;':';A = B;':';A > B;':';A $> B;OP )@@G@@':';A $= B @[@@@@)CLEAR___$S''A''' @[@@@@ A$S1@]@@@@ "$S$RA @]@@@@OQ )@@G@@ A$S$SA @]@@@@ )CL*[S@@@*SDFF*@B@@@@$: EXAMPLES TAKEN FROM THE APLOR )@@G@@/360 MANUAL ___@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@OS )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*[S@@@*SDFF*@B@@@@$: SOMOT )@@G@@E TESTS FOR THE MIXED OPERATORS @]@@@@ )CLEAR @^@@@@$: REVERSOU )@@G@@E TESTING @]@@@@A $S 'ABC' @#@@@@B $S 2 3 $R $I 6 @^@@@@C $S 2 3 4 $OV )@@G@@R $T $I 24 @]@@@@ @V A@#@@@@ @V B @#@@@@ @V OW )@@G@@C @]@@@@ $V A @]@@@@ $V B @]@@@@ $V C @#@@@@ OX )@@G@@ $V[1] B @#@@@@ $V [2]B @]@@@@ $V[1]C @]@@@@ $V[2]C OY )@@G@@@[@@@@$V[3]C@#@@@@ @V[1] B @]@@@@ @V[2]B@]@@@@ @V[3]C OZ )@@G@@@#@@@@ $V['C'] B @#@@@@ $V[123456789]B@#@@@@ $V[1 2 ] C PA )@@G@@@#@@@@ $V[1.255]C @#@@@@ $V[-2.145] C @[@@@@$V[1]2@]@@@@ $V PB )@@G@@2 @]@@@@ @V 2 @[@@@@)CLEAR@ @@@@$: TAKE AND DROP TESTING PC )@@G@@@A@@@@ALFA $S 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'@]@@@@&5 ^ ALFA @]@@@@5 ^ ALPD )@@G@@FA @]@@@@24 ^ ALFA @]@@@@24 $^ ALFA @]@@@@&5 $^ ALFA @]@@@@0 ^ ' PE )@@G@@' @#@@@@123456 ^ ALFA @#@@@@123456789 ^ ALFA @[@@@@)CLEAR@#@@@@PF )@@G@@A $S 2 4 5 7 5 4 @#@@@@B $S 3 4 $R $I 12 @[@@@@1 ^ A @[@@@@5 ^ A @]@@@@PG )@@G@@'A' ^ A @[@@@@20 ^ A@]@@@@2 2 ^ B @[@@@@2 ^ B @]@@@@'A' ^ B PH )@@G@@@]@@@@'AB' ^ B @[@@@@5 $^ A@[@@@@2 $^ B@]@@@@2.1 1.5 ^ B @]@@@@&2.6 $PI )@@G@@^ A @]@@@@2 2 $^ B @[@@@@&2 ^ B@[@@@@0 ^ A @[@@@@0 ^ 2 @[@@@@0 $^ 2PJ )@@G@@@[@@@@1 ^ 2 @[@@@@1 $^ 2@[@@@@&1 ^ 2@]@@@@&1 $^ 2 @[@@@@)CLEAR@^@@@@PK )@@G@@$: EXPAND TESTING @]@@@@P $S 2 3 5 7@#@@@@E $S 3 4 $R $I 12 @ @@@@PL )@@G@@X $S 3 4 $R 'ABCDEFGHIJKL' @]@@@@1 0 1\$I 2 @]@@@@1 0 1 1 1 \X@#@@@@PM )@@G@@U $S 1 0 1 0 1 @]@@@@U \ 6 3 2 @]@@@@U \ 'ABC' @]@@@@1 0 0\5 PN )@@G@@@#@@@@0 0 0 1 \ 'S' @]@@@@0 1 0 1\2 4 @]@@@@0 0 0\0 $R 1@ @@@@'A', (PO )@@G@@0 0\ 0 $R 'BC'),'D' @[@@@@1 \ 5 @]@@@@0 1 0 \ 5 @]@@@@V $S 1 0 0 1PP )@@G@@@#@@@@V\2 2 $R $I 4 @#@@@@V \[1]2 2 $R $I 4 @#@@@@V\2 2 $R'ABCD' PQ )@@G@@@#@@@@V\[1]2 2 $R'ABCD' @#@@@@H $S 2 3 4 $R$I 24@[@@@@H @]@@@@0 1 0 PR )@@G@@1\[1]H@]@@@@1 0 1\[1]H @^@@@@$: COMPRESS TESTING@]@@@@A $S $I 4 PS )@@G@@@]@@@@1 1 1 0 / A @]@@@@1 0 1 0 / A @]@@@@1 1 1 1 / A @]@@@@0 0 1 0 / A PT )@@G@@@]@@@@0 0 0 0 / A @#@@@@B $S 4 4 $R $I 16 @]@@@@1 0 1 1 / B @]@@@@0 0 0 PU )@@G@@1 / B @#@@@@1 0 0 0 /[1]B @[@@@@1/[1]B@]@@@@P $S 2 3 5 7@#@@@@E $S 3PV )@@G@@ 4 $R $I 12 @ @@@@X $S 3 4 $R'ABCDEFGHIJKL' @]@@@@1 0 1 0 /P @]@@@@PW )@@G@@1 0 1 0 /E @]@@@@1 0 1/[1]E @]@@@@1 0 1 $/E @[@@@@)CLEAR@]@@@@U $S 1PX )@@G@@ 0 1 0@]@@@@U/5 2 3 7 @]@@@@U/'ABCD' @[@@@@1/5 @#@@@@0 1 0 /3 3 $PY )@@G@@R$I 9 @#@@@@0 1 0/[1]3 3 $R$I9@]@@@@V$S1 0 1 @]@@@@V/3 3 $R$I9 @#@@@@PZ )@@G@@V/[1]3 3 $R$I9 @^@@@@M $S 3 3 $R'BAAURNSKY' @[@@@@V/M @[@@@@V/[1]MQA )@@G@@@#@@@@H $S 2 3 4 $R$I24 @]@@@@1 0 1 /[2]H @]@@@@1 1 0 0 /H @[@@@@1/1 QB )@@G@@@[@@@@0/1 @]@@@@A $S $I 10 @[@@@@3 $V A@]@@@@12 $V A @]@@@@&3 $V QC )@@G@@A @#@@@@B $S 3 4 $R $I 12 @#@@@@1 2 3 4 $V[1] B @]@@@@1 2 3 $V B QD )@@G@@@#@@@@1 2 3 $V[2] B @^@@@@C $S 2 3 4 $R $I 24 @#@@@@(2 3 $R $I 6QE )@@G@@) $V C@^@@@@(3 4 $R $I 12 ) $V [1] C@^@@@@(2 4 $R $I 8) $V[2] C @^@@@@QF )@@G@@(2 3 $R $I 6) $V[3] C @]@@@@3 $V $I 5 @]@@@@&3 $V $I 5 @#@@@@3 $V 'QG )@@G@@INGRAIN' @]@@@@&1 $V 'TOPS'@#@@@@3 $V 3 4 $R $I 12 @^@@@@&2 $V[1] 3 4QH )@@G@@ $R $I 12 @^@@@@M $S 2 5 $R 'GLEEAPLEAP'@[@@@@M @]@@@@&2 $V M QI )@@G@@@[@@@@3 $V M@ @@@@0 1 2 3 $V[1] 3 4 $R $I 12 @^@@@@(&1 2 3) $V 3 4 $RQJ )@@G@@ $I 12@^@@@@(&1 2 3) $V 3 4 $R $I 12@^@@@@1 &3 $V 2 4 $R $I 8 @^@@@@QK )@@G@@2 3 $V 2 5 $R 'RPSHA' @#@@@@2 3 3 $R $I 18 @^@@@@2 $V 2 3 3 $R $I 1QL )@@G@@8 @^@@@@+H $S 2 3 4 $R $I 24 @^@@@@(2 4 $R $I 3) $V[2] H @[@@@@QM )@@G@@)CLEAR@#@@@@A $S 2 3 $R $I 6 @^@@@@B $S 2 3 4 $R $I 24 @[@@@@A $V BQN )@@G@@@]@@@@A $V[1] B @[@@@@)CLEAR@#@@@@A $S 2 4 $R $I 8 @^@@@@B $S 2 3 4 $QO )@@G@@R $I 24 @]@@@@)ORIGIN 0 @]@@@@2 $V 2 4 6 8@]@@@@A $V[1]B @ @@@@QP )@@G@@$: UP AND DOWN GRADE TESTING @[@@@@$U 'A'@#@@@@$U 3 4 $R $I 12 @]@@@@QQ )@@G@@ $U ,5@]@@@@$U 2 3 4 @]@@@@$U 4 2 3 @]@@@@$U 3 5 3 2 @]@@@@QR )@@G@@$D 3 5 3 2 @#@@@@$U7 1 16 5 3 9 @#@@@@$U 7.1 1 16 5 3 9 @#@@@@$U 5 3QS )@@G@@ 7 3 9 2 @#@@@@$U 5.5 3 7 3 9 2 @^@@@@V $S &7 3 9 6 5 1 4 3 @[@@@@QT )@@G@@$U V @[@@@@V[$UV]@[@@@@$D V @[@@@@V[$DV]@]@@@@M $S $I0 @]@@@@1,($UMQU )@@G@@),2 @]@@@@)ORIGIN 0 @]@@@@$U 3 5 2 3 ___^ 2@[@@@@&1 ^ 2@]@@@@&1 $^ QV )@@G@@2 @[@@@@)CLEAR@^@@@@$: EXPAND TESTING @]@@@@P $S 2 3 5 7@#@@@@QW )@@G@@E $S 3 4 $R $I 12 @ @@@@X $S 3 4 $R 'ABCDEFGHIJK*[S@@@*SDFF*@B@@@@ QX )@@G@@$: THIS IS A SAMPLE TERMINAL SESSION@F@@@@ 6#9 $: FRQY )@@G@@OM TERMINALS, ENTRIES ARE INDENTED @E@@@@ A $S 6#9 $: TYQZ )@@G@@PICAL ASSIGNMENT STATEMENT @E@@@@ A $: IMPERATIRA )@@G@@VE TO TYPE VALUE OF A @E@@@@ B $S &12 $: NOTE USE OF UNRB )@@G@@ARY MINUS SIGN @D@@@@ A+B $: EVALUATE AND THEN PRRC )@@G@@INT @D@@@@ 256E&1 $: CONSTANT WITH AN EXPONENT @C@@@@RD )@@G@@ D $S 5 4 3 2 1 $: CREATE A VECTOR @G@@@@ D#D RE )@@G@@ $: VECTOR FUNCTIONS APPLY ELEMENT BY ELEMENT @G@@@@ D#B RF )@@G@@ $: BUT NOTICE THAT A SCALAR APPLIES TO ALL ELS @E@@@@ RG )@@G@@J $S 'UNCLE' $: CHARACTER CONSTANTS ARE VECTORS @]@@@@ J RH )@@G@@@F@@@@ BA $S 12 $: NAMES MAY BE UP TO 72 CHARACTERS LONG RI )@@G@@@#@@@@ BAC $S 13 @]@@@@ BA+BAC@#@@@@ 6+8+1+2 @]@@@@RJ )@@G@@ A $S 7@]@@@@ B $S 6@F@@@@ A#B+2 $: STATEMENRK )@@G@@TS ARE EXECUTED RIGHT TO LEFT @D@@@@ (A#B)+2 $: BUT NOTIRL )@@G@@CE WHAT PARENS DO @E@@@@ A B $: INVALID EXPRESSION (RM )@@G@@NO OPERATOR)@F@@@@ 3.5.2 $: MISSPELLED ITEM (2 DECIMARN )@@G@@L POINTS) @G@@@@ F $S 2 $: BE CAUTIOUS USING REPLACERO )@@G@@MENT WITHIN PARENS@F@@@@ +(F $S 3)+F $: NOTICE THAT THIS STMRP )@@G@@NT HAS VALUE 6 @F@@@@ F$S 2 $: BUT IF WE RETRY AND RQ )@@G@@MERELY ADD ZERO @D@@@@ +(F $S 3)+F+0 $: WE GET A DIFFERENT RRR )@@G@@ESULT @E@@@@ $: ***** EXAMPLES OF SCALAR FUNCTIONS ***** RS )@@G@@@G@@@@ 6#2$L3.2 $: DYADIC MINIMUM-- NOTE ORDER OF EXECUTIRT )@@G@@ON @G@@@@ (6#2)$L3.2 $: PARENTHESIZING CHANGES THE LEFT RU )@@G@@ARGUMENT @D@@@@ 6#$L3.2 $: THIS IS THE MONADIC FLOOR RV )@@G@@@D@@@@ +D$S$I5 $: HERE'S THE INDEX GENERATOR@G@@@@ RW )@@G@@$I0 $: AN EMPTY VECTOR GIVES BACK A BLANK LINE @G@@@@RX )@@G@@ +E$S 5-D $: NOTE HOW SCALAR FUNCTS EXTEND TO VECTORS RY )@@G@@@E@@@@ E$LD $: --ELEMENT BY ELEMENT EXTENSION @G@@@@RZ )@@G@@ E$>D $: LOGICAL OPERATORS GIVE LOGICAL (0 OR 1) VALSSA )@@G@@@G@@@@ $: ***** EXAMPLES USING THE TRIG (CIRCLE) OPERATOR SB )@@G@@***** @B@@@@ $T 1 $: PI TIMES ONE @C@@@@ $T%1 2SC )@@G@@ $: PI DIVIDED BY 1 2 @F@@@@ G $S 90 30 $: COSD )@@G@@NSIDER THESE AS ANGLES IN DEGREES @E@@@@ $T G%180 $: ANSE )@@G@@D CONVERT THEM TO RADIANS @D@@@@ $: ***** MANIPULATION SF )@@G@@OF ARRAYS ***** @#@@@@ L $S 2 3 5 7@A@@@@ $R L SG )@@G@@$: SIZE OF L@C@@@@ M $S 'CLYDE' $: CHARACTER VECTOR @D@@@@SH )@@G@@ $R M $: AND ITS DIMENSION VECTOR @E@@@@ L,L SI )@@G@@ $: CONCATENATE A NUMERIC VECTOR @E@@@@ M,M SJ )@@G@@ $: DITTO FOR A CHARACTER VECTOR @G@@@@ L,M SK )@@G@@ $: BUT WE CANNOT COMBINE NUMERICS WITH CHARS @F@@@@ Z $S 2 3 $R SL )@@G@@2 8 13 11 7 5 $: RESHAPE TO A 2 BY 3 MATRIX @G@@@@ Z SM )@@G@@ $: DISPLAY OF ARRAYS IS PRECEDED BY BLANK LINE @F@@@@ 2 4 $RSN )@@G@@ M $: CREATE A RECTANGULAR CHARACTER ARRAY @E@@@@ 6 $R ZSO )@@G@@ $: WE CAN GET A VECTOR BY RESHAPING@F@@@@ ,Z SP )@@G@@ $: BUT NORMALLY WE USE THE RAVEL OPERATOR@D@@@@ $R L SQ )@@G@@ $: OUR OLD FRIEND FROM BEFORE@E@@@@ L $S 1 2 3 $: WE SR )@@G@@CAN MAKE A VECTOR SHORTER ... @]@@@@ $R L @D@@@@ L $S ,Z SS )@@G@@ $: ... OR WE CAN LENGTHEN IT @D@@@@ L $: DIST )@@G@@SPLAY PRESENT VALUE @F@@@@ L[3] $: SELECT AN ELEMSU )@@G@@ENT BY SUBSCRIPTING @G@@@@ L[5 3 1] $: NOTICE THAT A SV )@@G@@VECTOR CAN BE A SUBSCRIPT @G@@@@ L[$I 3] $: AND WE CSW )@@G@@AN GET THE FIRST THREE ELEMENTS @C@@@@ L[$R L] $: ORSX )@@G@@ THE LAST ONE @G@@@@ Z[2;1] $: WE CAN ALSO PICK UP SY )@@G@@A SPECIFIC ELEMENT OF Z @B@@@@ Z[ ;1] $: OR A COLUMN...SZ )@@G@@@B@@@@ Z[1;] $: OR A ROW ... @D@@@@ Z[2 1;1 3] TA )@@G@@ $: OR ANY MIXTURE WE WANT @E@@@@ 'A$QB$SC' $: NOTB )@@G@@TE DIFFERENT CHARS ON OUTPUT @G@@@@ Q $S 'MNOPQRSTUV*/''XYZ' $: TC )@@G@@A MESS OF CHARACTERS AS A VECTOR @D@@@@ Q $: 2 TD )@@G@@QUOTES COALESCE INTO ONE@F@@@@ Q[Z] $: NOTICE THAT WETE )@@G@@ CAN CREATE AN ARRAY @D@@@@ Q[Z[2 1;1 3]] $: AND GET IT IN TF )@@G@@ANY SHAPE @G@@@@ Z[;3] $S 1 3 $: WE CAN ALSO CHANGE A COLUMTG )@@G@@N IN THE ARRAY @]@@@@ Z @F@@@@ G $S 2 3 4 5 6 1 $: HETH )@@G@@RE'S A CYCLIC PERMUTATION VECTOR @F@@@@ L[G] $: WHTI )@@G@@ICH WILL PERMUTE OUR OLD FRIEND 'L' @D@@@@ G[G] $: ORTJ )@@G@@ EVEN PERMUTE ITSELF @F@@@@ L[3] $: THE INDEX ORIGTK )@@G@@IN OF A CLEAR WS IS ONE @D@@@@ )ORIGIN 0 $: BUT WE CAN CHATL )@@G@@NGE IT, @E@@@@ L[3] $: AND WE GET A DIFFERENT ELETM )@@G@@MENT @G@@@@ L[4 2 0] $: AND NOW ZERO IS A LEGAL SUBSCRIPTN )@@G@@T VALUE @G@@@@ $I 6 $: THE INDEX GENERATOR ALWAYSTO )@@G@@ STARTS AT ORIGIN @D@@@@ )ORIGIN 1 $: SO IF WE CHANGE THE TP )@@G@@ORIGIN@D@@@@ $I 6 $: WE GET A DIFFERENT RESULT@F@@@@TQ )@@G@@ $: ***** EXTENSION OF FUNCTIONS TO ARRAYS ***** @F@@@@TR )@@G@@ +R$S $Q 4 $R 8 $: A RANDOM VECTOR OF 4 INTEGERS FROM 1-8@D@@@@TS )@@G@@ +S$S $Q 3 5 $R 8 $: A RANDOM 3 BY 5 MATRIX @G@@@@ +T$S $TT )@@G@@Q 3 5 $R 8 $: A DIFFERENT RANDOM MATRIX OF THE SAME SHAPE @F@@@@ TU )@@G@@S-T $: THE DIFFERENCE (ELEMENT BY ELEMENT) @F@@@@ TV )@@G@@S$LT $: MINIMUM IS ALSO ELEMENT BY ELEMENT @G@@@@ TW )@@G@@S$>T $: COMPARISONS GIVE LOGICAL (0 OR 1) RESULTS ___X TX )@@G@@@G@@@@ Z $: DISPLAY OF ARRAYS IS PRECEDED BY BLANKTY )@@G@@*[@@@@*SDFF*@C@#@[/. INTERFACE ROUTINE TO DOMINO$ FOR USE BY APL @C@@@#TZ )@@G@@. INTERFACE ROUTINE TO DOMINO$ FOR USE BY APL @[@@@[. @D@#@[ UA )@@G@@ AXR$ . TEMP UNTIL WE INSTALL PROCPACKATE @G@@@#. ****************UB )@@G@@***************************************************** @G@@@#. UC )@@G@@ * @G@@@# UD )@@G@@ AXR$ . * @G@@@#UE )@@G@@ WSDEF. DEFINE WORKSPACE * UF )@@G@@@G@@@#WORKSP INFO 2 20. SET ASIDE THE SPACE UG )@@G@@ * @G@@@# RUNCTL. DEFINE RUN CTRL BLOK(S) UH )@@G@@ * @G@@@#RUNCON INFO 2 22. AND SET ASIDE ITS SPACE UI )@@G@@ * @G@@@# CBLOCK . DEFINE CONTROL BLOCK UJ )@@G@@TYPES * @G@@@#. UK )@@G@@ * @G@@@#. END OF STANDARD PROC BLOCK UL )@@G@@ * @G@@@#. ****************************UM )@@G@@***************************************** @[@@@#. @[@#@[/. @#@@@#UN )@@G@@/. HERE WE GO @#@^@[ INSTRS . @D@@@^$(18) . THERE'S NO MORE UO )@@G@@ROOM IN THE IBANK, FOLKS!!!!! @[@@@[. @^@@@[. MONADIC ENTRY POINT-- UP )@@G@@@[@@@[. @A@@@[MODINO* SX X11,DMLINK . @E@]@[ LX,UUQ )@@G@@ X4,DM8000 . FAKE IDENTITY AS LEFTARG @E@@@] LX,U X4,UR )@@G@@DM0010 . FAKE IDENTITY AS LEFTARG @F@@@^ LA,U A4,1 US )@@G@@ . GET FLAG INDICATING MATRIX RESULT @C@@@^ SA A4,DMARFLUT )@@G@@ . AND STASH IT @^@@@[. LOOK AT RIGHTARG-- @A@@@[ LMJ UU )@@G@@ X11,PIKRIT . @A@@@[ J DM9090 . @F@]@[UV )@@G@@ JNE,U A4,2 . MAKE SURE WERE INVERTING A MATRIX @F@@@]UW )@@G@@ JNE,U A4,2 DM9010 . MAKE SURE WERE INVERTING A MATRIX @D@@@[UX )@@G@@ LA,H1 A2,0,A1 . GET ROWS FROM DIMVECT @C@@@[ LXI,UY )@@G@@U A2,0,A2 . MAKE IT SQUARE @E@@@[ SA A2,DMADIM UZ )@@G@@. FUDGE UP AS DIMENSION OF 'A'@E@]@[ J DO0100 . THENVA )@@G@@ CONTINUE AS PER DYAD @E@@@] J DM0200 . THEN CONTIVB )@@G@@NUE AS PER DYAD @[@@@]. @F@@@]. DUMMY FETCH TO MANUFACTURE AN IDENVC )@@G@@TITY MATRIX FOR THE ABOVE @[@@@]. @C@@@]DM0010 DL A1,UNITY VD )@@G@@ . GET DFLOAT ONE @B@@@] LMJ X4,0,X4 . AND RETURNVE )@@G@@@F@@@] LR R1,DMBROW . SET TO GET AS MAY 0'S AS ROWS OF BVF )@@G@@@E@@@]DM0020 JNGD R1,DM0010 . AFTER ALL 0'S, GO GET A ONE @D@@@]VG )@@G@@ DSL A1,72 . MOSTLY WE GET A ZERO @B@@@] LMJ VH )@@G@@ X4,0,X4 . AND RETURN@F@@@] J DM0020 . GO CVI )@@G@@HECK FOR MORE ZEROS TO GET @[@@@]. @[@@@[. @^@@@[. DYADIC ENTVJ )@@G@@RY POINT-- @[@@@[. @A@@@[DOMINO* SX X11,DMLINK . @C@]@[VK )@@G@@DO0010 LMJ X11,PIKLFT . GET LEFTARG (A) @C@@@]DM0100 LMJ X11VL )@@G@@,PIKLFT . GET LEFTARG (A) @A@@@[ J DM9090 . VM )@@G@@@D@^@[ JZ A4,DM9010 . SCALAR IS A RANK ERROR@G@^@[ VN )@@G@@ JLE,U A4,3 DM9010 . AS IS ANYTHING ELSE BUT VECT OR MTX @C@@@^VO )@@G@@ ANA,U A4,1 . ADJUST RANK OF A@G@@@^ TE,U A4,VP )@@G@@1 . DOES ADJUSTED FLAG SAY A IS MATRIX? @G@@@^ JNZ VQ )@@G@@ A4,DM9010 . NO, RANK ERR UNLESS ITS VECTOR INSTEAD @F@@@^ VR )@@G@@ SMA A4,DMARFL . SAVE RANKFLAG TO SET DIMS AT EXIT @B@@@[ VS )@@G@@ TNE,U A3,ZMOCHR . CHARACTER?@E@@@[ JNZ A5,DM9000 VT )@@G@@. YES, DOMAIN ERR UNLESS NULL @G@@@[ LSSL A5,18 . ASSUVU )@@G@@ME VECT USING LENGTH AS FAKE ROWS @D@@@[ AA,U A5,1 VV )@@G@@. AND COLUMNS FAKED TO 1@C@^@[ TE,U A4,ZRANKV . IS IT A VEVW )@@G@@CTOR? @D@@@^ TZ A4 . IS FLAG SET TO VECTOR?@F@@@[VX )@@G@@ LA A5,0,A1 . NO, GET REAL MATRIX DIMENSIONS @D@@@[VY )@@G@@ SA A5,DMADIM . STASH A DIMENSIONS @D@@@[ TE,UVZ )@@G@@ A3,ZMODFL . IS IT ALREADY DFLOAT? @G@@@[ LX X4,GLFTBLWA )@@G@@+ZMOINT . NO, FORCE CONVERSION DURING FETCH @[@@@[. @D@]@[DO0020WB )@@G@@ LMJ X11,PIKRIT . LOOK AT THE MATRIX @D@@@]DM0110 LMJ X11WC )@@G@@,PIKRIT . LOOK AT THE MATRIX @A@]@[ J DO9090 WD )@@G@@. @A@@@] J DM9090 . @F@@@[ JNE,U A4,WE )@@G@@2 DM9010 . IMMEDIATE WIPEOUT(RANK) IF NOT MTX@[@@@[. @B@@@[. BOTHWF )@@G@@ MONADIC AND DYADIC CONVERGE HERE-- @[@@@[. @C@]@[DO0100 TNE,U A3,WG )@@G@@ZMOCHR . IS B CHARACTER? @D@@@ DM0200 TZ ERRITH . IS OWH )@@G@@VERFLOW FLAG ON? @F@@@ ER ERR$ . YES, SOMEONE FORWI )@@G@@GOT TO TEST IT @C@ @]DM0200 TNE,U A3,ZMOCHR . IS B CHARACTER? WJ )@@G@@@C@@@ TNE,U A3,ZMOCHR . IS B CHARACTER? @E@@@[ JNZ WK )@@G@@ A5,DM9000 . YES, DOMAIN UNLESS NULL ALSO@D@@@[ TE,U A3,WL )@@G@@ZMODFL . IS B ALREADY DFLOAT? @G@@@[ LX X6,GRITBL+ZMOINWM )@@G@@T . NO, FORCE CONVERSION DURING FETCH @D@@@[ LA A2,0,A1 WN )@@G@@ . GET DIMENSIONS OF B @E@@@[ SA A2,DMBDIM . AND WO )@@G@@STASH FOR LATER USE @C@@@[ SSL A2,18 . ALIGN NO OWP )@@G@@F ROWS@F@@@[ TNE A2,DMAROW . DOES A HAVE THE SAME NO OF RWQ )@@G@@OWS? @F@@@[ TLE A2,DMBCOL . YES, IS NO COLS .LEQ. NO OF WR )@@G@@ROWS? @F@]@[ J DO9020 . IF EITHER FAILS, LENGTH ERROWS )@@G@@R @F@@@] J DM9020 . IF EITHER FAILS, LENGTH ERROWT )@@G@@R @C@@@^. INITIALIZE ADDRESS POINTERS IN DUMMY DESCR @D@@@^DM0300WU )@@G@@ LA,U A0,DMDDMS . ADDR OF DIM DATA AREA @B@@@^ RELADR A0 WV )@@G@@ . HOKE IT UP@F@@@^ SA A0,DMDMVD+1 . AND PLUG IWW )@@G@@NTO 2ND WOD OF DIM DESCR@D@@@^ LA,U A0,DMDMVD . ADDR OF DIWX )@@G@@M DESCR @D@@@^ RELADR A0 . WHICH IS ALSO DUMMY WY )@@G@@@E@@@^ SA,H1 A0,DMDUMY+1 . TO WD 2 OF PRIMARY DESCR @B@@@[WZ )@@G@@ TZ DMBCOL . IS B NULL?@C@@@[ TNZ DMACOL XA )@@G@@ . NO, NOW ABOUT A?@F@@@[ J DM3000 . IF EITHER,XB )@@G@@ GO DO SPECIAL CASE @[@@@[. @C@@@[. GET WORKING AREA AND CATENATXC )@@G@@E B AND A INTO IT @[@@@[. @C@]@[DO1000 LA A2,DMBCOL . NO OXD )@@G@@F COLS OF B @C@@@]DM1000 LA A2,DMBCOL . NO OF COLS OF B @C@@@[XE )@@G@@ AA A2,DMACOL . PLUS COLS OF A @D@^@[ LXI A2,XF )@@G@@DMBCOL . MERGE IN NO OF COLS @F@^@[ SA A2,DMDDMS XG )@@G@@. STASH DUMMY DIMS FOR WORK AREA @F@^@[ LA,U A1,DMDDMS XH )@@G@@. GET ADDR WE JUST PUT DIMS INTO @C@^@[ RELADR A1 XI )@@G@@. RELATIVIZE IT @F@^@[ SA,H2 A1,DMDMVD+1 . AND SET POINTER XJ )@@G@@IN DIMVECT DESCR @E@^@[ LA,U A0,DMDMVD . THEN GET DIMVECTXK )@@G@@ DESCR ADDR @E@^@[ RELADR A0 . MAKE THAT ONE RELATIVEXL )@@G@@ TOO @F@^@[ SA,H1 A0,DMDUMY+1 . AND PUT IN OVERALL DUMMY DESXM )@@G@@CR @E@@@^ LA,U A3,0,A2 . PRESERVE TOT NO OF COLS XN )@@G@@@D@@@^ LXI A2,DMBROW . MERGE IN NO OF ROWS @E@@@^ XO )@@G@@ SA A2,DMDDMS . STASH DUMMY DIMVECT VALUES @G@@@^ MSI XP )@@G@@ A3,DMBROW . TOT COLS TIMES ROWS GIVES NO OF ELS @D@@@^ XQ )@@G@@ SA,H2 A3,DMDUMY . CRAM INTO DUMMY DESCR @E@@@[ LA,U A0,XR )@@G@@DMDUMY . THEN GET ABSAD OF THE DUMMY @E@@@[ LA,U A1,ZMODFLXS )@@G@@ . SET DESIRED MODE TO DFLOAT @F@^@[ LMJ X11,PUTANS XT )@@G@@. AND GET A PLETHORA OF STORAGE @E@@@^ LMJ X11,PUTANS XU )@@G@@. AND GET A SURFEIT OF STORAGE@D@@@[ J DM9090 . IF WXV )@@G@@E CAN, OF COURSE @E@]@[ SX X3,DMDATA . SAVE ABSADR OF TXW )@@G@@HE DATA AREA@E@@@] SX X3,DMDADR . SAVE ABSADR OF THE DATXX )@@G@@A AREA@G@@@[ PUSH A6 . STACK DSCR FOR GARBCOL IN CAXY )@@G@@SE OF ERROR @^@@@[. NOW DO THE CATENATION @E@@@[DM1100 LA A13,DMBROXZ )@@G@@W . OUTER LOOP IS OVER ROWS @F@@@[DM1110 JNGD A13,DM1200 YA )@@G@@. WHEN ALL ROWS DONE, GO INVERT @D@@@[ LA A15,DMBCOL YB )@@G@@. MOVE COLS OF B FIRST @E@@@[DM1120 JNGD A15,DM1130 . WHEN ALL BYC )@@G@@COLS DONE, GO DO A@B@@@[ LMJ X6,0,X6 . GET NEXT B@D@@@[YD )@@G@@ DL A1,A4 . PUT IT IN THE STASHREG@D@@@[ LMJ YE )@@G@@ X2,0,X2 . INTO THE WORK AREA @C@@@[ J DM1120 YF )@@G@@ . GO BACK FOR MRE @D@@@[DM1130 LA A14,DMACOL . LOOP ON COYG )@@G@@LS OF A @E@@@[DM1140 JNGD A14,DM1110 . WHEN A DONE, GO MOVE AYH )@@G@@ ROW @B@@@[ LMJ X4,0,X4 . GET NEXT A@B@@@[ LMJ YI )@@G@@ X2,0,X2 . STASH IT @D@@@[ J DM1140 . AND YJ )@@G@@DO ANOTHER COLUMN @C@@@[. NOW SET UP ARG REGS AND CALL THE INVERTER YK )@@G@@@B@@@[DM1200 LA A0,DMBCOL . COLS OF B @E@@@[ AA A0,YL )@@G@@DMACOL . PLUS A GIVES TOTAL COLS @F@@@[ MSI A0,DMBROWYM )@@G@@ . TIMES ROWS GIVES TOTAL ELEMENTS @D@^@[ ANA,U A0,1 YN )@@G@@ . LESS THE LAST ONE @D@^@[ LSSL A0,1 . TIMEYO )@@G@@S 2 TO GET WORDS @G@^@[ AA A0,DMDADR . PLUS STARTADR=LAYP )@@G@@ST DOUBLEWD ADDR IN Q @D@@@^ LSSL A0,1 . TIMES 2 TOYQ )@@G@@ GET WORDS @C@@@^ AA A0,DMDADR . PLUS DATA ADDR @G@@@^YR )@@G@@ SA A0,DMWDAD . SAVE ADDR OF WORD CONTAINING DIN DATA YS )@@G@@@G@@@^ ANA,U A0,1 . SET LAST WD ADDR AS IF RESULT IS VYT )@@G@@ECT @F@@@^ ANA A0,DMARFL . AND IF MTX, SUBTRACT ANOTHERYU )@@G@@ WORD @E@@@[ LSSL A0,18 . ALIGN AS PLACE TO PUT RESULTYV )@@G@@@E@@@[ LXM A0,DMDADR . SET UP STARTADDR OF WORKAREA@E@@@[YW )@@G@@ DL A1,DMRCWD . GET ROWS AND COLS OF B AND A@E@@@[ YX )@@G@@ LA A3,(+448,BUFF) . USE BUFF AS SCRATCH AREA @F@@@[ DL YY )@@G@@ A4,WSFUZZ . SET ILCOND TOLERANCE TO FUZZ VALUE@C@@@[ LMJ YZ )@@G@@ X11,DOMINO$ . AND GO WHIRR @D@^@[ J DM9030 ZA )@@G@@. IF NOSPACE, SAY WSFULL@D@@@^ J DM8010 . IF NOSPACEZB )@@G@@, SAY WSFULL@F@^@[ J DM9000 . IF ILLCONDITIONED, SAYZC )@@G@@ DOMAIN ERR @F@@@^ J DM8000 . IF ILLCONDITIONED, SAYZD )@@G@@ DOMAIN ERR @[@@@[. @F@@@[. NORMAL COMPLETION- FREE UNUSED SCRATCH AZE )@@G@@REA, POST FINAL DESCR @F@@@[. NOTE: AT THIS POINT WE RELY ON THE FACT ZF )@@G@@THE THE RESERV ROUTINE @C@@@[. IN 5.9 AND LATER ALLOCATES CONTIGUOUS SPZG )@@G@@ACE @[@@@[. @G@@@[DM2000 VERIFY 0,0 . DECODE THE DUMMYZH )@@G@@ WE USED AS SCRATCH @C@^@[ LA A2,DMBCOL . GET COLUMNZI )@@G@@S OF B@D@^@[ SA,H1 A2,0,A1 . TO DIMVECT OF RESULT @C@^@[ZJ )@@G@@ MSI A2,DMACOL . TIMES COLS OF A @F@^@[ SA A2,ZK )@@G@@DMZELS . IS NO OF ELEMENTS OF TRUE RESULT @E@^@[ ANA A5,ZL )@@G@@A2 . SUBTRACT FROM SIZE OF DUMMY @F@^@[ LSSL A5,1 ZM )@@G@@ . MULT BY 2 GIVING UNUSED WORDS @C@^@[ LA A0,A6 ZN )@@G@@ . GET DESCR RELAD @C@^@[ ABSADR A1 . MAKE IT ABZO )@@G@@SOULTE@E@^@[ AU A0,A5 . COMPUTE WHERE WE'LL MOVE IT ZP )@@G@@@D@^@[ DL A2,2,A0 . GET OLD DIM DESCR @D@^@[ ZQ )@@G@@ DS A2,2,A1 . STASH IN NEW PLACE @E@^@[ LA A3,ZR )@@G@@A5 . GET NO WDS WE'RE MOVING @C@^@[ LXI A3,A5 ZS )@@G@@ . IN BOTH HALVES @E@^@[ AA A3,1,A0 . BUMP DIMDEZT )@@G@@SC AND DATA ADDRS @D@^@[ SA A3,1,A1 . STASH NEW WD2 OFZU )@@G@@ DESCR@C@^@[ LA A2,0,A0 . GET WD1 OF DESCR@D@^@[ ZV )@@G@@ LXM A2,DMZELS . PLUG IN TRUE NO OF ELS@E@^@[ SA A2,ZW )@@G@@0,A1 . AND POST 1ST WD OF DESCR @E@^@[ RELADR A1 ZX )@@G@@ . MAKE DESCR ADDR RELATIVE @C@^@[ PUSH A1 ZY )@@G@@. AND STACK IT @D@^@[ AU,U A0,0,WSTAG . GET OLD DESCR REZZ )@@G@@LATIVE@D@^@[ LA A0,A5 . NO WDS TO RELEASE @C@@@^AA )@@G@@ LA A2,DMBCOL . GET COLUMNS OF B@G@@@^ MSI A2,AB )@@G@@DMACOL . TIMES COLS OF A GIVES ELS OF RESULT @C@@@^ LA AC )@@G@@ A0,A6 . GET DESCR RELADR@C@@@^ ABSADR A0 AD )@@G@@. MAKE IT ABSOLUTE@D@@@^ SA,H2 A2,0,A0 . STASH NO ELS IN AE )@@G@@DESCR @G@@@^ ANA A5,A2 . SUBTRACET FROM TOT GIVES NO AF )@@G@@UNUSED ELS @F@@@^ LSSL A5,1 . TIMES 2 IS NO DATA WD AG )@@G@@S TO RELEASE@E@@@^ TZ DMARFL . SHOULD RESULT BE VECTOAH )@@G@@R? @C@@@^ J DM2200 . NO, GO DO MATRIX@B@@@^. FUDGAI )@@G@@E DESCRS, ETC. FOR VECTOR RESULT @D@@@^DM2100 LA,U A2,1 AJ )@@G@@. GET VECTOR RANK FLAG @E@@@^ SA,S3 A2,0,A0 . CRAM INTO AK )@@G@@PRIMARY DESCR @G@@@^ AA,U A5,1 . BUMP UNUSED WDS AL )@@G@@TO COUNT DIM DATA WD @C@@@^ DL A2,0,A0 . GET OLD DEAM )@@G@@SCR @F@@@^ AA A3,A5 . BUMP DATA ADDR BY UNUSED DATAN )@@G@@A WDS @G@@@^ AA,U A5,2 . THEN BUMP WDS TO FREE TO COUAO )@@G@@NT DIM DESCR@F@@@^ AU A0,A5 . PUT NEW ADDR FOR PRIMAAP )@@G@@RY IN A1 @F@@@^ J DM2300 . AND GO STASH, STACK, AAQ )@@G@@ND FREE @B@@@^. FARBLE POINTERS, ETC. FOR MATRIX RESULT @E@@@^DM2200AR )@@G@@ LA A1,DMWDAD . RECOVER ADDRESS OF DIM DATA @C@@@^ LXI AS )@@G@@ A2,DMBCOL . GET COLUMNS OF B@C@@@^ LXM A2,DMACOL AT )@@G@@. AND COLUMNS OF A@F@@@^ SA A2,0,A1 . POST DIMENSIONS AU )@@G@@OF TRUE RESULT @G@@@^ AU A0,A5 . BUMP DESCR ADDR AV )@@G@@BY WDS TO BE RELEASED @C@@@^ DL A2,2,A0 . GET DIM DEAW )@@G@@SCR @C@@@^ DS A2,2,A1 . AND MOVE IT OVER@E@@@^ AX )@@G@@ LA A3,A5 . SET UP NO WDS WE'RE MOVING @C@@@^ LXI AY )@@G@@ A3,A5 . IN BOTH HALVES @G@@@^ AA A3,1,A0 AZ )@@G@@. INCREASE DIMV AND DATA ADDS BY THAT MUCH@E@@@^ LA A2,0,A0 BA )@@G@@ . PICK UP 1ST WORD OF DESCR @D@@@^. STASH ADJUSTED PRIMARY DESCRBB )@@G@@, STACK RESULT, ETC @F@@@^DM2300 DS A2,0,A1 . PLUG NEW PBC )@@G@@RIM DESC IN ITS PLACE @D@@@^ RELADR A1 . RELATIVIZEBD )@@G@@ ITS ADDRESS@E@@@^ PUSH A1 . AND STACK IT AS THE REBE )@@G@@SULT @F@@@^ LA A1,A6 . RECOVER RELAD OF WORKAREA DEBF )@@G@@SCR @G@@@^ LA A0,A5 . AND SET UP NO OF WDS TO BE RBG )@@G@@ELEASED @F@@@[ FREE . AND GIVE UP SPACE WE DBH )@@G@@IDN'T NEED @D@@@[ J DM4000 . THEN TAKE NORMAL EXIT BI )@@G@@@[@@@[. @C@@@[. SPECIAL CASE FOR ONE OR BOTH ARGUMENTS NULL @[@@@[BJ )@@G@@. @D@^@[DM3000 ER ERR$ . VERY SPECIAL CASE @E@@@^BK )@@G@@DM3000 LA,U A6,DMNVEC . SET UP TO COPY NULL VECTOR? @F@@@^ BL )@@G@@ TNZ DMARFL . SHOULD RESULT REALLY BE VECTOR? @F@@@^ BM )@@G@@ J DM3200 . YES, GO COPY NULL INTO THE WS @G@@@^DM3100BN )@@G@@ SZ,H2 DMDUMY . NO, MATRIX. CLEAR NUMBER OF ELEMENTS @C@@@^BO )@@G@@ LXI A0,DMBCOL . GET COLUMNS OF B@B@@@^ LXM A0,BP )@@G@@DMACOL . AND OF A @F@@@^ SA A0,DMDDMS . AND POST DBQ )@@G@@IMENSIONS OF RESULT @C@@@^ LA,U A6,DMDUMY . GET DESCR BR )@@G@@ADDR @G@@@^DM3200 RELADR A6 . DUPE EXPECTS RELATIVE DESCR BS )@@G@@ADDRESSES @F@@@^ LMJ X11,DUPE . MAKE A COPY OF THE DUMBT )@@G@@MY IN THE WS@A@@@^ J DM9090 . @C@@@^ PUSHBU )@@G@@ A2 . STACK THE RESULT@D@@@^ BV )@@G@@. AND FALL THRU TO EXIT @[@@@[. @#@@@[. NORMAL EXIT @[@@@[. BW )@@G@@@E@@@ DM4000 TZ ERRITH . DID ANY OVERFLOWS OCCUR? @G@@@ BX )@@G@@ J DM8000 . YES, BETTER TAKE DOMIAIN ERROR EXIT BY )@@G@@@A@ @[DM4000 LX X11,DMLINK . @E@@@ LX X11,DMLINBZ )@@G@@K . NO, WE CAN EXIT NORMALLY @A@@@[ J 1,X11 CA )@@G@@. @[@@@[. @#@^@[. ERROR EXITS @G@@@^. ERROR EXITS WHILE SCRACB )@@G@@TCH SPACE IS ALLOCATED. IF RESULT IS VECTOR, @G@@@^. DOMINO$ WILL USECC )@@G@@ THE SPACE WHERE THE DIM DATA WD WAS. IF IT ABORTS, @G@@@^. WE MUST BECD )@@G@@ SURE THE DIM DATA IS RESTORED, SO GARBAGE COLLECTION GOES. @[@@@^. CE )@@G@@@D@@@^DM8000 ERROR YDOMAI,DM8100 . ILL-CONDITIONED MATRIX@E@@@^DM8010CF )@@G@@ ERROR YWSFUL . INSUFFIEIENT SCRATCH SPACE @G@@@^DM8100 LA CG )@@G@@ A0,DMWDAD . GET ADDR WHERE DIM DATA WD SHOULD BE @G@@@^ CH )@@G@@ LA A1,DMDDMS . GET DIM VALS USED TO ACQUIRE SCRATCH SPA@D@@@^CI )@@G@@ SA A1,0,A0 . RESTORE THE DIM DATA @F@@@^ J CJ )@@G@@ DM9090 . THEN TAKE STANDARD ERROR EXIT @[@@@^. @ @@@^CK )@@G@@. ERRORS WHILE WS IS INTACT @[@@@^. @[@@@[. @A@@@[DM9000 ERROCL )@@G@@R YDOMAI,DM9090 . @A@@@[DM9010 ERROR YRANK,DM9090 . @A@^@[CM )@@G@@DM9020 ERROR YLENGT,DM9090 . @A@^@[DM9030 ERROR YWSFUL CN )@@G@@. @A@@@^DM9020 ERROR YLENGT . @A@@@[DM9090 LX X11CO )@@G@@,DMLINK . @F@@@ SZ ERRITH . BE SURE OVERFLOWCP )@@G@@ FLAG IS CLEARED @A@ @[ J 0,X11 . @D@@@ CQ )@@G@@ J 0,X11 . AND TAKE ERROR EXIT @^@@@[/. DATA USED FOR DCR )@@G@@OMINO @#@@@[ VARBLS . @A@@@[DMLINK EQUF $,,H1 . CS )@@G@@@D@@@]DMZELS EQUF $,,H2 . NO ELS IN TRUE RESULT @A@@@[ CT )@@G@@ RES 1 . @[@@@[. @D@@@[DMRCWD RES 2 CU )@@G@@ . ROW AND COLUMNS WORD @C@@@[DMBDIM EQU DMRCWD . DIMECV )@@G@@NSIONS OF B @A@@@[DMBROW EQUF DMBDIM,,H1 . @A@@@[DMBCOL EQUFCW )@@G@@ DMBDIM,,H2 . @C@@@[DMADIM EQU DMRCWD+1 . DIMENSIONSCX )@@G@@ OF A @A@@@[DMAROW EQUF DMADIM,,H1 . @A@@@[DMACOL EQUF DMACY )@@G@@DIM,,H2 . @G@@@^DMARFL EQUF $,,S1 . RANK FLAG FOR RECZ )@@G@@SULT, 0/1 FOR VECT/MTX @G@@@^DMWDAD EQUF $,,H2 . ADDR OF DIDA )@@G@@M DATA WD OF SCRATCH SPACE @A@@@^ RES 1 . DB )@@G@@@[@@@[. @ @@@[. DUMMY DESCRIPTORS AND SUCH @[@@@[. @G@@@^DMNVECDC )@@G@@ CBLOCK ZTPTMP,ZMODFL,1,0 . DUMMY DESCR FOR NULL VECT RESULT @E@@@[DD )@@G@@DMDUMY CBLOCK ZTPTMP,ZMODFL,2,$-$ $-$ . DUMY DATA DESCR @E@@@]DMDADRDE )@@G@@ EQUF DMDUMY+1,,H2 . STASH FOR DATA AREA ADDR @E@^@[DMDMVD CBLODF )@@G@@CK ZTPDMV,ZMOHFI,1,2 $-$ . DUMMY DIM DESCR @E@@@^DMDMVD CBLOCK ZTPDG )@@G@@DIM,ZMOHFI,1,2 $-$ . DUMMY DIM DESCR @D@@@[DMDDMS RES 1 DH )@@G@@ . DIM DATA STASHED HERE @]@@@[ END ___COUNT DIM DATA WD DI )@@G@@@C@@@^ DL A2,0,A0 . GET OLD DESCR @F@@@^ AA DJ )@@G@@*[@@@@*SDFF*@D@@@@/. THIS ELEMENT DEFINES TABLES OF GENERAL UTILITY DK )@@G@@@G@]@@. ****************************************************************DL )@@G@@***** @G@]@@. STANDARD PROCS - INCLUDED BY AN @ADD PRCPKG/APL IN SOURCE DM )@@G@@DECKS * @[@@@]. @G@]@@. DN )@@G@@ * @G@]@@ AXR$ . DO )@@G@@ * @^@@@] AXR$ . @G@]@@DP )@@G@@ CONFIG . DEFINE ASSEMBLY PARAMETERS * DQ )@@G@@@C@@@] CONFIG . DEFINE ASSEMBLY PARAMETERS @G@]@@ APSYMDR )@@G@@B. DEFINE APL SYMBOL SET * @B@@@] DS )@@G@@ APSYMB . DEFINE APL SYMBOL SET @G@]@@ WSDEF. DEFINE WORKDT )@@G@@SPACE * @A@@@] WSDEF . DEFINDU )@@G@@E WORKSPACE @G@]@@WORKSP INFO 2 20. SET ASIDE THE SPACE DV )@@G@@ * @C@@@]WORKSP INFO 2 20 . SET ASIDE THE SPACE DW )@@G@@@G@[@@ RUNCTL. DEFINE RUN CTRL BLOK(S) DX )@@G@@ * @G@[@@RUNCON INFO 2 22. AND SET ASIDE ITS SPACE DY )@@G@@ * @[@@@[. @F@@@[. NEW STYLE DEF OF RUN CONTROL BLOK PUTS IDZ )@@G@@T WITHIN THIS ELEMENT @F@]@[. AS OTHER ELEMENTS ARE REASSEMBLED, THE NEA )@@G@@EED FOR THE COMMON BLOCK@G@]@[. WILL DISAPPEAR, AS EVERYONE WILL BE EQUFEB )@@G@@'D OFF THE EXTERNAL TAG RUNBLK@[@@@[. @G@]@[RCINFO EQU 22 EC )@@G@@ . FOR NOW, WE STILL NEED THE COMMON BLOCK @A@]@[RUNCON INFO 2 RED )@@G@@CINFO . @G@]@[$(RCINFO),RUNBLK* RES 1 . THIS TAG IS WHATEE )@@G@@ EVERYONE ELSE WILL USE @E@@@# VARBLS . BE SURE ITEF )@@G@@S IN THE D-BANK @G@@@]RUNBLK* RES 1 . EQUFS IN RUNCTL EG )@@G@@PROC REFERENCE THIS TAG @F@@@[ RUNCTL . DEFINE EQUEH )@@G@@FS HERE TO AVOID DFLAGS @G@@@[ RES RCSPAR(1)-RUNBLK . ALLOCEI )@@G@@ATE THE SPACE FOR THE TABLE @[@@@[. @G@]@@ CBLOCK EJ )@@G@@ . DEFINE CONTROL BLOCK TYPES * @D@@@] CBLOCK EK )@@G@@ . DEFINE CONTROL BLOCK TYPES @G@]@@. EL )@@G@@ * @[@@@]. @G@[@@. END OF STAEM )@@G@@NDARD PROC BLOCK * @G@[@@. ****EN )@@G@@***************************************************************** @[@[@@EO )@@G@@. @[@[@@. @E@[@@. THIS ENTIRE ELEMENT IS DIPOSED OF AFTER THE INEP )@@G@@ITIALIZATION@G@[@@. CODE HAS BEEN EXECUTED AND THE APPROPRIATE TABLE HASEQ )@@G@@ BEEN TRANSFERED @G@[@@ INITAL . SET LOCN CTR FORER )@@G@@ INITIALIZATION CODE @[@]@[. @E@]@@CHINIT INFO 2 ININFO ES )@@G@@. DEFINE COMMON BLOCK WE'RE IN@G@@@]CHINIT INFO 2 ININFO . DEFIET )@@G@@NE COMMON BLOCK FOR CHAR TBL SETUP @[@@@[. @E@@@[ BRIEF . UEU )@@G@@OM ASSEMBLER ONLY, REMOV*[@@@@*SDFF*@B@@@@$(2) LIT EV )@@G@@ . @B@@@@$(1) AXR$ . @B@@@@LBIT EW )@@G@@ EQU 1*/('Z'-'L') . @B@@@@BEGIN* L A0,(LINF,IEX )@@G@@NF) . @E@@@@ L A14,A5 . SAVE OPTION WOEY )@@G@@RD @D@@@@ LMJ X11,RINF$ . READ INFOR @F@@@@EZ )@@G@@ ER PRINT$ . PRINT ERR MSG AND GO ON @C@@@@FA )@@G@@AGAIN L,U A0,FATPK . PACKET @F@@@@ ER FB )@@G@@ MSCON$ . DO AN MSALL$ TO GET FATBL @E@@@@ JN FC )@@G@@ A0,FAULT . JUMP IF NO GOOD @B@@@@P PROC 1 FD )@@G@@ . @B@@@@AVL* NAME 0 . @B@@@@FE )@@G@@ L,H1 X4,FATBL+P(1,2) . @G@@@@ TNZ X4 FF )@@G@@ . TEST FOR ANY IN APPLICATION @B@@@@ J FG )@@G@@ NOEQP . @E@@@@ A A7,FATBL+1,X4 . ACFH )@@G@@CUMULATE TRACKS @E@@@@ A A8,FATBL+2,X4,H2 . ACCUMULAFI )@@G@@TE POSITIONS@B@@@@ E$DIT EPK . @B@@@@ FJ )@@G@@ E$FD1 P(1,1) . @B@@@@ E$COL 8 FK )@@G@@ . @D@@@@ E$DECF 5,FATBL+1,X4 . EDIT TRACKS FL )@@G@@@B@@@@ E$COL 14 . @B@@@@ E$MSG FM )@@G@@ AVLMSG . @D@@@@ E$DECF 3,FATBL+2,X4,H2 . EDFN )@@G@@IT POSITIONS@B@@@@ E$COL 26 . @B@@@@ FO )@@G@@ E$MSGR . @B@@@@ E$DITX FP )@@G@@ . @B@@@@ L A0,(0112,IMG) . @B@@@@ FQ )@@G@@ ER PRINT$ . @]@@@@NOEQP . @B@@@@ ENFR )@@G@@D . @B@@@@ E$DIT EPK FS )@@G@@ . @B@@@@ E$MSG HDG . @B@@@@ ERFT )@@G@@ TDATE$ . @C@@@@ L A6,A0 FU )@@G@@ . SAVE IT @B@@@@ E$DAY1 . @B@@@@ FV )@@G@@ E$SKIP 2 . @B@@@@ E$TIME A6 FW )@@G@@ . @B@@@@ E$DITX . @B@@@@ FX )@@G@@ L A0,(0112,IMG) . @B@@@@ ER PRINT$ FY )@@G@@ . @D@@@@ DSL A7,72 . CLEAR A7-A8 FZ )@@G@@@D@@@@ TOP,U A14,LBIT . TEST FOR L BIT@G@@@@ GA )@@G@@ J TOTAL . NO L OPTION, GIVE TOTAL ONLY @B@@@@GB )@@G@@ AVL ('UCS'),7 . @B@@@@ AVL ('FHGC )@@G@@432'),2 . @B@@@@ AVL ('FH880'),3 . @B@@@@GD )@@G@@ AVL ('FH1782'),4 . @B@@@@ AVL ('F2GE )@@G@@/3'),0 . @B@@@@ AVL ('8414'),5 . @B@@@@GF )@@G@@ AVL ('8440'),6 . @D@@@@PRTTOT E$DIT EPK GG )@@G@@ . BEGIN EDIT @B@@@@ E$FD1 ('TOTAL') GH )@@G@@ . @B@@@@ E$COL 8 . @D@@@@ E$GI )@@G@@DECF 5,A7 . EDIT TRACKS @B@@@@ E$COL 14 GJ )@@G@@ . @B@@@@ E$MSG AVLMSG . @D@@@@GK )@@G@@ E$DECF 3,A8 . EDIT POSITIONS@B@@@@ E$GL )@@G@@COL 26 . @B@@@@ E$MSGR GM )@@G@@ . @B@@@@ E$DITX . @B@@@@ L GN )@@G@@ A0,(0112,IMG) . @B@@@@ ER PRINT$ GO )@@G@@ . @D@@@@TESTM TEP,U A14,1*/('Z'-'M') . TEST M OPTION @C@@@@GP )@@G@@ J WAIT . PRESENT @B@@@@ L GQ )@@G@@ A0,(0101,('DONE. ')) @B@@@@PRTEXT ER PRINT$ . GR )@@G@@@B@@@@ ER EXIT$ . @B@@@@TOTAL L GS )@@G@@ X5,(1,0) . @B@@@@NXTTYP L,H1 X4,FATBL,X5 . GT )@@G@@@G@@@@ TNZ X4 . TEST FOR ANY IN APPLICATIOGU )@@G@@N @C@@@@ J $+3 . NONE @D@@@@ GV )@@G@@ A A7,FATBL+1,X4 . ADD TRACKS @D@@@@ A GW )@@G@@ A8,FATBL+2,X4,H2 . ADD POSITIONS @D@@@@ TLEM,U X5,7 GX )@@G@@ . TEST FOR END @D@@@@ J NXTTYP . MOGY )@@G@@RE TO DO @B@@@@ J PRTTOT . @E@@@@WAIT GZ )@@G@@ L,U A1,15000 . WAIT 15 SECONDS @B@@@@ TEHA )@@G@@P A14,(1*/('Z'-'D')) @G@@@@ LSSL A1,1 HB )@@G@@ . DOUBLE WAITING TIME FOR D OPTION@B@@@@ ER TWAIT$ HC )@@G@@ . @E@@@@ J AGAIN . REPEAT WHOLE THD )@@G@@HING @D@@@@FAULT L A15,A0 . SAVE STATUS @B@@@@HE )@@G@@ E$DIT EPK . @B@@@@ E$MSG MSCMHF )@@G@@SG . @B@@@@ E$OCTV A15 . @^@@@@HG )@@G@@ E$DITX . @B@@@@ L A0,(0112,IMG) . HH )@@G@@@B@@@@ J PRTEXT . @]@@@@$(2) . @B@@@@HI )@@G@@LINF EQU 2*27+1 . @B@@@@INF RES LINFHJ )@@G@@ . @B@@@@IMG RES 012 . @B@@@@HK )@@G@@EPK E$PKT 012,IMG . @B@@@@MSALL$ EQU 060 HL )@@G@@ . @B@@@@FATPK + MSALL$ . @B@@@@HM )@@G@@ + LFATBL,FATBL . @B@@@@ + 0 HN )@@G@@ . @B@@@@LFATBL EQU 512 . @B@@@@HO )@@G@@FATBL RES LFATBL . @B@@@@MSCMSG 'MSCON$ ERROR,HP )@@G@@ A0 = &' . @A@@@@AVLMSG 'TRACKS, &POSITIONS.&' @B@@@@HDG HQ )@@G@@ 'MASS STORAGE AVAILABLILTY &' @B@@@@ END BEGIN HR )@@G@@ . ___OSI E$MSG MSCMSG . @B@@@@ E$HS )@@G@@OCTV A15 . @^@@@@ E$DITX . @B@@@@ HT )@@G@@ L A0,(0112,I)@@[F[^C^=C^2+-@*) ]@@@/,0@@@C/@@[[/G@@#"'=@@@@HU )@@G@@R;@@[B'=@@@@/,0@@@C#)@@LR#@@DRAA@QA&)@D[F[K) K)P^C[1]@KK)A@@/,0@@@C@@@@MHV )@@G@@/,0@@@C/@@@]/,0@@@C[)@@G'=@@@@/,0@@@C8@@DMAB@QA&)@M[F]@([K)N[@KL@@@@@@@@HW )@@G@@/K@@@3(@@@@^RD@@[L/K@@#0>;)^@@;H0@[C'=@@@@R#@@DS/,0@@@AC@QA&)@V[F[KM+-@@HX )@@G@@)*KB+^@U]@@@C@^@[F/,0@@@C/@@@C/,0@@@C@@@DT/,0@@@C/@@[[GA^@[GG[4@[FAD@QA&HY )@@G@@)@=[EK)L^C@4 ]@P[^C^K@@@/,0@@@C8K@@#C^^@[G/,0@@@C8@@DI/,0@@@C/@@@I/,0@@@HZ )@@G@@C8K@@ AE@QA&)@![EK)#K)GK)EKOC^4^K@@@/K@@[I(@@@@^RD@@[G'=@@@@R#@@DS/,0@@@IA )@@G@@/,0@@@/,0@@@C/@@@UAF@QA&)@6[F[KM+-@@)*KB+^@U]@@@C@^@[F/,0@@@C/@@@C/,0@@@IB )@@G@@C@@@DU/,0@@@C/@@[[GA^@[GG[4@[FAG@QA&)@_[EK)L^C@4 ]@P[^C^K@@@/,0@@@C8K@@#IC )@@G@@C^^@[G/,0@@@C8@@DI/,0@@@C/@@@I/,0@@@C8K@@ AH@QA&)[C[EK)#K)GK)EKOC^4^K@@@ID )@@G@@/K@@[((@@@@^RD@@[H'=@@@@R#@@DS/,0@@@/,0@@@/,0@@@C/@@@UAI@QA&)[L[F[KM+-@@IE )@@G@@)*KB+^@U]@@@C@^@[F/,0@@@C/@@@C/,0@@@C@@@DV/,0@@@C/@@[[GA^@[GG[4@[FAJ@QA&IF )@@G@@)[U[EK)L^C@4 ]@P[^C^K@@@/,0@@@C8K@@#C^^@[G/,0@@@C8@@DI/,0@@@C/@@@I/,0@@@IG )@@G@@C8K@@ AK@QA&)[<[EK)#K)GK)EKOC^4^K@@@/K@@]^(@@@@^RD@@[I'=@@@@R#@@DS/,0@@@IH )@@G@@/,0@@@/,0@@@C/@@@UAL@QA&)[?[F[KM+-@@)*KB+^@U]@@@C@^@[F/,0@@@C/@@@C/,0@@@II )@@G@@C@@@DW/,0@@@C/@@[[GA^@[GG[4@[FAM@QA&)[5[EK)L^C@4 ]@P[^C^K@@@/,0@@@C8K@@#IJ )@@G@@C^^@[G/,0@@@C8@@DI/,0@@@C/@@@I/,0@@@C8K@@ AN@QA&)["[EK)#K)GK)EKOC^4^K@@@IK )@@G@@/K@@]Z(@@@@^RD@@[E'=@@@@R#@@DS/,0@@@/,0@@@/,0@@@C/@@@UAO@QA&)]B[F[KM+-@@IL )@@G@@)*KB+^@U]@@@C@^@[F/,0@@@C/@@@C/,0@@@C@@@DX/,0@@@C/@@[[GA^@[GG[4@[FAP@QA&IM )@@G@@)]K[EK)L^C@4 ]@P[^C^K@@@/,0@@@C8K@@#C^^@[G/,0@@@C8@@DI/,0@@@C/@@@I/,0@@@IN )@@G@@C8K@@ AQ@QA&)]T[EK)#K)GK)EKOC^4^K@@@/K@@]'(@@@@^RD@@[J'=@@@@R#@@DS/,0@@@IO )@@G@@/,0@@@/,0@@@C/@@@UAR@QA&)]+[F[KM+-@@)*KB+^@U]@@@C@^@[F/,0@@@C/@@@C/,0@@@IP )@@G@@C@@@DY/,0@@@C/@@[[GA^@[GG[4@[FAS@QA&)]:[EK)L^C@4 ]@P[^C^K@@@/,0@@@C8K@@#IQ )@@G@@C^^@[G/,0@@@C8@@DI/,0@@@C/@@@I/,0@@@C8K@@ AT@QA&)]4[EK)#K)GK)EKOC^4^K@@@IR )@@G@@/K@@#P(@@@@^RD@@[K'=@@@@R#@@DS/,0@@@/,0@@@/,0@@@C/@@@UAU@QA&)].[F[KM+-@@IS )@@G@@)*KB+^@U]@@@C@^@[F/,0@@@C/@@@C/,0@@@C@@@DZ/,0@@@C/@@[[GA^@[GG[4@[FAV@QA&IT )@@G@@)#A[EK)L^C@4 ]@P[^C^K@@@/,0@@@C8K@@#C^^@[G/,0@@@C8@@DI/,0@@@C/@@@I/,0@@@IU )@@G@@C8K@@ AW@QA&)#J[]K)#K)GK)EKOC^2+-@@@@@@@@@/,0@@@C/@@[['=@@@@R#@@DS/,0@@@IV )@@G@@/,0@@@/,0@@@C/@@@UAX@QA&)#R[F[K)J^C@0K)L^C@0@@@@/,0@@@C/@@@I/,0@@@C8K@@ IW )@@G@@C@@@@N/,0@@@C/@@@C/,0@@@C@@@D)AY@QA&)#)[F[K) [][^K)#K)GK)E@@/,0@@@/,0@@@IX )@@G@@/,0@@@C/@@@U/,0@@@C8K@@#C@@@@O/,0@@@C8@@DIAZ@QA&)#([F[K)N^[[K)NK)QKO^@@@IY )@@G@@RD @[ER[K@D<'=@@@@'=@@@@R#@@D+/K@@#9=;)]@@'=@@@@R#@@DSBA@QA&)#2[MK^ [^[@IZ )@@G@@^^@@@@;*K@@[=#)@D=R;K#%S/K@@#P/K@@#1$9K@@BGA^@[GG[4@[F/K@@#6(@@@@^BB@QA&JA )@@G@@)#/[F][X@]+-@@)*K]+^[*@@/,0@@@C@@@@V/,0@@@C8@@DE/,0@@@C/@@[[C#0@@G/K@@@^JB )@@G@@'=@@@@BC@QA&)^ @V]@([K@@)[[@4*)@@@@@@@@@@@@@@@@@@@@@@@[[@@@@@@@@@@@&E@@7JC )@@G@@/K@@#,R#@@DS/,0@@@BD@QA&)[B@WEC@@@@@)DE@4@@@@@@@, &POSTRACKS & , A0 =JD )@@G@@ ERRORMSCON$@@@@@@@C@@[E@@@@@0BE@QA&)DK[W@@EDL@@@FH432@@@UCS@[E@@7@@7@@@JE )@@G@@Y & ABLILT AVAILTORAGEMASS S.& ITIONSBF@QA&)DV[O@@EC@@@@@@@@@@@K@@@JF )@@G@@@@[@@@@[[@D-DONE. @TOTAL@@8440@@8414@@F2/3FH1782@FH880BG@QA&0@@@]@@EC@@@JG )@@G@@@@@@@@@@K@@@@@[@@@@[[@D-DONE. @TOTAL@@8440@@8414@@F2/3FH1782@FH880BH@QA&JH )@@G@@@@^@@#@@B@@S@@7@@[@@;@@@@@@@@@@@@@^C@@@@D>EDIT$ EDITR$ ECHAR$JI )@@G@@ ECOL$ ESKIP$ EMSG$ ETIME$ EDAY1$ EDAY2$JJ )@@G@@ EDAY3$ EDITX$ ECOLN$ EMSGR$ EOCTV$ EDECV$JK )@@G@@ EFD1$ EOCTF$ EDECF$ RINF$ PRINT$ MSCON$JL )@@G@@ TDATE$ EXIT$ TWAIT$ BEGIN @@[@@@@@@@@@ NA(2,JM )@@G@@MA)=5 @#@@@@ GO TO 10 @]@@@@ END @^@@@@@FOR,SI LJN )@@G@@AGRA @ @@@@ SUBROUTINE LAGRA(NTC) @D@@@@C LAGRING AV UTSKRIFTERJO )@@G@@@@@@I8@N/@C@^D_^@@@N/^D_@@@@J5@@@@@[@@@@@@@@@@@Z@[O@@W@@@@@@@@@@@@@@@@@@JP )@@G@@@@@@@@@@@@@@67 @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@JQ )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@F.@C@@@E^@@@@E^[W@@V^D>@@@___@@@___@@@___@@@___JR )@@G@@@@@___@@@___@@@___@@@___@@@___@@@___@@@___@@@___@@@___@@@___@@@___@@@___JS )@@G@@@@@___@@@___@@@___@@@___@@@___@@@___@@@___@@@___[@@^@@C8W@@@KCK^@@H8)@@[JT )@@G@@&;K@CQC@@@@H'=@@@HG8W@@@ @H@@@>@@@F%/K@@CN>@@@F:/KF@@[C8H@@@?8I@@@/K@@C JU )@@G@@C@@@F(C8K@@#/KF@@@C@@@FYC8K@@[/KF@@@C@@@F=C8K@@]/KF@@@L8@@@[C@)^@@G8)@@[JV )@@G@@*@I@@@?CY@@@/K@@C-G),@@@/K@@CV%CI@@@/KF@@@C)"@@@H80@@[T80@@AG="@@@9?I@@[JW )@@G@@?80@@BC@K@F?/KF@@[N8W@@@C^@^@@G8@@@[C9K@@[ @@^@IN8)@@@(@G@@@/K@@DQ(4G@@@JX )@@G@@/K@@DA%1W@@@/K@@DQC?W@@@!8K@@A/K@@DD%(K^@I @@^@H[(K^@I9??@@[C-G@@@:9@@@[JY )@@G@@C@0@F?')H@EAH9@@@[T9@@@AG>G@@@')H@EIG)G@@@G8@@@[/K@@C1:9K@@[/K@@DIC*?@@@JZ )@@G@@:8)@@.N8)@@[%[K@[[/K@@DA/K@@C.%@)@F?[5@^@H:@)@F?[-K^@H/K@@DA(@@@[]:(K^@IKA )@@G@@/K@@DV[(K^@I @@^@H:[K@[[/K@@D@^@HKF )@@G@@[5@^@I[1@^@I[!@^@IC80@@F+8K@@_:8)@@ ;^@@@A8#0@ES9*@^@]C@@@F!C@K@F,C8)@@BKG )@@G@@C@0@F?[@"^@ 8#)@E-N4K^@H9!@^@J/\)@FJC9K@@*(4@^@H*)@^@H')H)@@N0K^@H9!@^@LKH )@@G@@*@@@[[/K@@E0C[@@F\N8K@@^/\)@FJN?K^@H(@@@[[/K@@E'C9K@@(')H)@@C[@^@N/\)@FJKI )@@G@@C9K@@)')H)@@(*@^@H*=@^@H/K@@F@C@@@F0'=@@@J/KF@@@C9K@@/')H)@@N*K^@HC[@^@OKJ )@@G@@/\)@FJN=K^@H(@@@[[/K@@E.C9K@@/')H)@@C[@^@P/\)@FJ/K@@E.;>@@@A')H)@@8KK@FHKK )@@G@@/KI@@@[5W@@@[1W@@@[!W@@@[(W@@@[>W@@@/\0@FR[-W)@@Q;K@FL/KJ@@@PROCESSOR CAKL )@@G@@LL ERROR @[^@FUABNORMAL RETURN FROM READ$ @[ @FZTOO MANY SPECIFICAKM )@@G@@TIONS @[^@F>]@@@@@[@@@@@ @@[^@ @@[@FLTPF$ @@G^@[C8G@@@;G@@@=W8@@8KKN )@@G@@C8?@@@C8H@@@/\K@G]C8)@@:')])H7;G@@@=W8@@@/C8?@@@C8H@@@/\K@G]C8)@@:')])H7KO )@@G@@C8?@@@C8V@@@;G)@@=W8)@@EG8)@@0')])H7C8\@@0')])H7/KH@@@;C@@@M+8@_@@;GK@@0KP )@@G@@/\K@G]C8)@@/')])H7+8@@_@;GK@@%/\K@G]C8)@@/')])H7+8@@@_C8!@[@/\K@G]/KF@@@KQ )@@G@@;C@@@M+8@@_@;GK@@%/\K@G]+8@_@@;CK@@FC@!@G"C80@@^;@)@@Y')])H78#0@G)+8@@@_KR )@@G@@C8!@[@/\K@G]/KF@@@AE1@@#;C@@@M[@@@[[+8@_@@;CK@@F9?H@G"/,0@IRC8)@@ ')])H7KS )@@G@@C@K@[[+8K@_@;G)@@%W8)@@E/@)@G7G8)@@0')])H7C8\@@0')])H7C8)@@,')])H7+8K@@_KT )@@G@@C8I@Y?C8K@@ RE1@@#/K@@JW JAN UARY FEB RUARY MAR CH APR IL KU )@@G@@ MAY JUN E JUL Y AUG UST SEP TEMBER OCT OBER KV )@@G@@ NOV EMBER DEC EMBER A^W@@#A@?@@^A@/@@ Q8W@@@N?L@@@R@)@J3R^1@@@&80@@[KW )@@G@@C8@@J4M@/)@@Q^1@@@ ?[@@]/KF@@@A^W@@#A@?@@^A@/@@ Q8W@@@&8)@@[Q4-@@[&80@@[KX )@@G@@Q01@@[O^1@@@/KF@@@A4-@@[P^1@@@A01@@[C8[@@@Q^L@@#R@?@@^R@/@@ /KF@@@[4<@@@KY )@@G@@[0<@@@[?<@@@[*<@@@[=<@@@/?)@H.[)<)@@A^-@@]Q8)@@@/K[K@]C8?@@@')])H7/KF@@@KZ )@@G@@;G@@@=W8@@@AG^[@@@Q8!@@@Q8/@@@/KF@@@G8]@@@C8N@@@H^L@@@T8K@@AG8H@@@/K@@I^LA )@@G@@C8#@@@H^[@@@T8@@@AG8]@@@/KF@@@C80@@ /K@@ISC80@@F;^@@[]+8K@@_%8)@@ :8)@@@LB )@@G@@/K@@IY')])H78#0@IS/KF@@@&"0__"/K@@I<&'0@@@C8.@@@;G@@@M;CK@@M&;@@@[&;K@@[LC )@@G@@8#0@I%/KF@@@')G)I"0@@@@F%8)@@@')])H7/K@@I*C?[@@[C^L@@[/K@@I4;G@@@M;CK@@MLD )@@G@@&;@@@[&;K@@[')G)I":0-@@@/K@@I;')])H7/K@@I6[?[@@[[^L@@[/KF@@@C4!@@@C0!@@@LE )@@G@@C?!@@@C*!@@@C=!@@@/\@@J^C)!)@@[^[@@]Q;@@@@/K[K@]C80@@@;G@@@#/@@@JKG80@@[LF )@@G@@;G@@@#/^@@JFC8)@@0')])H7C8)@@@;=K@@#G8)@@0')])H78#0@JK/KF@@@C8.@@@T8K@@#LG )@@G@@;GH@@@H80@@[/K@@JKC8K@@@N8X@@@C80@@@;O@@@=W8@@@EE/X@@@;?)@@AG8.@@08KK@J=LH )@@G@@/^@@JY/C@@J(;?)@@AG80@@-8KK@J(C@K@@IC8)@@ /K@@J!')])H78KK@J?C@)@@J')])H7LI )@@G@@;GK@@A/^)@J\/KF@@@@@[@@@ R#@^D2C#)@@L/,0@C@'=@@@IR;@^[+'=@@[P/G@@N3LJ )@@G@@C/@^[W/,0@HSC8@^D!/,0@I2'=@@@?C[)@@G/,0@GDC/@@@]/,0@IEC@@@@M/,0@F1/,0@H\LK )@@G@@R#@^D3'=@@@I;H0@[C>;)^@@/K@@N>RD@^[?(@@@@^/K@@K*G[4^[&GA^^[$C/@^[W/,0@HSLL )@@G@@C@@^D4/,0@IPC/@@@C/,0@I^C@^^[&C8K@@ /,0@JWC/@@@I/,0@I^C8@^D(/,0@I2C^^^[$LM )@@G@@C8K@@#/,0@JWC/@@@U/,0@I^/,0@I\/,0@H\R#@^D3'=@@@IRD@^[$(@@@@^/K@@L#G[4^[&LN )@@G@@GA^^[$C/@^[W/,0@HSC@@^D5/,0@IPC/@@@C/,0@I^C@^^[&C8K@@ /,0@JWC/@@@I/,0@I^LO )@@G@@C8@^D(/,0@I2C^^^[$C8K@@#/,0@JWC/@@@U/,0@I^/,0@I\/,0@H\R#@^D3'=@@@IRD@^[*LP )@@G@@(@@@@^/K@@LYG[4^[&GA^^[$C/@^[W/,0@HSC@@^D6/,0@IPC/@@@C/,0@I^C@^^[&C8K@@ LQ )@@G@@/,0@JWC/@@@I/,0@I^C8@^D(/,0@I2C^^^[$C8K@@#/,0@JWC/@@@U/,0@I^/,0@I\/,0@H\LR )@@G@@R#@^D3'=@@@IRD@^[((@@@@^/K@@L9G[4^[&GA^^[$C/@^[W/,0@HSC@@^D7/,0@IPC/@@@CLS )@@G@@/,0@I^C@^^[&C8K@@ /,0@JWC/@@@I/,0@I^C8@^D(/,0@I2C^^^[$C8K@@#/,0@JWC/@@@ULT )@@G@@/,0@I^/,0@I\/,0@H\R#@^D3'=@@@IRD@^[>(@@@@^/K@@MOG[4^[&GA^^[$C/@^[W/,0@HSLU )@@G@@C@@^D8/,0@IPC/@@@C/,0@I^C@^^[&C8K@@ /,0@JWC/@@@I/,0@I^C8@^D(/,0@I2C^^^[$LV )@@G@@C8K@@#/,0@JWC/@@@U/,0@I^/,0@I\/,0@H\R#@^D3'=@@@IRD@^[%(@@@@^/K@@M\G[4^[&LW )@@G@@GA^^[$C/@^[W/,0@HSC@@^D9/,0@IPC/@@@C/,0@I^C@^^[&C8K@@ /,0@JWC/@@@I/,0@I^LX )@@G@@C8@^D(/,0@I2C^^^[$C8K@@#/,0@JWC/@@@U/,0@I^/,0@I\/,0@H\R#@^D3'=@@@IRD@^[:LY )@@G@@(@@@@^/K@@NEG[4^[&GA^^[$C/@^[W/,0@HSC@@^D'/,0@IPC/@@@C/,0@I^C@^^[&C8K@@ LZ )@@G@@/,0@JWC/@@@I/,0@I^C8@^D(/,0@I2C^^^[$C8K@@#/,0@JWC/@@@U/,0@I^/,0@I\/,0@H\MA )@@G@@R#@^D3'=@@@IC/@^[W/,0@HSC@@^D;/,0@IPC/@@@C/,0@I^C@@@@NC8K@@ /,0@JWC/@@@IMB )@@G@@/,0@I^C8@^D(/,0@I2C@@@@OC8K@@#/,0@JWC/@@@U/,0@I^/,0@I\/,0@H\R#@^D3'=@@@IMC )@@G@@=;)]@@/K@@N,R#@^D.'=@@@I'=@@@DR[K^D"RD ^[>(@@@@^/K@@N:G[4^[&GA^^[$$9K@@BMD )@@G@@/K@@N&/K@@NER;K#%S=#)^D_;*K@@['=@@@0/K@@J9C#0@@GC/@^[W/,0@HSC8@^D>/,0@I2ME )@@G@@C@@@@V/,0@JC/,0@H\R#@^D3/K@@N<@@@@@@@USE @@@@@@@@@@@@, @@@@@@@@@@@@MF )@@G@@@@@@@@@@@@@@@@@@@@@&E^[M@@@@@@[[@@@@@@@@@@@@@@@@@@@@@@@@@@@0@C@^[>@@@@@@MG )@@G@@@@@@@@MSCON$ ERROR, A0 = & TRACKS, &POSITIONS.& MASS STORAGE AVAILMH )@@G@@ABLILTY & @@7^@V@[E^[M@@@UCS@FH432@FH880FH1782@@F2/3@@8414@@8440@TOTALMI )@@G@@DONE. @[[^D/@@[@@@@@K@@@MAIN @@X@@@@@@@@[. R#0@@NMJ )@@G@@ 02G.0@@=@I@@@@DMRSNW SL/]0^L> SNOOPY R]@^MFMK )@@G@@NOOPY TRACE ON R_S@@@ 0286 /K@^LZERU$ K@@@@^N=9GBBML )@@G@@INFOR$ K@]@@EDQD^KB@@V^@@@#1@C@EDIT$T K@]@@KHJ\GC^@@@@@@@[$@F1MM )@@G@@EDIT$ K@]@@QHJGGC^@@@@@@@]X@HSAVAIL @@#@@@GEI[^C@@@@@@@^C@J5MN )@@G@@@D>^@V@I@@@@ LX X2,SVX2 . MO )@@G@@ 0286 @I@@@@-137,137 MP )@@G@@ /^@@L)R#^^[(/@@@L :@@^EM/K@@LT/,0@IPC/@@@C/,0@I^MQ )@@G@@RR^^[$(@@@@G/G@@L@CC^^[$/,0@JVC/@@@K/,0@I^CO^^[$/,0@JVC/@@@Q/,0@I^RB^^[&MR )@@G@@R7O^[*:8K@@K/@@@L1+8@0@@/^K@LG/,0@JVC/@@@U/,0@I^CW^^[&/,0@JVC/@@@//,0@I[MS )@@G@@C?^^[&/,0@JV/,0@H\R#@^EL'=@@@IO9@@@ 8^)@KK=;)]@@/K@@L6R#@^EO'=@@@I'=@@@DMT )@@G@@C8@^D(/,0@I2/K@@K>/,0@H\/K@@K9>;)^@@/K@@L#C/@@@C/,0@I^C8@^D?/,0@I2/K@@K,MU )@@G@@;CK@@KR])@@HC/@@@)/,0@I^R#E^D9/,0@I2C/@@@Q/,0@I^RB^^[&+8@J__C@@@@H/,0@JVMV )@@G@@/K@@K,;C@@@A/,0@IPC/@@@C/,0@I^C8@^D\/,0@I2/K@@K,:8@@@[/K@@L%>;)^@@/K@@L#MW )@@G@@R]?^D0C/@@@C/,0@I^R#@@@E/,0@I2/K@@K,C/@@@)/,0@I^C8@^D4/,0@I2C/@@@@/,0@I^MX )@@G@@/K@@KPC/@@@O/,0@I^C@@^EP/,0@IP/K@@K,R;K#%S=#)^EQ;*K@@['=@@@0/K@@J9C#0@@GMY )@@G@@C/@^[W/,0@HSC8@^D>/,0@I2C@@@@V/,0@JC/,0@H\R#@^EL/K@@K"@@@@@@@USE @@@@@@MZ )@@G@@@@@@@@, @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@&E^[M@@@@@@[[@@@@@@@@@@@@@@@@NA )@@G@@@@@@@@@@@@@0@C@^[>@@@@@@@@@@@@MSCON$ ERROR, A0 = & (SPEEDING UP)& NB )@@G@@(NO PACK MTD)& (PREPPING)& @@@^D4@@@^D6@@@^D8(SUSPENDED)&(RESERVED)& NC )@@G@@(DOWN)& @@@^D.@@@^E[@@@^E^(BEING REGISTERED)& (PREP REQUIRED)& ND )@@G@@(PREP NEEDED, BEING REGISTERED?_?)& PACKID TRKS POS ASG SS/UU& NE )@@G@@@@7^@V@[E^[MEXEC8_DONE. @[[^EN@FIXED@@K@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@NF )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@MAIN @@X@@@@@@@@[NG )@@G@@@@@@@@@@@@@@@@@@@@R#0@@N@@@@@@@@@@@@@@@@@@G.0@@=@@@@@@@@@@@@@@@@@@/]0^L>NH )@@G@@@@@@@@@@@@@@@@@@@@R]@^MF@@@@@@@@@@@@@@@@@@R_S@@@@@@@@@@@@@@@@@@@@@/K@^LZNI )@@G@@ERU$ K@@@@^N=9GBBINFOR$ K@]@@EDQD^KB@@V^@@@#1@C@EDIT$T NJ )@@G@@K@]@@KHJ\GC^@@@@@@@[$@F1EDIT$ K@]@@QHJGGC^@@@@@@@]X@HSDISCS NK )@@G@@@@#@@@CBS[EC@@@@@@@]K@J5@D/^@V@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@NL )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@NM )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ILES AT RUN TERMINATION.NN )@@G@@@]D^ZLREQUESTED OPERATION IS ILLEGAL ON THIS UNIT. @BRKPT PRINT$ . NO )@@G@@@@@@@@ NP )@@G@@ NQ )@@G@@ @@@@@@REREAD ATTEMPT BEFORE FIRST READ ON CARD RNR )@@G@@EADER.ATTEMPT TO READ BEYOND END OF INPUT ON CARD READER. @@[^Z$@&5^Z$NS )@@G@@0@@^)]@@[^)V@BRKPT PUNCH$ . C,E. C,B. @@@@@@@@@@@@@@@@@@K@@@*XC@@@*PNT )@@G@@L@@@*X*@@@*X(@@@*XD@@@*X)@@@*X%@@@(%:@@@(%M@@@($E@@@%\F@@@%1@@@@@@@@@@@@NU )@@G@@@@B=)7@@ =)'@@C=)7)@B=)7)@C=)7)@ =)')@C=)7)@^=)/)@^=)/^@@@(A[@@@*D @@@(#NV )@@G@@@@@@(AD@@@( E@@@(8F@@@%7]@@@*D[@@@*F>8@^@@=8@[@@UNRECOGNISED STATUS CODENW )@@G@@ = .LOSS OF POSITION ON TAPE UNIT -- OPERATOR ANSWERED ERROR MESSAGE WNX )@@G@@ITH B.NINE TRACK TAPES MUST BE ODD PARITY.OPERATOR DECLARED TAPE UNIT DONY )@@G@@WN. @@[@@@@@]^)?@@[^)Z@@[^-=@@@@@@@@@@@@C@@@:AD@@@:,K@@@:?M@@@:3(@@@:6NZ )@@G@@*@@@?AE@@@?EUNRECOVERABLE ERROR ON FASTRAND DEVICE -- STATUS CODE = XX. OA )@@G@@FILE IS INCOMPLETE OR BAD FORMAT. @@]^-+@@[@@@@FREE @@@@@@@@@@@@@@#^-"OB )@@G@@ @,S^\T@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@]@^\TOC )@@G@@A7J^\TA@]C^<%@]^^<2@] ^OR )@@G@@0[Z_________J.88888888890]G3G3G3G3G2J.,+'F*,+'F(0]PPPPPPPPPOJ.$S$S$S$S$TOS )@@G@@@@@@@@L37&:2QF=F""<$\HR=OJT_2"MJ^36 MUQCLHH,MY#\K:$V+4 N'K51J]=OH^9H&2&_OT )@@G@@HY(M(DAV*G':F_R4X;@%H.\HE=PW#$ B:90)DHF^C&&7DJ[7B9=WVFI3YR6TA(J!JC:T86/:OU )@@G@@ V.@U5K.?Z,]^LYI)+Z=Y.83#D&\F%2=1 WI]^FGQ?/X@4LL[[[RS$$L^L0 DLOG @@"@@@OV )@@G@@@@)@@@K@.WEJK[-&T&__;@@OK@)@@@@@@@@@__.@@S)@)@@@[M;%H [5MEZ$I!2JO*ET/O?,OW )@@G@@:VETV$8,VR+%Q:F^# ^@+DTC5@SOQ4_[3_77DSQRT @@)@@@@[@@@@@@@@@@@@@@@[)@)@@@OX )@@G@@@@@@@@@@@@@@NEXPA$@@#@@@[1-Z6T])+.1.E^=WFIBB18PW;PQL?7"R:D8&SQRT @^@@@@OY )@@G@@@B___"B____@K[,E*;EP0R/GDI.0JM@^,\\NU(E)5(0H_<)@[L'8OZK@@@@@N[\8EGQ*D9&)OZ )@@G@@U'D"TRARG .GT. 88.028@ EXP C@@@@@)@)@@@\8N_A%KB?@9QKG@@@@@@[@@@@@ ^\0PA )@@G@@@@I^\0@@[^\0@@[@@@@@ ^\T [[^^\T@@[^\TIOTPCL@B_@@@@@@@@@@@@@@@@@@@@@PB )@@G@@IOTPIN@B_@@@@@@@@@ASG @@@@@@@@@@@@ STOP @#]^$L@@Q^\0(1P6G13.5) PC )@@G@@@@[[#T@@[[]*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@T F @@@@@@@@@@@@@@@@@@PD )@@G@@@@@@@@@@[^\0)^@@@@)@)@@@@@[@@O@@[@@P@@@@@@^@@@@@@@@@@@@@@@C@K^*@@@@@@@@@PE )@@G@@KB2@@@@@@@@@KE")@@@@@@@@KI$^@@@@@@@@KL05@@@@@@@@KO.]K@@@@@@@KS&DU@@@@@@@PF )@@G@@KV\:0)@@@@@@KY;&?*@@@@@@K+>KF9@@@@@@L#:R<:1U1+@@L=2ZFD3KL$N,M '1>J<-:>D)PG )@@G@@M$+H-6E_G=3LNC$4/$D-YUC=N(,RRQ!,899#OE5"X'<8ZU"@O:"5-8MO:II&PH==5(FESV96PH )@@G@@UT(3\2B=K@I?7N@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@PI )@@G@@@@@@@@A$\^*\A:\^*\A\\^*\A3\^*\A7\^*\A<\^*,LOCATION OF ERROR IS MARKED BYPJ )@@G@@ * IN FOLLOWING IMAGE. @@C^(I@@[^%K@@[^%K@@[^%K@@^^(Q@@^^(U@@A^(Y@@[^%KPK )@@G@@@@ ^(=INTERNAL TYPE AND FORMAT TYPE ARE INCOMPATIBLE. ILLEGAL OCTAL INPUPL )@@G@@T. ILLEGAL INTEGER INPUT. TOO MANY DIGITS IN INTEGER INPUT. ILLEGAPM )@@G@@L CHARACTER IN INPUT. @[D^(:@[C^(4ILLEGAL FORMAT CHARACTERS WERE ACCEPPN )@@G@@TED AS BLANKS. RECORDS EXCEEDING MAXIMUM LENGTH ARE FAULTY. @@@@@@PO )@@G@@ @@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@NBMSG$PP )@@G@@@@@@@@@@@@@@() @]D^*&@[Q^\T@@[^*\@[Q^*\??????@@@@@@@@@@@@@_D^%5@_F^%TPQ )@@G@@@_D^%=@_F^%T@_C^%!@_#^%"EXECUTION TERMINATED BY AN ATTEMPT TO READ PAST PR )@@G@@AN END-OF-FILE. EXECUTION TERMINATED BY AN ATTEMPT TO PASS END-OF-TAPEPS )@@G@@A NON INTEGRAL BLOCK WAS READ FROM MAGNETIC TAPEABNORMAL I/O CONDITION DPT )@@G@@ETECTED - STATUS CODE = -- INAPPROPRIATE UNITOUTPUT SYMBIONT UNIT REFPU )@@G@@ERENCED BY A READ STATEMENT. INPUTOUTPUT WRITE READ __D^:[@@@@@@@@@@@@PV )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ SEQUENCE N LINE NPW )@@G@@ ERROR TERMINATION IN ROUTINE CALLED AT SEQUENCE NPX )@@G@@UMBER OF ROGRAMA COMPUTED GO TO THAT WAS OUT OF RANGE WASPY )@@G@@ DETECTED AT SEQUENCE NUMBER OF MAIN PROGRAM. ILLEGAL OP AT SPECPZ )@@G@@IFIED RETURN FROM RETURN VARIABLE SPECIFIED IN QA )@@G@@OUT OF RANGE NEGATIVE@]B^:X@]D^:=@]B^:=@@@/K@MAIN P@]E^:=@]H^:,@]B^:"QB )@@G@@@]C^? I/ORETN 0RETN K@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@QC )@@G@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@_____"@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@QD )@@G@@@@@@@@@@@@@@@@@@@[@@@@@@@@@@@[@@@@@@@@@@@@@@@@@[@@@@@@@@@@@@@@@@@@@@@[T