;****** UOFP SEGMENTED BASIC ****** SEARCH S IFNDEF NOCODE, ;NOCODE=1 : JUST DEFINE SYMBOLS IFNDEF BASTEK, ;DO NOT INCLUDE TEK PLOTTING PACKAGE IFNDEF BASDDT, ;BASDDT=1 FOR DDT IFE NOCODE,< IFE BASDDT, IFN BASDDT,<TITLE BSXCT1 EXECUTE PHASE > > IFN NOCODE,< UNIVERSAL BSYXCT > ;****** END UOFP SEGMENTED BASIC ****** SUBTTL PARAMETERS AND TABLES ;***COPYRIGHT 1969,1970,1971,1972,1973,1974 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.*** ;VERSION 17E 2-OCT-74/NA ;VERSION 17D 4-MAY-73/KK ;VERSION 17C 2-JAN-73/KK ;VERSION 17B 25-JUL-72/KK ;VERSION 17A 10-FEB-1972/KK ;VERSION 17 15-OCT-1971/KK ;VERSION 16 5-APR-1971/KK ;VERSION 15 17-AUG-1970/KK ;VERSION 14 16-JUL-1970/AL/KK ;VERSION 13 15-SEP-1969 LOC .JBINT TRPLOC LOC .JBVER BYTE (3)VWHO(9)VBASIC(6)VMINOR(18)VEDIT LOC .JB41 JSR UUOH ;****** UOFP SEGMENTED BASIC ****** IFE NOCODE,< RELOC HISEG > IFN NOCODE,<LOC 400010> ;****** END UOFP SEGMENTED BASIC ****** INTERN ERRCNT,LINADR,ERRB,ERLB INTERN EOF31,EOF32,CRLF3,CLSRAN,PRTNUM INTERN CHAER1,ERRXCY,ERRXCX INTERN ATANB,CHRB,CLOGB,COSB,COTB,EXPB,INSTRB,INTB INTERN LEFTB,LENB,LOGB,MIDB,RIGHTB,RNDB,SGNB,SINB,SLEEPB,SPACEB INTERN SQRTB,STRB,TANB,VALB,PCRLF INTERN TIMEB,DATEB,DAYB,ECHOB,FIXB,LINEB,PIB,POSB,ASCIIB INTERN APPEND,CHAERR,CHAHAN,CHKIMG,CLSFIL,CNER1,CRLF INTERN DOINPT,DOREAD,EIFLOT,ENDIMG,EOF,EUXIT,EXP3.0,FNMX0 INTERN EXP1.0,EXP2.0 INTERN FNMXER,FRETRN,GOSBER,IFIX,IMGLIN,INSEQ,INSET,MARERR,MARGAL,MARGN INTERN MASTST,OPNFIL,OUTSET,PAGE,PAGEAL,PRDLER,RANDER,RANSCR INTERN REINER,RESTON,RETURN,RNNUMO,RNSTRO,SAVACS,SCATH INTERN SCNIMN,SCNIMS,SETCOR,SETERR,SEVEN,WRPRER,XCTON,XRES INTERN UUOHAN INTERN FIXPNT,FLTPNT XLIST IFN BASTEK,< LIST INTERN INIPLT,PAGPLT,LINPLT,ORGPLT,STRPLT,MOVPLT,WHRPLT INTERN CURPLT,SAVPLT XLIST > LIST EXTERN ACTBL,APBMAX,APPMAX,ARAROL,BA,BGNTIM,BLOCK,C3,CECOD,CEIL,CESVR EXTERN CEVSP,CHAFL2,CHAFLG,CLOSED,COMTIM,CORINC,CRTVAL,DATAFF EXTERN DATLIN,DECROL,DETER,DREL,ELETOP,ENT,ENTDSK,EOFFLG EXTERN ELECT1,ELECT2,ELECT3,ERR,ERL,ERRGO,ERRTRO EXTERN TYPE,PFLAG,FTYPE,INLNFG EXTERN ES2,EX1,EXTD,EXTFG,FCNLNK,FILD,FILDIR,FILFLG,FPPN EXTERN FILTYP,FIRSFL,FLCOD,FLLIN,FLVIR,FLOAT,FLOOR,FLSVR EXTERN FLVSP,FMTPNT,FUNAME,GTSTS,HPOS,IBDSK,IBDSK2 EXTERN IFIFG,IFNFLG,INITO,INNDSK,INPFLA,INPRES,INVFLG,INVLRG EXTERN LASREC,LEAD,LIBFLG,LINB0,LINNUM,LINROL,LOK EXTERN LOKUP,LZ,MARGIN,MARWAI,MASAPP,MASMAX,MIDSAV,MODBLK,MTIME EXTERN NEWOL1,NOTLIN,NUMCOT,NUMRES,NXTROL,OBDSK,OBDSK2,OBF,ODF EXTERN OUCH,OUTDSK,OUTERR,OUTTDS,PAGCNT,PAGLIM,PINPNM EXTERN PINPUT,PIVOT,PLIST,POINT,PREAD,PROTEC,PSAV,QUERYF,QLIST EXTERN QSKIP,QUOFL1,QUOFLG,QUOTBL,RANCNT,RANTST,REAINP EXTERN REATMP,RENAMD,RNDDAT,RNDIDX,RUNFLA,RUNLIN EXTERN SAVE1,SB1M1,SB2M1,SCAROL,SORCLN,SRTDBA,STODSK EXTERN STRCTR,STRFCN,STRLEN,STRPTR,SVRBOT,SVRROL,SVRTOP,SX EXTERN TABVAL,TEMLOC,TEMP1,TEMP2,TEMP3,TRAIL,TRPLOC EXTERN USETID,USETOD,UUOH,UXFLAG,VALPTR,VARFRE,VARROL EXTERN VECT1,VECT2,VPAKFL,VRFBOT,VRFBTB,VRFTOP,VSPROL EXTERN VIRSIZ,VIRWRD EXTERN WRIPRI,ZONFLG EXTERN .JBFF,.JBREL,.JBTPC ;****** EXTERNALS FROM BASLIB (XCTLIB) EXTERN BASORT,CPOPJ,CPOPJ1,CTTAB,D1E14,D1EM18,D1EM4 EXTERN DATCHK,DATTBL,DECCEI,DECFLO,DECTAB,DPBSTR EXTERN EOFFL,ERRMS3,EVANUM,FILNAM,FILNMO EXTERN FIXCON,GOSR2,GOSR3,INLINE,INLMES EXTERN LINPT,LOCKOF,LOCKON,NOGETD,NXCH,NXCHD,NXCHD2,NXCHS EXTERN OUCH,OUTCNT,OUTPT,PRNNAM,PRNSIX,PTXER1,QSA EXTERN SEARCH,SKIPDA,TTYIN,UXIT6,UXIT7,VPANIC,VSUB1 ;****** END EXTERNALS FROM BASLIB (XCTLIB) IFN BASDDT,< EXTERN DDTGO > EXTERN .USREL,RUNDDT,NOLINE INTERN CHAXIT,EXECUT,OVTRAP,HSGVER,REUXIT,UXIT BASIC=UXIT RUNNH=UXIT EUXIT=UXIT EIFLOT=IFLOAT EXTERN LUXIT1,ERRBPT,ERRTCN,ERRTBL,ERRTXT UXIT1=LUXIT1 IFN NOCODE,< IF2,< END> > ERRNUM=0 DEFINE INLBSY(A,B),< IFN NOCODE,< ERRNUM=ERRNUM+1 DEFINE ERM'A <EMS'A: ASCIZ B> > > ;C=PDP-11 TYPE ERROR # CORRESPONDING TO PDP-10 ERROR # A. DEFINE INLERR(C,A,B) < BYTE (9) 1,0,^D'C,^D'A IFN NOCODE,<XLIST ERRNUM=ERRNUM+1 DEFINE ERM'A <EMS'A: ASCIZ B> LIST> > DEFINE INLEMS(C,A,B) < BYTE (9) 1,0,^D'C,^D'A> DEFINE NFERR(C,A) < BYTE (9) 1,0,^D'C,^D'A> DEFINE ERROM(A,B) <IFN NOCODE,<XLIST ERRNUM=ERRNUM+1 DEFINE ERM'A <EMS'A: ASCIZ B> LIST> > %OPD=1 ;OPDEF UUO COUNTER DEFINE OPCNT (A)< %OPD=%OPD+1 IFG %OPD-37,<PRINTX <TOO MANY UUO'S>> OPDEF A [<%OPD>B8]> OPCNT PRNM OPCNT PRDL OPCNT PRNTB OPCNT GOSUB OPCNT ARFET1 OPCNT ARFET2 OPCNT ARSTO1 OPCNT ARSTO2 OPCNT ARSTN1 OPCNT ARSTN2 OPCNT DATA OPCNT ADATA1 OPCNT ADATA2 OPCNT SDIM OPCNT MATRD OPCNT MATPR OPCNT MATSCA OPCNT MATCON OPCNT MATIDN OPCNT MATTRN OPCNT MATINV OPCNT MATADD OPCNT MATSUB OPCNT MATMPY OPCNT MATZER OPCNT STRUUO OPCNT SVRADR OPCNT PRSTR OPCNT DONFOR OPCNT MATINP MAXUUO=%OPD UUOHAN: PUSH P,UUOH ;RETURN ADDRS ON PUSH-DOWN LIST LDB X1,[POINT 9,40,8] IFL MAXUUO-37,< CAILE X1,MAXUUO HALT ;ILLEGAL UUO. > UUOTBL: JRST .(X1) JRST ERRXCT JRST PRNMER JRST PRDLER JRST PRNTBR JRST GOSBER JRST AFT1ER JRST AFT2ER JRST AST1ER JRST AST2ER JRST ASN1ER JRST ASN2ER JRST DSKRT JRST ADT1ER JRST ADT2ER JRST SDIMER JRST MTRDER JRST MTPRER JRST MTSCER JRST MTCNER JRST MTIDER JRST MTTNER JRST MTIVER JRST MTADER JRST MTSBER JRST MTMYER JRST MTZRER JRST SUUOEX JRST SAD1ER JRST PRSTRR JRST FORCOM JRST MATIN HSGVER: SIXBIT /BASX13/ ;[3] SEGMENT VERSION DSKRT: LDB X1,[POINT 4,40,12] CLEARM FTYPE ;ASSUME REAL TRZE X1,10 ;IS IT INTEGER? SETOM FTYPE ;YES, MARK IT DPB X1,[POINT 4,40,12] JRST .+1(X1) JRST DATAER ;DATA 0, UUO. JRST RANUM ;DATA 1, -- R.A. JRST RANUM1 ;DATA 2, -- R.A. JRST RANUM2 ;DATA 3, -- R.A. JRST RANSTR ;DATA 4, -- R.A. SUUOEX: LDB X1,[POINT 4,40,12] ;STRING UUOS USE THE AC FIELD CAILE X1,MASUUO ;AS AN EXTENSION OF THE OPCODE. HALT . UUOSTR: JRST .(X1) JRST PUTSTR JRST COMSTR JRST INSTR JRST GETVEC JRST PUTVEC JRST STRCHA JRST GETVEC ;INTEGER FETCH JRST PUTVEC ;INTEGER STORE MASUUO=.-UUOSTR-1 OPDEF STRSTO [STRUUO 1,] OPDEF STRIF [STRUUO 2,] OPDEF STRIN [STRUUO 3,] OPDEF VECFET [STRUUO 4,] OPDEF VECPUT [STRUUO 5,] OPDEF STOCHA [STRUUO 6,] INLBSY(57,</ ? No such device />) INLBSY(58,</ ? Quota exceeded or block no. too large on output device/>) INLBSY(59,</ ? Device is write locked/>) INLBSY(69,</ ? Input line too long/>) REUXIT: SETZM MTIME UXIT: SETZM CHAFL2 SETZM CHAFLG CHAXIT: SETZM FUNAME JRST XXXXXX## SUBTTL BEGIN EXECUTION ;BEGIN EXECUTION ENTRY DDTNH DDTNH: IFN BASDDT,< JRST DDTGO > IFE BASDDT,< JFCL > EXECUT: SETOM FCNLNK ;INITIALIZE FCN CALLS SETOM PFLAG ;ASSUME AMBIGUOUS CONSTANTS ARE INTEGER SETZM ERR ;CLEAR ERR FLAG SETOM NOLINE ;DO NOT PRINT LINE # ON ERROR YET CLEARM CRTVAL ;DEFAULT CRT VAL = 0, 10-13 ILLEGAL SETZM ERRGO ;CLEARM ERROR RETURN SETZM ERL ;CLEAR ERR LINE MOVEM P,PSAV ;SAVE CURRENT PUSHDOWN POINTER MOVE X1,.JBREL ;GET HIGH MARK SKIPN RUNDDT ;DOING BASDDT? MOVEM X1,.USREL ;NO, SET AS USER HIGH MARK MOVEI X1,DECFLO ; MOVEI T,DECROL MOVEM X1,FLOOR(T) MOVEI X1,DECCEI MOVEM X1,CEIL(T) PUSHJ P,RESTOR ;SET TO START AT BEGINNING OF DATA SETZB R,COMTIM ;POINTER TO GOSUB RTRN AOS COMTIM PUSHJ P,INLMES ;RETURNS SIGNAL END OF COMPILATION. ASCIZ / / OUTPUT ;INITIALIZE SOME SWITCHES: SETZM INPFLA ;NO INPUT CURRENTLY BEING READ SETZM FILFLG HRRZ X1,VARFRE ;SET UP FILES. MOVEM X1,.JBFF MOVEI X1,9 EXLAB1: SETZM PROTEC-1(X1) SOJG X1,EXLAB1 MOVEI X1,9 EXEC6: SKIPN A,ACTBL-1(X1) JRST EXEC11 ;NO FILE ON THIS CHANNEL. EXEC0: HRRZ T1,.JBFF HRLM T1,BA-1(X1) SETZM @FILMOD-1(X1) ;MODE IS ASCII FOR SEQ. JUMPG A,EXEC7 ;FILES AND STRING R.A. FILES, MOVEI T1,34 ;BINARY FOR NUMERIC R.A. FILES. SKIPL STRLEN-1(X1) ;SET USER WORD COUNT FOR R.A. FILES. MOVEI T1,20 MOVEM T1,@FILMOD-1(X1) EXEC7: XCT INITO-1(X1) JRST [MOVE T,OPS1+1 JRST NOGETD] DPB X1,[POINT 4,LOKUP,12] MOVE N,FILD-1(X1) MOVEM N,LOK MOVE N,FPPN-1(X1) MOVEM N,LOK+3 MOVE N,EXTD-1(X1) MOVEM N,LOK+1 SETZM LOK+2 PUSH P,N ;CHECK FOR CORE BEFORE INBUFS. HRRZ N,.JBFF ADDI N,406 CAMG N,.USREL JRST EXEC71 ;OKAY MOVEI N,2000 MOVEM N,CORINC ADD N,.JBREL CORE N, JRST [SETZM ACTBL-1(X1) INLEMS(60,60,PANIC1) JRST GOSR2] ;ABORT IFE BASDDT,< PUSHJ P,NPANIC > IFN BASDDT,< PUSHJ P,DPANIC## > EXEC71: POP P,N JUMPL A,EXEC8 ;SEQ. OR R.A.? DPB X1,[POINT 4,IBDSK2,12] ;SEQ. XCT IBDSK2 SETZM PROTEC-1(X1) XCT LOKUP JRST [HRRZ T1,LOK+1 TRZ T1,777770 JUMPN T1,LOOKFL MOVEI T1,2 JRST EXLAB2] MOVEI T1,1 EXLAB2: MOVEM T1,ACTBL-1(X1) ;SET UP ACTBL. CAIE T1,1 JRST EXEC72 HLLZ T1,LOK+2 ;SAVE < >. TLZ T1,777 MOVEM T1,PROTEC-1(X1) EXEC72: HRRZ T1,.JBFF HRRM T1,BA-1(X1) ;SET UP BA. JRST EXEC12 EXEC8: DPB X1,[POINT 4,IBDSK,12] ;RANDOM ACCESS. XCT IBDSK HLLZM N,ENT+1 MOVE N,FILD-1(X1) MOVEM N,ENT DPB X1,[POINT 4,OBDSK,12] XCT OBDSK DPB X1,[POINT 4,ENTDSK,12] SETZM ENT+2 MOVE T1,FPPN-1(X1) MOVEM T1,ENT+3 SETZM PROTEC-1(X1) XCT LOKUP ;DOES FILE EXIST NOW. JRST [MOVE T1,.JBFF HRRZ A,LOK+1 JUMPN A,LOOKFL JRST EXEC9] HLLZ T1,LOK+2 TLZ T1,777 MOVEM T1,PROTEC-1(X1) MOVEM T1,ENT+2 MOVE T1,.JBFF XCT ENTDSK ;YES. JRST ENFFAL DPB X1,[POINT 4,OUTTDS,12] ;SET UP BUFFER. XCT OUTTDS JRST EXLAB3 JRST EXEC86 EXLAB3: DPB X1,[POINT 4,INNDSK,12] ;SET UP BUFFER. XCT INNDSK JRST EXEC81 EXEC89: DPB X1,[POINT 4,STODSK,12] XCT STODSK JRST EXEC91 ;NULL FILE--SAME AS NON-EXISTENT. EXEC86: SETZM ACTBL-1(LP) INLEMS(1,70,INLSYS) ;SYSTEM ERROR JRST GOSR2 EXEC81: MOVE T1,-403(T1) ;GET FIRST WORD. TLNN T1,377777 JRST EXEC83 EXEC82: PUSH P,.JBFF PUSH P,[Z EXNAME] EXNAM: PUSH P,X1 INLERR(10,61,</ ? File />) POP P,X1 EXNAM2: MOVE T,FILD-1(X1) MOVEM T,FILDIR MOVE T,EXTD-1(X1) MOVEM T,FILDIR+1 MOVE T,FPPN-1(X1) MOVEM T,FILDIR+3 SETZM SAVE1 PUSHJ P,ERRXCX JRST PRNNAM EXNAME: PUSHJ P,ERRXCY PUSH P,X1 INLERR(10,62,</ is not random access />) POP P,X1 EXNAM1: SKIPE NOLINE ;SHOULD WE PRINT LINE # JRST EXNAM3 ;YES, DON'T OUTPUT LINE NUMBER PUSH P,X1 INLERR (34,66,</ in line />) POP P,X1 MOVE T,BLOCK-1(X1) PUSHJ P,ERRXCX PUSHJ P,PRTNUM EXNAM3: SETZM ACTBL-1(X1) SKIPE CHAFL2 PUSHJ P,ERRMS3 OUTPUT POP P,.JBFF PUSHJ P,ERRXCY SKIPE FILFLG JRST UXIT SETZM RUNFLA JRST EXEC12 EXEC83: HRRZM T1,LASREC-1(X1) MOVE T1,.JBFF SKIPGE A,STRLEN-1(X1) ;NUMERIC OR STRING. JRST EXEC85 ;NUMERIC. MOVE T1,-402(T1) ;STRING. CAMGE T1,[000001000000] JRST EXEC82 JUMPN A,EXEC84 MOVEM T1,STRLEN-1(X1) HRRZI T1,(T1) CAIG T1,^D132 CAIGE T1,1 JRST EXEC82 JRST EXEC10 EXEC84: CAME A,T1 JRST EXLAB4 MOVEM A,STRLEN-1(X1) JRST EXEC10 EXLAB4: PUSH P,.JBFF PUSHJ P,EXNAM PUSH P,X1 INLERR(10,63,</ record length or type does not match />) POP P,X1 JRST EXNAM1 EXEC85: SKIPE -402(T1) JRST EXEC82 SETOM STRLEN-1(X1) JRST EXEC10 EXEC9: XCT ENTDSK ;NON-EXISTENT FILE. JRST ENFFAL DPB X1,[POINT 4,OUTTDS,12] ;SET UP BUFFER. XCT OUTTDS JRST EXEC91 JRST EXEC86 EXEC91: SETZM LASREC-1(X1) MOVE A,.JBFF ;CLEAR OUTPUT BUFFER. SUBI A,200 EXLAB5: SETZM -1(T1) SOJ T1, CAIE T1,(A) JRST EXLAB5 SKIPL A,STRLEN-1(X1) ;NUMERIC OR STRING? JRST EXEC92 ;STRING. HRLZI A,400000 ;NUMERIC. MOVEM A,(T1) JRST EXEC93 EXEC92: JUMPN A,EXLAB6 MOVE A,[XWD ^D8,^D34] EXLAB6: MOVEM A,1(T1) MOVEM A,STRLEN-1(X1) EXEC93: MOVEI A,200 ;SET THE WORD COUNT. HRRM A,-1(T1) DPB X1,[POINT 4,OUTTDS,12] XCT OUTTDS JRST EXEC94 ;OUTPUT THE HEADER RECORD. DPB X1,[POINT 4,GTSTS,12] XCT GTSTS JRST [SETZM ACTBL-1(X1) JRST OUTERR] EXEC94: DPB X1,[POINT 4,CLOSED,12] XCT CLOSED HLLZS LOK+1 SETZM LOK+2 MOVE T1,FPPN-1(X1) MOVEM T1,LOK+3 XCT LOKUP JRST [HRRZ T1,LOK+1 TRZ T1,777770 JRST LOOKFL] HLLZS ENT+1 SETZM ENT+2 LDB T1,[POINT 9,PROTEC-1(X1),8] DPB T1,[POINT 9,ENT+2,8] MOVE T1,FPPN-1(X1) MOVEM T1,ENT+3 XCT ENTDSK JRST ENFFAL HLRZ T1,BA-1(X1) MOVEM T1,.JBFF DPB X1,[POINT 4,IBDSK,12] DPB X1,[POINT 4,OBDSK,12] XCT IBDSK XCT OBDSK DPB X1,[POINT 4,OUTTDS,12] DPB X1,[POINT 4,INNDSK,12] XCT OUTTDS JRST EXLAB7 JRST EXEC86 EXLAB7: XCT INNDSK JRST EXEC10 JRST EXEC86 EXEC10: HRRZ T1,.JBFF HRRM T1,BA-1(X1) JRST EXEC12 EXEC11: SETZM BA-1(X1) EXEC12: SKIPGE FILFLG ;DON'T LOOP--IF ONCE JRST OPNFL4 ;ONLY FILE STATEMENT. SOJG X1,EXEC6 ;GO BACK TO LOOP. MOVE X1,.JBFF MOVEM X1,VARFRE JRST EXEC1 LOOKFL: PUSH P,.JBFF PUSH P,X1 INLERR(5,64,</ ? Cannot lookup file />) POP P,X1 JRST ENTLOK ENFFAL: PUSH P,.JBFF PUSH P,X1 INLERR(4,65,</ ? Cannot enter file />) POP P,X1 ENTLOK: PUSHJ P,EXNAM2 PUSHJ P,ERRXCY JRST EXNAM1 EXEC1: PUSHJ P,BASORT ;SORT THE TABLE BA INTO SRTDBA. MOVEI X1,^D9 EXEC2: SETZM PINPNM-1(X1) SETZM WRIPRI-1(X1) SETZM REAINP-1(X1) SETZM BLOCK-1(X1) SETZM MODBLK-1(X1) SETZM POINT-1(X1) AOS POINT-1(X1) SETZM EOFFLG-1(X1) SOJG X1,EXEC2 MOVEI N,^D72 MOVEI X1,^D9 EXEC3: SETZM HPOS(X1) SETOM FIRSFL(X1) SETZM TABVAL(X1) SETZM FMTPNT(X1) SETZM MARWAI(X1) SETOM PAGLIM(X1) SETZM QUOTBL(X1) SETOM ZONFLG(X1) MOVEM N,MARGIN(X1) SOJGE X1,EXEC3 SKIPE RUNFLA ;SKIP IF AN ERROR HAS OCCURRED SETOM UXFLAG SETOM NUMRES ;NO MAT INPUT HAS OCCURRED YET SETZ N, ;ARG FOR RANDOM NUMBER SET UP. PUSHJ P,RANDOM ;INITIALIZE THE "STANDARD" RANDOM NUMBERS. MOVEI X1,630010 APRENB X1, PUSHJ P,LOCKOF ;EXECUTION MAY BE INTERRUPTED. SETZM IFIFG SETZM ODF MOVEI Q,MASAPP MOVEM Q,MASAPP MOVE Q,QLIST SETZM INVFLG SETZM VRFBOT SKIPN RUNDDT SKIPE RUNFLA ;IF ANY ERRORS CAIA ;UNLESS UNDER BASDDT JRST UXIT ;EXIT SETZ X1, ;SET THE CORE INCREMENT AS A FUNCTION MOVE A,FLSVR ;OF THE NUMBER OF STRING VARIABLES IN EXEC31: CAML A,CESVR ;THE PROGRAM. JRST EXEC33 HLRZ X2,(A) ADDI X1,(X2) ;ADD IN THE ARRAYS. ADDI A,3 JRST EXEC31 EXEC33: HRRZ X2,CEVSP SUB X2,FLVSP ADDI X1,(X2) ;ADD IN THE SCALARS. MOVEI A,2000 CAIG X1,^D200 JRST EXEC35 MOVEI A,4000 CAILE X1,^D500 MOVEI A,6000 EXEC35: MOVEM A,CORINC SKIPE CHAFLG ;CHAINING? JRST EXEC4 ;YES. DON'T DISTURB TIME. SETZ A, RUNTIM A, MOVEM A,BGNTIM EXEC4: SETZM NOLINE ;NOW PRINT LINE #S ON ERRORS SKIPGE A,RUNLIN ;BEGIN EXECUTION--- JRST @FLCOD ;AT THE BEGINNING. JRST (A) ;AT A LINE NUMBER. XFIL30: ADDI B,-60(C) PUSHJ P,NXCH TLNN C,F.DIG POPJ P, IMULI B,^D10 JRST XFIL30 SUBTTL RUNTIME ROUTINES ;RUNTIME ROUTINE TO CLOSE FILES FOR FILE STATEMENTS. CLSFIL: SKIPN FILD-1(LP) ;IS FILE ESTABLISHED? JRST FNR ;NO, THEN CAN'T CLOSE IFN BASTEK,< CAMN LP,PLTOUT ; CLEARM PLTOUT ; CAMN LP,PLTIN ; CLEARM PLTIN > SKIPG X2,ACTBL-1(LP) ;SEQ. OR R.A.? JRST CLSRAN CAIE X2,3 ;SEQ. JRST CLSSE1 SETOM ODF SKIPE HPOS(LP) PUSHJ P,CRLF3 ;END CURRENT LINE. CLSSE1: DPB LP,[POINT 4,DREL,12] XCT DREL MOVEI X1,3 CAME X1,ACTBL-1(LP) POPJ P, MOVEI X1,(LP) ;FILE IS IN WRITE MODE, PUSHJ P,UXIT6 ;SO SET UP PROTECTION CODE. XCT DREL POPJ P, CLSRAN: MOVE X2,BLOCK-1(LP) ;R.A. SKIPE MODBLK-1(LP) PUSHJ P,OUTRAN MOVEI X2,1 PUSHJ P,INRAN HLRZ X2,BA-1(LP) HRRZ X1,3(X2) CAMN X1,LASREC-1(LP) ;NEED TO UPDATE LAST REC. NO.? JRST CLSRN1 MOVE X1,LASREC-1(LP) ;YES. HRRM X1,3(X2) MOVEI X2,1 PUSHJ P,OUTRAN CLSRN1: PUSH P,B ;LAST BLOCK NEEDS COUNT NE 200? PUSH P,T PUSH P,T1 MOVE T,LASREC-1(LP) SKIPG STRLEN-1(LP) JRST CLSRN2 HLRZ B,STRLEN-1(LP) ;STR FILE. MOVEI X1,^D128 IDIVI X1,(B) IDIVI T,(X1) MOVEI T1,1(T1) IMULI T1,(B) JRST CLSR22 CLSRN2: MOVEI T,1(T) ;NUM. FILE. IDIVI T,^D128 MOVEI T1,1(T1) CLSR22: MOVEI X2,1(T) PUSHJ P,INRAN HLRZ X1,BA-1(LP) HRRZ T,2(X1) CAIN T,(T1) JRST CLSRN3 ;NO, NEEDS 200, WHICH IT ALREADY HAS. HRRM X2,USETOD-1(LP) ;YES, NEEDS NE 200 COUNT. XCT USETOD-1(LP) HRLI X2,3(X1) MOVEI X1,206(X1) HRRI X2,(X1) BLT X2,177(X1) HRRM T1,-1(X1) ;SET THE COUNT. DPB LP,[POINT 4, OUTTDS,12] XCT OUTTDS JRST CLSRN3 DPB LP,[POINT 4, GTSTS,12] XCT GTSTS JRST [SETZM ACTBL-1(LP) JRST OUTERR] CLSRN3: POP P,T1 POP P,T POP P,B MOVEI X2,3 MOVEM X2,ACTBL-1(LP) JRST CLSSE1 ;RUNTIME ROUTINE TO OPEN FILES FOR THE FILE STATEMENT. OPNFIL: PUSHJ P,STRPL1 ;GET STR + 1 SPACE. JRST CHAER1 SOS MASAPP PUSHJ P,FILNMO ;GET FILENM.EXT. JUMP SAVE1 PUSH P,T PUSH P,C SETZM FILD-1(LP) ;CHECK FOR DUPLICATE NAME. MOVEI D,9 MOVE X1,FILDIR OPNL1: MOVE X2,FILDIR+1 OPNL2: CAMN X1,FILD-1(D) CAME X2,EXTD-1(D) JRST OPNL3 MOVE X2,FILDIR+3 CAMN X2,FPPN-1(D) JRST OPNER2 SOJG D,OPNL1 SKIPA X2,FILDIR+1 OPNL3: SOJG D,OPNL2 OPNFL1: MOVEM X1,FILD-1(LP) MOVEM X2,EXTD-1(LP) MOVE X2,FILDIR+3 MOVEM X2,FPPN-1(LP) HLRZ T,BA-1(LP) ;GET BUFFERS. JUMPN T,OPNFL2 PUSHJ P,VCHBUF HRLM T,BA-1(LP) ADDI T,406 HRRM T,BA-1(LP) PUSHJ P,BASORT HLRZ T,BA-1(LP) OPNFL2: MOVEM T,.JBFF POP P,C POP P,T MOVE N,VALPTR CAME N,T ;SEQ. OR R.A.? JRST OPNFL6 ;R.A. OR ERROR. SKIPLE FILTYP ;VIRTUAL OPEN? JRST OPNF20 ;YES. SKIPE FILTYP ;SEQ. JRST FNMX1 MOVEI A,1 OPNFL3: MOVEM A,ACTBL-1(LP) ;SET UP FOR EXEC. HRRZ X1,SORCLN SKIPN NOTLIN HRRZ X1,0(X1) ;SORCLN NOW POINTS TO LINE #. MOVEM X1,BLOCK-1(LP) MOVEI X1,(LP) SETOM FILFLG JRST EXEC0 OPNFL4: POP P,Q ;RETURN HERE FROM EXEC. MOVEI X2,OPLAB1 JRST RESACS ;RESTORE THE AC'S. OPLAB1: SKIPL ACTBL-1(LP) ;CLEAR AND SET UP FLAGS. JRST OPNFL5 SETZM BLOCK-1(LP) SETZM MODBLK-1(LP) MOVEI X1,1 MOVEM X1,POINT-1(LP) POPJ P, OPNFL5: MOVEI X1,^D72 MOVEM X1,MARGIN(LP) SETZM MARWAI(LP) SETOM PAGLIM(LP) SETZM QUOTBL(LP) MOVEI X1,(LP) JRST XRES01 OPNFL6: MOVEI X2,"%" ;R.A. OR ERROR. CAIE X2,(C) JRST OPNFL8 PUSHJ P,NXCH OPNF20: HRLZI X1,400000 MOVEM X1,STRLEN-1(LP) OPNF11: SKIPN FILTYP JRST FNMX1 MOVE N,VALPTR CAME N,T JRST CHAER1 SETO A, SKIPLE FILTYP ;VIRTUAL ARRAY? SOJ A, ;YES. -2 TO ACTBL JRST OPNFL3 OPNFL8: TLNN C,F.DOLL JRST CHAER1 PUSHJ P,NXCH SETZ B, TLNN C,F.DIG JRST [SETZM STRLEN-1(LP) JRST OPNF11] PUSHJ P,XFIL30 SKIPLE B CAILE B,^D132 JRST OPNER4 OPNF10: MOVEM B,STRLEN-1(LP) ADDI B,4 IDIVI B,5 ADDI B,1 HRLM B,STRLEN-1(LP) JRST OPNF11 OPNER2: INLERR(3,67,</ ? File />) SETZM SAVE1 PUSHJ P,ERRXCX PUSHJ P,PRNNAM PUSHJ P,ERRXCY INLERR(34,1,</ on more than one channel/>) JRST GOSR2 OPNER4: INLERR(7,2,</ ? String record length < 1 or > 132/>) JRST GOSR2 DEFINE R(A) <IRP A < EXP OPS'A EXTERN OPS'A>> FILMOD: R<1,2,3,4,5,6,7,8,9> INSEQ: SETOM QUERYF ;FLAG NO ? JRST INSET2 INSET: JUMPN LP,INSET1 ;TTY? SETZM QUERYF ;FLAG QUERY TO GO OUT INSET2: SETZM IFIFG ;YES. POPJ P, INSET1: SKIPG X1,ACTBL-1(LP) ;NO. GET CORRESPONDING ACCESS CODE. JRST FNMXER CAMN LP,PLTIN ;PLOTTING FILE? JRST PLTERR ;NO, GIVE ERROR CAIE X1,1 ;IF NOT EQUAL TO 1, FILE NOT OK FOR READING JRST ILRD ;ILLEGAL READ ERROR MESSAGE SETOM IFIFG POPJ P, ;END OF FILE TEST. EOF: SKIPG X2,ACTBL-1(LP) ;ACTBL ENTRY = 1 MEANS A READABLE FILE. JRST FNMXER CAIE X2,1 JRST EOF6 SETOM IFIFG EOF30: SKIPN T,PINPNM-1(LP) ;CHECK THE LINE BUFFER. JRST EOF3 PUSHJ P,DELAWY TLNN C,F.CR JRST EOF0 SETZM PINPNM-1(LP) EOF3: SETZ X1, ;NEED ANOTHER LINE. NXIN5 WILL CHECK PUSHJ P,NXIN5 ;TO SEE IF IT SHOULD COME BACK HERE BY EOF32: JRST EOF30 ;LOOKING FOR EOF32 ON PLIST. EOF31: POP P,X1 ;BACK HERE FROM INLINE; CLEAR PUSH LIST. POP P,X1 POP P,X1 SETZM IFIFG POPJ P, EOF0: SETZM IFIFG SKIPN REAINP-1(LP) ;WARN READ# STATEMENTS TO SKIP SETOM EOFFLG-1(LP) ;A LINE NUMBER; PROBLEM ONLY ARISES JRST CPOPJ1 ;IF MODE WAS NOT SET WHEN IF END# WAS EXECUTED. EOF6: PUSHJ P,TTYIN INLERR(10,3,</ ? IF END asked for unreadable file/>) JRST GOSR2 ;RESTORE. XRES: SKIPG X2,ACTBL-1(LP) ;GET ACCESS CODE. JRST FNMXER CAIE X2,3 JRST XRES0 SETOM ODF SKIPE HPOS(LP) PUSHJ P,CRLF3 XRES0: DPB LP,[POINT 4,DREL,12] ;DEPOSIT CHANNEL NUMBER FOR RELEASE XCT DREL ;DO RELEASE HLRZ X2,BA-1(LP) ;GET BUFFER ADDRESS MOVEM X2,.JBFF SETZM @FILMOD-1(LP) ;SET MODE TO ASCII. XCT INITO-1(LP) ;INIT THAT CHANNEL JRST [MOVE T,OPS1+1 JRST NOGETD] DPB LP,[POINT 4, IBDSK, 12] XCT IBDSK MOVE X2,FILD-1(LP) ;GET FILE NAME MOVEM X2,LOK ;SET FOR LOOKUP MOVE X2,EXTD-1(LP) MOVEM X2,LOK+1 SETZM LOK+2 MOVE X2,FPPN-1(LP) ;GET PJ-PG MOVEM X2,LOK+3 ;SAVE IT FOR LOOKUP DPB LP,[POINT 4,LOKUP,12] ;SET CHANNEL FOR LOOKUP XCT LOKUP ;DO LOOKUP JRST LOKFAL MOVE X2,ACTBL-1(LP) CAIE X2,3 JRST XRES00 MOVEI X1,(LP) PUSHJ P,UXIT7 MOVEI X2,1 MOVEM X2,ACTBL-1(LP) JRST XRES0 XRES00: MOVEI X2,1 MOVEM X2,ACTBL-1(LP) ;SET ACCESS TABLE FOR READ XRES01: SETZM PINPNM-1(LP) SETZM REAINP-1(LP) SETZM EOFFLG-1(LP) SETZM ODF POPJ P, ;SCRATCH SCATH: SKIPG X2,ACTBL-1(LP) ;GET ACCESS CODE JRST FNMXER HLRZ X2,BA-1(LP) ;GET BUFFER ADDRESS MOVEM X2,.JBFF SETZM @FILMOD-1(LP) ;SET MODE TO ASCII. XCT INITO-1(LP) ;DO INIT JRST [MOVE T,OPS1+1 JRST NOGETD] DPB LP,[POINT 4,OBDSK2,12] ;SET CHANNEL FOR OUTBUF XCT OBDSK2 ;DO "OUTBUF" MOVE X2,FILD-1(LP) ;GET FILE NAME MOVEM X2,ENT ;SET FOR ENTER MOVE X2,EXTD-1(LP) HLLZM X2,ENT+1 SETZM ENT+2 LDB T1,[POINT 9,PROTEC-1(LP),8] DPB T1,[POINT 9,ENT+2,8] MOVE X2,FPPN-1(LP) MOVEM X2,ENT+3 DPB LP,[POINT 4,ENTDSK,12] ;SET CHANNEL FOR ENTER XCT ENTDSK ;DO ENTER JRST ENFAIL ;ENTER FAILED DPB LP,[POINT 4,OUTDSK,12] ;SET FOR DUMMY OUTPUT XCT OUTDSK ;DO DUMMY OUTPUT MOVEI X2,3 ;FILE OK FOR WRITING MOVEM X2,ACTBL-1(LP) ;TELL ACCESS TABLE MOVEI X2,^D990 MOVEM X2,LINNUM-1(LP) SETZM WRIPRI-1(LP) SETZM HPOS(LP) SETOM FIRSFL(LP) SETZM FMTPNT(LP) SETZM PAGCNT(LP) SETZM TABVAL(LP) SETOM ZONFLG(LP) POPJ P, ;R.A. RUNTIME SCRATCH. RANSCR: SKIPL ACTBL-1(LP) JRST FNMXER SETZM LOK DPB LP,[POINT 4,RENAMD,12] ;ERASE FILE. XCT RENAMD JRST RANSRF MOVE X1,FILD-1(LP) MOVEM X1,ENT MOVEM X1,LOK MOVE X1,EXTD-1(LP) HLLZM X1,ENT+1 HLLZM X1,LOK+1 SETZM ENT+2 LDB X1,[POINT 9,PROTEC-1(LP),8] DPB X1,[POINT 9,ENT+2,8] ;PRESERVE PROTECTION MOVE X1,FPPN-1(LP) MOVEM X1,ENT+3 DPB LP,[POINT 4,ENTDSK,12] XCT ENTDSK JRST ENFAIL HLRZ X1,BA-1(LP) ADDI X1,203 MOVEM X1,.JBFF ;SET UP HEADER RECORD. DPB LP,[POINT 4,OBDSK,12] XCT OBDSK DPB LP,[POINT 4,OUTTDS,12] XCT OUTTDS JRST RSLAB1 JRST RANSC5 RSLAB1: MOVE X2,.JBFF SOJ X2, RANSC1: SETZM (X2) SOJ X2, CAIL X2,3(X1) JRST RANSC1 SKIPG X1,STRLEN-1(LP) JRST RSLAB2 MOVEM X1,2(X2) JRST RANSC3 RSLAB2: HRLZI X1,400000 MOVEM X1,1(X2) RANSC3: MOVEI X1,200 ;A DUMMY WORD COUNT MOVEM X1,(X2) DPB LP,[POINT 4,OUTTDS,12] XCT OUTTDS JRST RANSC4 RANSC5: DPB LP,[POINT 4,GTSTS,12] XCT GTSTS JRST [SETZM ACTBL-1(LP) JRST OUTERR] RANSC4: DPB LP,[POINT 4,CLOSED,12] XCT CLOSED SETZM LOK+2 SETZM LOK+3 DPB LP,[POINT 4,LOKUP,12] XCT LOKUP JRST LKFAIL HLLZS ENT+1 SETZM ENT+2 MOVE X1,FPPN-1(LP) MOVEM X1,ENT+3 XCT ENTDSK JRST ENFAIL HLRZ X1,BA-1(LP) MOVEM X1,.JBFF DPB LP,[POINT 4,IBDSK,12] XCT IBDSK XCT OBDSK DPB LP,[POINT 4,OUTTDS,12] XCT OUTTDS JRST RSLAB3 JRST RANSC5 RSLAB3: DPB LP,[POINT 4,INNDSK,12] XCT INNDSK JRST RSLAB4 JRST EXEC86 RSLAB4: SETZM BLOCK-1(LP) SETZM MODBLK-1(LP) SETZM LASREC-1(LP) MOVEI X1,1 MOVEM X1,POINT-1(LP) POPJ P, SETERR: INLERR(18,4,</ ? SET argument/>) JRST OUTBND SEVEN: OCT 7 OUTSET: JUMPN LP,OSLAB1 ;TTY? SETZM ODF ;YES. POPJ P, OSLAB1: SKIPG X2,ACTBL-1(LP) ;GET ACCESS CODE JRST FNMXER CAMN LP,PLTOUT ;PLOTTING FILE? JRST PLTERR CAIE X2,3 ;OPEN FOR WRITING? JRST ILWRT ;NO SETOM ODF POPJ P, ;THIS ROUTINE IS USED AT RUNTIME BY THE READ# STATEMENTS. ;DELAWY SKIPS THROUGH DELIMITERS AND STOPS ON THE FIRST ;NON-TAB, NON-SPACE, NON-COMMA. DELAWY: LDB C,T JUMPE C,DELAWY PUSHJ P,NXCHD2 DWLAB1: TLNN C,F.COMA+F.SPTB POPJ P, PUSHJ P,NXCH JRST DWLAB1 ;PRINTING SUBROUTINES ;PRINT TO QUOTE CHAR ;CALL: MOVE T,<ADDRS OF MSG> ; MOVE D,<QUOTE CHAR> ; PUSHJ P,PRINT ;CALL: MOVE T,<ADDRS OF MSG> ; MOVE D,<QUOTE CHAR> ; PUSHJ P,PRINT ;ALTERNATE CALL: PRINT1, IF BYTE PNTR IN T. OUCH0: PUSH P,C AOS HPOS(LP) MOVE C,MARGIN(LP) SKIPGE QUOTBL(LP) ;QUOTE MODE? JRST OUCH4 ;YES. CAML C,HPOS(LP) ;NO. JRST OUCH3 PUSHJ P,PCRLF JUMPN LP,OUCH5 OUTPUT JRST OUCH5 OUCH4: CAML C,HPOS(LP) JRST OUCH3 POP P,C JRST PTXER2 OUCH3: SOS HPOS(LP) OUCH5: POP P,C JRST OUCH ;NUMBER PRINTER (PRINTS INTEGER IN T) PRTNUX: MOVEI X1,3 SKIPE STRFCN JRST PRTNX4 JRST PRTNX3 PRTNX1: MOVEI X1,4(B) ;CHECK ROOM FOR INT. OF THIS SIZE " " SKIPN STRFCN PRTNX3: PUSHJ P,CHROOM PRTNX4: PUSHJ P,PSIGN PRTNX2: IDIVI T,^D10 JUMPE T,PRTN0 PUSH P,T1 PUSHJ P,PRTNX2 POP P,T1 PRTN0: MOVEI C,60(T1) AOS NUMCOT SKIPE STRFCN JRST DPBSTR JRST OUCH0 PRTNUM: IDIVI T,^D10 JUMPE T,PRTN1 PUSH P,T1 PUSHJ P,PRTNUM POP P,T1 PRTN1: MOVEI C,60(T1) AOS NUMCOT JRST OUCH PSIGN: MOVEI C," " ;PRINT "SIGN" (BLANK OR MINUS) JUMPL N,PSIGN2 SKIPE STRFCN POPJ P, JRST OUCH0 PSIGN2: SKIPE STRFCN JRST PSIGN4 SKIPL QUOTBL(LP) JRST PSIGN3 MOVEI C," " PUSHJ P,OUCH0 PSIGN3: MOVEI C,"-" JRST OUCH0 PSIGN4: MOVEI C,"-" JRST DPBSTR SUBTTL CORE COMPRESSION AND EXPANSION PANIC1: ERROM(60,</ ? Out of room/>) INLSYS: ERROM(70,</ ? System error/>) ;UTILITY ROUTINE TO SET UP VRFBOT AND VRFTOP. SETCOR: PUSH P,X2 SETZM VRFBOT SKIPN SRTDBA JRST SETCO3 PUSH P,T1 PUSH P,T PUSH P,A PUSH P,C SETCO1: MOVE X2,VARFRE MOVEI T1,^D200(X2) MOVEI T,^D200 SETZ A, PUSHJ P,VSUB1 CAMG T1,.USREL JRST SETCO2 PUSHJ P,VPANIC JRST SETCO1 SETCO2: MOVEM T1,VRFBOT MOVEM T1,VRFBTB POP P,C POP P,A POP P,T POP P,T1 JRST SETCO5 SETCO3: MOVE X2,VARFRE ADDI X2,^D200 CAMG X2,.USREL JRST SCLAB1 PUSHJ P,VPANIC JRST SETCO3 SCLAB1: MOVEM X2,VRFBOT MOVEM X2,VRFBTB SETCO5: HRRZ X2,.USREL MOVEM X2,VRFTOP POP P,X2 POPJ P, ;THIS ROUTINE OBTAINS SPACE IN THE "FREE CORE AREA" FOR REAL STRINGS, ;APPEND BLOCKS, THE TEMPORARY STRINGS WHICH ARE THE RESULTS OF ;STRING FUNCTIONS, AND BUFFERS FOR DATA FILES. IT HAS SIX ENTRY POINTS: ;VCHCKC AND VCHCKW FOR REAL STRINGS, VCHTSC AND VCHTSW FOR TEMPORARY ;STRINGS, VCHAPP FOR APPEND BLOCKS, AND VCHBUF FOR DATA FILES. ;STRINGS HAVE TWO ENTRY POINTS SO THAT THEY MAY REQUEST SPACE IN UNITS ;OF EITHER CHARACTERS OR WORDS. THE REQUEST IS IN AC T. NO OTHER ;AC'S ARE DESTROYED. THE LOCATION OF THE LOWER BOUND OF THE OBTAINED ;SPACE IS RETURNED IN AC T. LITLEN=^D27 VCHCKC: PUSH P,T1 ;ENTRY POINT--REAL STRINGS. JUMPE T,VCHCK1 ADDI T,4 IDIVI T,5 JRST VCHCK2 VCHCKW: PUSH P,T1 ;ENTRY POINT--REAL STRINGS. JUMPN T,VCHCK2 VCHCK1: MOVEI T,LITLEN VCHCK2: MOVE T1,VARFRE ADDI T1,(T) SKIPN VRFBOT JRST VCHCK5 CAMG T1,VRFBTB JRST VCHCK7 JRST VCHCK6 VCHCK5: CAMG T1,.USREL JRST VCHCK7 VCHCK6: PUSHJ P,VPANIC JRST VCHCK2 VCHCK7: SKIPE SRTDBA ;ANY BUFFERS? JRST VCHCK3 ;YES. MOVE T,VARFRE ;NO. MOVEM T1,VARFRE JRST VOUT VCHCK3: PUSH P,X2 PUSH P,X1 PUSH P,A PUSH P,C VCHCK4: MOVE X2,VARFRE ;GET OUT OF THE WAY OF THE BUFFERS, MOVEI T1,(X2) ADDI T1,(T) SETZ A, ;BY MOVING UP. PUSHJ P,VSUB1 SKIPN VRFBOT JRST VCHCK8 CAMG T1,VRFBTB JRST VCHCK0 JRST VCHCK9 VCHCK8: CAMG T1,.USREL JRST VCHCK0 VCHCK9: PUSHJ P,VPANIC JRST VCHCK4 VCHCK0: MOVEM T1,VARFRE VOUT2: MOVEI T,(X2) VOUT0: POP P,C POP P,A POP P,X1 VOUT1: POP P,X2 VOUT: POP P,T1 POPJ P, VCHAPP: PUSH P,T1 ;ENTRY POINT--APPEND BLOCKS. VCHAP2: MOVE T1,VRFBOT ADDI T1,^D47 CAMG T1,VRFTOP JRST VCLAB1 PUSHJ P,VPANIC JRST VCHAP2 VCLAB1: SKIPE SRTDBA ;ANY BUFFERS? JRST VCHAP1 ;YES. MOVE T,VRFBOT ;NO. MOVEM T1,VRFBOT JRST VOUT ;NO. VCHAP1: PUSH P,X2 PUSH P,X1 PUSH P,A PUSH P,C VCHAP3: MOVE X2,VRFBOT MOVEI T1,(X2) ADDI T1,^D47 HRRZI T,^D47 SETZ A, PUSHJ P,VSUB1 ;GET OUT OF THEIR WAY BY MOVING UP. CAMG T1,VRFTOP JRST VCLAB2 PUSHJ P,VPANIC JRST VCHAP3 VCLAB2: MOVEM T1,VRFBOT JRST VOUT2 VCHBUF: PUSH P,T1 ;ENTRY POINT--DATA FILE BUFFERS. PUSH P,X2 VCHBF4: SKIPN T1,VRFBOT ;LOWER BOUND IS VRFBOT, IF IT MOVE T1,VARFRE ;EXISTS, OTHERWISE IT IS VARFRE. MOVEI T,406 ADDI T1,(T) MOVE X2,VRFTOP SKIPN VRFBOT MOVE X2,.USREL CAIG T1,(X2) JRST VCLAB3 PUSHJ P,VPANIC JRST VCHBF4 VCLAB3: SKIPE SRTDBA ;ANY BUFFERS? JRST VCHBF2 ;YES. SKIPE T,VRFBOT ;NO. JRST VCHBF3 MOVE T,VARFRE MOVEM T1,VARFRE JRST VOUT1 VCHBF3: MOVEM T1,VRFBOT JRST VOUT1 VCHBF2: PUSH P,X1 PUSH P,A PUSH P,C VCHBF5: SETZ A, SKIPN T1,VRFBOT MOVE T1,VARFRE MOVEI X2,(T1) ADDI T1,(T) PUSHJ P,VSUB1 ;GET OUT OF THEIR WAY BY MOVING UP. MOVE X1,VRFTOP SKIPN VRFBOT MOVE X1,.USREL CAIG T1,(X1) JRST VOUT2 PUSHJ P,VPANIC JRST VCHBF5 VCHTSC: PUSH P,T1 ;ENTRY POINT--TEMP. STRINGS. JUMPE T,VCHTS1 ADDI T,4 IDIVI T,5 JRST VCHTS2 VCHTSW: PUSH P,T1 JUMPN T,VCHTS2 VCHTS1: MOVEI T,LITLEN VCHTS2: MOVE T1,VRFTOP ADDI T1,1 SUBI T1,(T) CAML T1,VRFBOT JRST VCLAB6 PUSHJ P,VPANIC JRST VCHTS2 VCLAB6: SKIPE SRTDBA ;ANY BUFFERS? JRST VCHTS3 ;YES. MOVEI T,(T1) ;NO. SUBI T1,1 MOVEM T1,VRFTOP JRST VOUT VCHTS3: PUSH P,X2 PUSH P,X1 PUSH P,A PUSH P,C VCHTS4: MOVE T1,VRFTOP ADDI T1,1 HRRZI X2,(T1) SUBI X2,(T) MOVE A,T SETZ T, PUSHJ P,VSUB1 ;GET OUT OF THE WAY OF THE BUFFERS BY MOVING DOWN. MOVE T,A CAML X2,VRFBOT JRST VCLAB7 PUSHJ P,VPANIC JRST VCHTS4 VCLAB7: MOVEI X1,-1(X2) MOVEM X1,VRFTOP JRST VOUT2 SUBTTL RUNTIME ROUTINES ;ROUTINE TO PRINT NUMBER OUTSRF: SETOM STRFCN JRST OTLAB1 OUTNUM: SETZM STRFCN OTLAB1: MOVM T,N JUMPE T,PRTNUX PUSH P,E ;DO NOT CLOBBER E (FOR MATRIX) MOVEI E,0 ;CHANGE IN EXPONENT OUTN1A: CAMG T,D1E14 ;SCALE IF .GT. 10^14 JRST OUTN1B ADDI E,^D18 ;ADD 18 TO SCALE FMPR T,D1EM18 ;AND MULTIPLY BY 10^-18 JRST OUTN1A OUTN1B: CAML T,D1EM4 ;SCALE IF .LT. 10^-4 JRST OUTN1C SUBI E,^D14 ;SUBTRACT 14 FROM SCALE FMPR T,D1E14 ;AND MULT BY 10^14 JRST OUTN1B ;GO SEE IF MORE SCALING OUTN1C: MOVE A,T ;LOOK UP IN DEC ROLL MOVEI R,DECROL PUSHJ P,SEARCH JFCL ;DONT CARE IF FOUND CAME A,(B) ;FUDGE BY 1 IF EXACT MATCH SUBI B,1 SUBI B,DECTAB ;FIND DIST FROM MIDDLE JUMPN E,OUTN2 ;(NOT INTEGER IF WE SCALED) CAIGE B,^D8 ;CHK 8 DIG INTEGER CAIGE B,0 JRST OUTN2 CAML T,FIXCON ;IS THIS 2^26? JRST OUTN1D ;YES, ITS 27 BIT INT. MOVE X1,T FAD X1,FIXCON ;INTEGER? FSB X1,FIXCON CAME X1,T JRST OUTN2 ;NOT SUCH (LOST FRACTIONAL PART) FAD T,FIXCON ;SUCH. FIX NUMBER TLZ T,377400 OUTN1D: TLZ T,377000 ;(IN CASE 27-BIT INTEGER) POP P,E ;RESTORE E JRST PRTNX1 OUTN2: FDVR T,DECTAB(B) ;GET MANTISSA FMPR T,DECTAB+5 MOVEM T,EXTFG ;SAVE FOR "EXACT" CHECK. FADR T,FIXCON TLZ T,377400 ;FIX CAMGE T,INTTAB+6 JRST OUTN21 IDIVI T,^D10 ;ROUNDING MADE 7 DIGITS ADDI B,1 ;MAKE IT 6 AGAIN OUTN21: CAIL T,^D100000 ;ROUNDING MADE 5 DIGITS? JRST OUTN22 IMULI T,^D10 ;YES. MAKE 6 AGAIN SUBI B,1 OUTN22: ADDB B,E ;ADD TOGETHER TWO PARTS OF SCALE AOJ E, CAIG E,6 CAMG E,[OCT -6] JRST OUTN3 ;TO OUTN3 FOR E.LE.-6 OR 6.LT.E. JUMPL E,OUTN23 ;TO OUTN23 FOR -6.LT.E.LT.0. MOVEI X1,^D10 ;HERE FOR 0.LE.E.LE.6. SKIPN STRFCN ;CHECK ROOM FOR A DEC NO. WITH NO EXP. PUSHJ P,CHROOM SETZ B, ;B IS A FLAG FOR DNPRNT. 0 MEANS NO EXP. PUSHJ P,PSIGN JUMPE E,OUTN25 ;FINISH JRST OUTN27 ;UP. OUTN23: MOVE T1,EXTFG ;HERE FOR -6.LT.E.LT.0. MOVM E,E PUSH P,T IDIV T,INTTAB(E) JUMPE T1,OUTN24 POP P,T JRST OUTN3 ;NOT "EXACT". OUTN24: POP P,T1 ;"EXACT". MOVEI X1,^D10 ;CHECK ROOM FOR A DEC NO. WITH NO EXP. SKIPN STRFCN PUSHJ P,CHROOM SETZ B, ;B IS DNPRNT FLAG. 0 MEANS NO EXP. PUSHJ P,PSIGN OUTN25: MOVEI C,"0" ;OUTPUT "0" AND ".". SKIPN STRFCN JRST OTLAB2 PUSHJ P,DPBSTR JRST OTLAB3 OTLAB2: PUSHJ P,OUCH0 OTLAB3: PUSHJ P,DNPRN2 JUMPE E,OUTN27 OUTN26: MOVEI C,"0" ;OUTPUT LEADING 0'S AFTER ".". SKIPN STRFCN JRST OTLAB4 PUSHJ P,DPBSTR JRST OTLAB5 OTLAB4: PUSHJ P,OUCH0 OTLAB5: SOJG E,OUTN26 OUTN27: PUSHJ P,DNPRNT ;OUTPUT NO. POP P,E ;RESTORE E. POPJ P, ;EXIT. OUTN3: MOVEI E,1 ;HERE FOR NOS. WHICH NEED EXPONENTS. MOVEI X1,^D14 ;CHECK FOR ROOM FOR A DEC NO. + EXP. PUSH P,B SKIPN STRFCN PUSHJ P,CHROOM POP P,B PUSHJ P,PSIGN PUSHJ P,DNPRNT POP P,E ;RESTORE E MOVEI C,"E" ;OUTPUT EXPONENT. SKIPN STRFCN JRST OTLAB6 PUSHJ P,DPBSTR JRST OUTN6 OTLAB6: PUSHJ P,OUCH0 OUTN6: MOVEI C,"+" JUMPGE B,OTLAB7 ;SPIT OUT SIGN MOVEI C,"-" OTLAB7: SKIPN STRFCN JRST OTLAB8 PUSHJ P,DPBSTR JRST OTLAB9 OTLAB8: PUSHJ P,OUCH0 OTLAB9: MOVM T,B ;USE PRTNX2 TO PRINT EXPON JRST PRTNX2 ;SUBROUTINE USED BY OUTNUM TO PRINT DECIMAL NUMBER. PRINTS ;SIX DIGITS (INTEGER IN T) WITH CONTENTS(E) DIGITS ;TO THE LEFT OF DECIMAL POINT DNPRNT: MOVEI D,-1 ;SIGNAL TRAILING ZERO UNLESS... JUMPE B,DNPRN0 ;E-NOTATION MOVEI D,0 DNPRN0: IDIVI T,^D10 ;GET LAST DIGIT JUMPE T,DNPRN1 ;IS IT FIRST? JUMPN T1,DPLAB1 ;NON ZERO DIGIT? SKIPA T1,D ;NO, STASH ZERO OR TRAILZERO DPLAB1: MOVEI D,0 ;YES. TRAILER IS OVER. HRLM T1,(P) ;NO. STASH DIGIT PUSHJ P,DNPRN0 ;CALL DNPRNT RECURSIVELY HLRE T1,(P) ;RESTORE DIGIT JUMPGE T1,DNPRN1 ;ORDINARY DIGIT? JUMPLE E,CPOPJ ;NO, TRAILZERO. AFTER DECIMAL POINT? MOVEI T1,0 ;NO, STASH A ZERO. DNPRN1: MOVEI C,60(T1) ;PRINT DIGIT SKIPN STRFCN JRST DPLAB2 PUSHJ P,DPBSTR JRST DPLAB3 DPLAB2: PUSHJ P,OUCH0 DPLAB3: SOJN E,CPOPJ ;COUNT DIGITS. POINT NEXT? DNPRN2: MOVEI C,"." ;YES. PRINT POINT SKIPE STRFCN JRST DPBSTR JRST OUCH0 SUBTTL SUBTTL ERROR PROCESSING ERRXCT: PUSH P,X1 ;SAVE AN AC SKIPE ERRGO ;ON ERROR GOTO ? JRST ONERPR ;YES. GO PROCESS. PUSH P,X2 ;AND ANOTHER SKIPE X1,ERRTCN ;GET ERROR COUNT JRST ERRXC1 ;ALREADY SOME MOVE X2,[XWD 700,ERRTXT-1] MOVEM X2,ERRBPT ERRXC1: LDB X2,[POINT 9,40,35] ;PICK UP TEXT ADDRESS JUMPE X2,ERRXC3 ;ZERO MEANS NON FATAL ERROR SO JUST IGNORE ADD X2,[XWD 20,400007] ERRXC2: MOVEM X2,ERRTBL(X1) ;STASH IT AOS ERRTCN ;UP ERROR COUNT ERRXC3: POP P,X2 ;RESTORE POP P,X1 ;ACS POPJ P, ;AND BACK TO WORK ERRXCX: PUSH P,X1 ;SAVE AN AC PUSH P,X2 ;AND ANOTHER MOVE X1,ERRTCN ;GET ERROR COUNT HRRZ X2,ERRBPT ;GET TEXT ADDRESS AOJA X2,ERRXC2 ;INCREMENT ERRXCY: PUSH P,X1 ;SAVE AN AC PUSH P,X2 ;AND ANOTHER MOVE X1,ERRBPT ;GET A BYTE POINTER SETZ X2, ;MAKE ASCIZ ERRXC4: IDPB X2,X1 ;SAVE A ZERO TLNE X1,760000 ;REACHED A WORD BOUNDARY? JRST ERRXC4 ;NO, CARRY ON MOVEM X1,ERRBPT ;YES, SAVE POINTER JRST ERRXC3 ;AND RETURN ;DO STUFF FOR USERS "ON ERROR GOTO" ONERPR: LDB N,[POINT 9,40,26] ;PICK UP ERROR # MOVEM N,ERR MOVE X1,SORCLN ;PICK UP LINE # MOVEM X1,ERL ;SAVE N CASE RETROACTIVE "ON ERROR GOTO" MOVE X1,UUOH ;PICK UP ADDRESS OF UUO+1 SUBI X1,1 ;NOW POINTS TO UUO MOVEM X1,ERRTRO ;NOW RETROACTIVE "ON ERROR GO TO" ;CAN FINISH UP THE ERROR CODING AS USUAL POP P,X1 ;RESTORE X1 SVV0=ERRTBL ;SAVE ACS IN UNUSED LO SEGMENT IN CASE RETROACTIVE "ON ERROR GOTO" POP P,SVV0 ;RECTIFY PDL MOVEM 0,SVV0 ;SAVE AC 0 MOVE 0,[XWD 1,SVV0+1] BLT 0,SVV0+17 PUSHJ P,PCHECK ;MAKE SURE PDL IS IN GOOD SHAPE JRST @ERRGO ;GO TO USERS "ON ERROR GOTO" ADDRESS ERRCNT: MOVE X1,ERL ;GET LINE FROM WHICH ERROR CAME FROM MOVEM X1,SORCLN ;PUT BACK IN SORCLN ;RESTORE ACS SAVED AT ONERPR MOVE 0,[XWD SVV0+1,1] BLT 0,17 MOVE 0,SVV0 JRST @ERRTRO ;GO DO REST OF ERROR STUFF AS USUAL LINADR: MOVEM A,SORCLN ;SORCLN POINTS TO LINE #. JRST 1(A) ;RETURN TO DO REST OF LINE ;RUN-TIME GOSUB ROUTINES FORCOM: MOVEI X1,313 ;RUNTIME COMPARE FIX-DONT USE IF CON SKIPGE @40 ADDI X1,2 DPB X1,[POINT 9,@(P),8] ;SET UP COMPARE FOR ENTIRE LOOP POPJ P, XCTON: MOVE T,N ; JUMPLE T,XCTON1 ; ADDI T,(A) ;GET THE "GOTO" ADDRESS CAML T,(A) JRST XCTON1 HLRZ N,(T) CAIN N,254000 JRST @(T) MOVE N,(A) PUSH P,N MOVE N,(T) MOVEM N,40 JRST GOSBER XCTON1: INLERR(58,5,</ ? ON evaluated out of range/>) JRST GOSR2 ;HERE ON OVFLOW ERROR OVTRAP: PUSH P,X1 ;SAVE THIS REG IN CASE FALSE ALARM. SKIPE NOLINE ;TRAP WHILE AT DDT BREAK POINT? JRST OVTRP0 ;YES, PROCESS IT HRRZ X1,.JBTPC ;GET TRAP ADDRESS. CAML X1,FLCOD ;TRAP IN USER PROG? CAMLE X1,CECOD JRST OVFIG2 ;NO. FALSE TRAP.(NOT BY USER) OVTRP0: MOVE X1,.JBTPC ;GET TRAP FLAGS. TLNE X1,(1B11) ;UNDERFLOW? JRST UNTRAP ;YES TLNE X1,(1B12) ;ZERO DIVIDE? JRST DVTRAP ;YES OVTR0: TLNN X1,(1B3) ;IS IT INTEGER OR FLOATING JRST OVTRIN ;INTEGER NFERR (92,0) PUSHJ P,INLMES ASCIZ / % Floating overflow/ JRST OVTR2 ;FIX UP RESULT OVTRIN: NFERR (92,0) PUSHJ P,INLMES ;OUTPUT OVERFLOW MESSAGE ASCIZ / % Integer overflow/ OVTR2: SKIPL N ;NEG OVFLOW? HRLOI N,377777 ;LRG NUMBER SKIPG N MOVE N,MIFI ;LRG NEG NUMBER OVTR1: PUSHJ P,GOSR3 OVFIG2: MOVEI X1,630010 APRENB X1, SETOM LIBFLG POP P,X1 JRST @.JBTPC UNTRAP: NFERR (93,0) PUSHJ P,INLMES ASCIZ / % Floating underflow/ SETZI N, ;RESULT IS ZERO. JRST OVTR1 DVTRAP: NFERR (61,0) PUSHJ P,INLMES ASCIZ / % Division by zero/ JRST OVTR2 SUBTTL RUNTIME ROUTINES ;ANALYZE THE FILENAME ARGUMENT FOR CHAIN. CHAHAN: PUSHJ P,STRPL1 ;GET STR PLUS TERM DOLL SIGN JRST CHAER1 ;SO FILNAM WILL STOP. PUSHJ P,FILNAM JUMP NEWOL1 CAME T,VALPTR ;STOPPED IN RIGHT PLACE? JRST CHAER1 POP P,Q MOVEI X2,CHLAB1 JRST RESACS CHLAB1: SOS MASAPP POPJ P, GOSBER: PUSHJ P,PCHECK ;CHECK ENOUGH PDL PUSH P,PSAV MOVEM P,PSAV ;SAVE PDP LEVEL IN CASE ERROR TRAP MOVE X1,@40 MOVE R,FCNLNK HRLM R,@40 MOVE R,40 MOVEM R,FCNLNK TRNN X1,777777 ;IF FCN, BEGINS AT CTRL WRD+1 HRRI X1,1(R) TLNN X1,777777 ;CHECK RECURSIVE CALL JRST (X1) INLERR(27,51,</ ? Subroutine or function calls itself/>) JRST GOSR2 RETURN: SETZB T,IFNFLG ;GOSUB RETURN, NOTHING ON PLIST. CAIA FRETRN: SETOM IFNFLG ;IFNFLG DISTINGUISHES BETWEEN "RETURN" MOVE R,FCNLNK ;AND END OF FNX PROCESSING. JUMPLE R,BADRET ;CHECK RETURN TOO FAR MOVS X1,(R) ;FETCH LINK BACK HRRZS (R) ;MARK SUBR NOT IN USE HRREI R,(X1) MOVEM R,FCNLNK CAME P,PSAV ;MAKE SURE PDL OKAY JRST MNYDEF POP P,PSAV ;RESTORE SAVED PDL LEVEL POP P,X2 ;SAVE REAL RETURN LOCATION JFFO T,RTLAB1 ;CONVERT MASK TO NUM ARGS JRST FRTRN1 ;ZERO, NO FIX UP NEEDED RTLAB1: TRZ T1,1 ;MAKE EVEN SUBI T1,^D36 ;NUMBER OF ARGS * 2 ASH T1,-1 ;DIVIDE BY 2 MOVMS T1 ;MAKE POSITIVE HRLS T1,T1 ;LH = RH SUB Q,T1 ;FIX PUSH DOWN LIST FRTRN1: SKIPN IFNFLG JRST (X2) ;RETURN RESACS: POP P,T ;RESTORE AC'S, EXCEPT 0, X2, AND P. POP P,T1 POP P,SORCLN POP P,A POP P,B POP P,C POP P,D POP P,F POP P,ODF POP P,E POP P,G POP P,R POP P,X1 POP P,L JRST (X2) SAVACS: POP P,X2 PUSHJ P,PCHECK ;CHECK ENOUGH PDL SPACE PUSH P,N HRRZ N,Q SUBI N,QLIST CAILE N,55 JRST MNYDEF POP P,N SAVCS1: PUSH P,L PUSH P,X1 PUSH P,R PUSH P,G PUSH P,E PUSH P,ODF PUSH P,F PUSH P,D PUSH P,C PUSH P,B PUSH P,A PUSH P,SORCLN PUSH P,T1 PUSH P,T JRST (X2) PCHECK: PUSH P,N HRRZ N,P SUBI N,PLIST CAILE N,250 JRST MNYDEF POP P,N POPJ P, MNYDEF: SETZM ERRGO ;DISABLE ERROR TRAPPING ! INLERR(29,6,</ ? Too many FN's, GOSUBs or error traps/>) JRST GOSR2 BADRET: INLERR(31,7,</ ? RETURN before GOSUB/>) JRST GOSR2 ;R.A. OUTPUT ROUTINE. RNSTRO: SKIPG STRLEN-1(LP) ;STR FILE? JRST RNERR1 ;NO. FAIL. HLRZ B,STRLEN-1(LP) ;B=NO. WORDS/REC. MOVEI X1,^D128 IDIVI X1,(B) MOVE A,POINT-1(LP) ;X1=NO. RECS/BLK. MOVEI T,(A) IDIVI T,(X1) ;T = BLK NO. - 1. IMULI T1,(B) ;T1 = NO. OF WRDS INTO BLK. JRST RNNUM1 RNNUMO: SKIPL STRLEN-1(LP) ;NUM FILE? JRST RNERR1 ;NO. FAIL. MOVE A,POINT-1(LP) MOVE T,A ;T = BLK NO. - 1. AOS T IDIVI T,^D128 ;T1 = NO. OF WRDS INTO BLK. RNNUM1: AOJ T, CAMN T,BLOCK-1(LP) ;CUR BLK? JRST RNNUM4 ;YES. SKIPN MODBLK-1(LP) ;NO -- NEED TO OUTPUT JRST RNNUM2 ;CUR BLK? MOVE X2,BLOCK-1(LP) ;YES. PUSHJ P,OUTRAN RNNUM2: CAMG A,LASREC-1(LP) ;IS NEW REC WITHIN FILE? JRST RNNUM3 ;YES. MOVE A,LASREC-1(LP) ;NO. IS IT WITHIN THE LAST BLOCK? SKIPG STRLEN-1(LP) AOS A SKIPG STRLEN-1(LP) MOVEI X1,^D128 IDIVI A,(X1) CAIN T,1(A) JRST RNNUM3 ;YES. RNNM25: HLRZ A,BA-1(LP) MOVEI B,177 ;CLEAR OUT NEW BLK. ROLAB1: SETZM 3(A) AOJ A, SOJGE B,ROLAB1 JRST RNNM31 ; RNNUM3: MOVE X2,T ;OR GET NEW BLK. PUSHJ P,LOCKON ;SET INTERLOCK PUSHJ P,INRAN RNNM31: MOVEM T,BLOCK-1(LP) PUSHJ P,LOCKOF ; RNNUM4: MOVE A,POINT-1(LP) CAMLE A,LASREC-1(LP) MOVEM A,LASREC-1(LP) HLRZ A,BA-1(LP) ADDI A,3(T1) SKIPL STRLEN-1(LP) JRST RNNUM5 SKIPN VIRWRD ;VIRTUAL ARRAY? MOVEM N,(A) ;OUTPUT NUM. RNNOUT: AOS POINT-1(LP) SETOM MODBLK-1(LP) POPJ P, RNNUM5: TLNN N,777777 ;OUTPUT STR. JRST RNNM12 TLNE N,377777 JRST RNNUM6 MOVE T,N MOVE N,(T) TLNN N,777777 JRST RNNM12 RNNUM6: JUMPG N,RNNUM9 HLRE T,N MOVM T,T HRRZ B,STRLEN-1(LP) CAMLE T,B JRST RNERR2 MOVEM T,(A) ADDI A,1 HRL A,N SOJL T,RNNOUT IDIVI T,5 ADDI T,(A) BLT A,(T) JRST RNNOUT RNNUM9: MOVE X1,N ;APP BLK. PUSHJ P,LENAPB HRRZ B,STRLEN-1(LP) CAMLE N,B JRST RNERR2 MOVEM N,(A) ADDI A,1 HRLI A,440700 ;A HAS NEW PNTR. HLRE E,X1 HRRZI X1,(X1) RNNM10: HRR X2,1(X1) HRLI X2,440700 ;X2 IS AN OLD PNTR. HLRE T1,1(X1) JUMPE T1,RNNM11 ROLAB2: ILDB C,X2 IDPB C,A AOJL T1,ROLAB2 RNNM11: SOJLE E,RNNOUT AOJA X1,RNNM10 RNNM12: SETZM (A) JRST RNNOUT ;UTILITY ROUTINE TO INPUT A BLOCK FOR A R.A. FILE. THE DESIRED ;BLOCK NUMBER IS IN X2. INRAN: HRRM X2,USETID-1(LP) XCT USETID-1(LP) DPB LP,[POINT 4,INNDSK,12] XCT INNDSK POPJ P, SETZM ACTBL-1(LP) INLEMS(1,70,INLSYS) JRST GOSR2 ;UTILITY ROUTINE TO TRANSFER A BLOCK FROM A R.A. INPUT BUFFER TO THE ;OUTPUT BUFFER FOR THAT CHANNEL. THE BLOCK NUMBER IS IN X2. OUTRAN: PUSH P,X1 HRRM X2,USETOD-1(LP) XCT USETOD-1(LP) HLRZ X2,BA-1(LP) ADDI X2,3 HRLI X2,(X2) MOVEI X1,203 ADDI X1,(X2) HRRI X2,(X1) BLT X2,177(X1) MOVEI X2,200 HRRM X2,-1(X1) DPB LP,[POINT 4,OUTTDS,12] POP P,X1 XCT OUTTDS POPJ P, SETZM ACTBL-1(LP) DPB LP,[POINT 4,GTSTS,12] XCT GTSTS JRST OUTERR ;RUNTIME ROUTINE FOR THE PAGE STATEMENT. ;PAGE SIZE IS IN AC N, IN FLOATING POINT. PAGE: CAIGE N,1 JRST PAGERR ;OR GREATER. PAGE0: MOVEM N,PAGLIM(LP) JUMPE LP,PAGE1 ;TTY IS ALWAYS IN "OUTPUT MODE". MOVE T1,ACTBL-1(LP) ;FILE. IS IT WRITEABLE? CAIE T1,3 JRST PAGE2 PAGE1: PUSH P,ODF SETZM ODF JUMPE LP,PGLAB1 SETOM ODF PGLAB1: SKIPN HPOS(LP) ;NEED TO END CURRENT LINE? JRST PAGE3 ;NO. MOVEI C,15 PUSHJ P,OUCH MOVEI C,12 PUSHJ P,OUCH PAGE3: MOVEI C,14 PUSHJ P,OUCH SETOM FIRSFL(LP) POP P,ODF PAGE2: SETZM PAGCNT(LP) SETZM HPOS(LP) SETZM TABVAL(LP) SETZM FMTPNT(LP) POPJ P, ;RUNTIME ROUTINE FOR THE PAGE ALL STATEMENT. ;PAGE SIZE IS IN AC N, IN FLOATING POINT. PAGEAL: CAIGE N,1 ;PAGE SIZE MUST BE 1.0 JRST PAGERR ;OR GREATER. MOVEI LP,9 PAGEL1: PUSHJ P,PAGE0 SOJG LP,PAGEL1 POPJ P, ;RUNTIME ROUTINE FOR THE MARGIN STATEMENT. ;MARGIN SIZE IS IN AC N, IN FLOATING POINT. MARGN: CAIL N,1 ;MARGIN MUST BE GE.1 AND LE.132. CAIL N,^D133 JRST MARER1 MOVEM N,MARWAI(LP) POPJ P, ONE33: 133.0 ONE28: 128.0 MINONE: -1.0 ;RUNTIME ROUTINE FOR THE MARGIN ALL STATEMENT. ;MARGIN SIZE IS IN AC N, IN FLOATING POINT. MARGAL: CAIL N,1 ;MARGIN MUST BE GE. 1 AND LE. 132. CAIL N,^D133 JRST MARER1 MOVEI LP,9 MRLAB1: MOVEM N,MARWAI(LP) SOJG LP,MRLAB1 POPJ P, ;SEMI-IFIX ROUTINE. ;IFIX EXPECTS A NON-NEGATIVE FLOATING POINT NUMBER IN AC N ;AND RETURNS A FIXED POINT INTEGER IN AC N. IFIX: PUSH P,T PUSH P,T1 MOVE T,N MULI T,400 SETZM LIBFLG ASH T1,-243(T) MOVE N,T1 POP P,T1 POP P,T SKIPN LIBFLG POPJ P, HRLOI N,377777 POPJ P, ;SEMI-IFLOAT ROUTINE. ;IFLOAT EXPECTS A NON-NEGATIVE FIXED POINT NUMBER IN AC N AND ;RETURNS A FLOATING POINT NUMBER IN AC N. IFLOAT: PUSH P,T SETZ T, LSHC N,-^D8 LSH T,-^D9 TLO N,243000 TLO T,210000 FADR N,T POP P,T POPJ P, ;RUN-TIME ROUTINES FOR READ AND INPUT DOREAD: MOVE R,[XWD NXREAD,PREAD] SETZM INPFLA ;READ, NOT INPUT POPJ P, ;SET UP TO READ DOINPT: SKIPN IFIFG SETZM PINPUT ;FORCE NEW LINE MOVE R,[XWD NXINPT,PINPUT] POP P,INPFLA ;SAVE ERROR RETURN MOVEM P,INPRES ;SAVE P IN CASE OF INPUT ERROR JRST @INPFLA ;ROUTINE TO GET A DATA WORD DATAER: SKIPN IFIFG JRST DATAE1 SKIPN T,PINPNM-1(LP) JRST NXINPT SKIPGE REAINP-1(LP) SKIPN EOFFLG-1(LP) ;SEE NOTE IN IF END# ROUTINE. JRST DTLAB1 SETZ X1, JRST NXIN4 DTLAB1: PUSHJ P,DELAWY JRST DATR0 DATAE1: SKIPN T,(R) ;MORE ON SAME LINE? ;THE NEXT EIGHT LINES OF CODE SHOULD NOT BE EXPANDED ;SEE SLOPPY (DEC) CODING @ SSKIP JRST DATR1 ;NO PUSHJ P,NXCH ;PUT FIRST CHAR OF NEXT NUMBER IN C SKIPE INPFLA ;CHECK TO SEE IF THIS IS REALLY JRST DATR0 ;THE "ONE OPTIONAL TRAILING COMMA" TLNE C,F.TERM ;ALLOWED IN DATA STATEMENTS. JRST DATR1 DATR0: PUSHJ P,EVANUM PUSHJ P,SSKIP ;IT WASN'T A NUMBER, TRY NEXT JUMPE N,DATOK1 ;DON'T CHECK TYPE ON ZERO MOVE B,TYPE ;GET TYPE FOR INPUT NUMBER CAMN B,FTYPE ;DOES IT MATCH? JRST DATOK1 ;YES, DATA IS OK SKIPE FTYPE ;SHOULD IT BE REAL? JRST DATR2 ;NO, GIVE ERROR PUSH P,T ;FLTPNT USES T PUSHJ P,FLTPNT ;YES, FLOAT IT POP P,T ;RESTORE T DATOK1: PUSH P,X1 HRRZ X1,40 MOVEM N,(X1) ;STORE THE DATA WORD. POP P,X1 SKIPE IFIFG PUSHJ P,DELAWY SKIPE INPFLA ;END OF LINE TEST. TLNN C,F.CR TLNE C,F.TERM SETZI T, SKIPN IFIFG JRST DATAE2 MOVEM T,PINPNM-1(LP) JRST DATR01 DATAE2: MOVEM T,(R) DATR01: POP P,X1 SKIPN T ;END OF A LINE? SKIPN INPFLA ;YES, IS THIS INPUT? JRST (X1) ;NO, RETURN MOVEM X1,INPFLA ;YES, RESTART NEXT ERROR FROM HERE. JRST (X1) DATR1: MOVS X1,R ;DISPATCH ADDRS FOR MORE DATA JRST (X1) DATR2: SKIPE INPFLA ;READ OR INPUT? JRST INPERR ;INPUT, ASK FOR NEW LINE JRST IMP ;JUST GIVE ERROR ;ROUTINE TO GET A DATA STRING INSTR: SDATAE: SKIPN IFIFG JRST SDAT1 SKIPN T,PINPNM-1(LP) JRST NXSINP SKIPGE REAINP-1(LP) SKIPN EOFFLG-1(LP) ;SEE NOTE IN IF END# ROUTINE. JRST ISLAB1 MOVEI X1,1 JRST NXIN4 ISLAB1: PUSHJ P,DELAWY JRST SDATR0 SDAT1: MOVE T,1(R) ;GET CURRENT LINE POINTER SKIPE INPFLA ;INPUT,INSTRUCTION? MOVE T,(R) ;YES, SHARE POINTER WITH NUMBER DATA SKIPN T ;MORE ON CURRENT STRING DATA LINE? ;THE NEXT EIGHT LINES OF CODE SHOULD NOT BE EXPANDED ;SEE SLOPPY (DEC) CODING @ SSKIP JRST SDATR1 ;NO. HUNT FOR NEXT DATA LINE PUSHJ P,[SKIPE INLNFG JRST NXCHS JRST NXCH] ;GET FIRST CHAR SKIPE INPFLA ;CHECK TO SEE IF THIS IS REALLY JRST SDATR0 ;THE "ONE OPTIONAL TRAILING COMMA" TLNE C,F.TERM ;ALLOWED IN DATA STATEMENTS. JRST SDATR1 SDATR0: PUSHJ P,REDSTR ;READ THE STRING AND STORE IT PUSHJ P,SSKIP ;BAD STRING SKIPE IFIFG PUSHJ P,DELAWY SKIPE INPFLA ;END OF LINE TEST. TLNN C,F.CR TLNE C,F.TERM SETZI T, SKIPN IFIFG JRST SDAT2 MOVEM T,PINPNM-1(LP) JRST DATR01 SDAT2: MOVEM T,1(R) ;SAVE STRING DATA POINTER. SKIPE INPFLA ;INPUT? MOVEM T,(R) ;YES , SHARE POINTER JRST DATR01 SDATR1: MOVS X1,R ;DISPATCH ADDRESS FOR STRING DATA.. JRST 1(X1) ;GET AN ARRAY DATA WORD ADT1ER: PUSHJ P,ADTTYP MOVE X1,(P) ;GET RESTART ADDRESS IN CASE OF ERROR SKIPN T ;END OF A LINE? SKIPN INPFLA ;IS THIS INPUT JRST AST1ER ;GO STORE THE WORD MOVEM X1,INPFLA ;RESTART NEXT ERROR FROM HERE JRST AST1ER ;GO STORE THE WORD ADT2ER: PUSHJ P,ADTTYP MOVE X1,(P) ;GET RESTART ADDRESS IN CASE OF ERROR SKIPN T ;END OF A LINE? SKIPN INPFLA ;IS THIS INPUT JRST AST2ER ;GO STORE THE WORD MOVEM X1,INPFLA ;RESTART NEXT ERROR FROM HERE JRST AST2ER ADTTYP: MOVE X1,40 ;PICKUP OP-CODE CLEARM FTYPE ;ASSUME IT IS REAL TLZE X1,400 ;IS IT INTEGER? SETOM FTYPE ;YES, MARK IT PUSH P,X1 ;SAVE 40 CLEARM 40 ;DUMMY 40 FOR INPUT PUSHJ P,DATAER ;INPUT A NUMBER POP P,40 ;RESTORE 40 POPJ P, ;AND RETURN ;GO TO NEXT LINE OF DATA NXREAD: TDZA X1,X1 ;GET NEXT DATA LINE FOR NUMBER ITEM NSRSTR: MOVEI X1,1 ;GET NEXT DATA LINE FOR STRING ITEM MOVE T,DATLIN(X1) ;GET NXT DATA LINE NO AOBJP T,NXRE2 ;JUMP IF OUT OF DATA MOVEM T,DATLIN(X1) HRRZ T,(T) ;GET ADDRS OF SOURCE LINE HRLI T,440700 PUSHJ P,NXCH PUSH P,X1 PUSHJ P,QSA ;LOOK FOR "DATA" ASCIZ /DATA/ JRST [POP P,X1 JRST NXREAD+2] POP P,X1 JUMPG X1,SDATR0 ;GO GET STRING? JRST DATR0 ;NO, GO GET NUMBER ;REQUEST NEXT LINE OF INPUT NXVINP: SETOI X1, ;GET LINE AND RETURN TO "MATIN" JRST NXIN1 NXINPT: TDZA X1,X1 ;GET A LINE OF INPUT; NUMBER ITEM NEXT NXSINP: MOVEI X1,1 ;GET A LINE OF INPUT; STRING ITEM NEXT NXIN1: SKIPN IFIFG SETZB LP,ODF JUMPN LP,NXIN5 PUSH P,A ;OUTPUT ANY FORMATTING BEFORE THE "?". PUSH P,B PUSH P,X1 PUSH P,X2 PUSH P,40 SETZM 40 PUSHJ P,PRDLER POP P,40 SETZ X1, PUSHJ P,CHROOM SKIPE QUERYF ;TO OUTPUT ? JRST NXIN7 ;NO PUSHJ P,INLMES ASCIZ / ?/ NXIN7: OUTPUT SETZM QUERYF PUSHJ P,PCRLF3 SETZM FMTPNT POP P,X2 POP P,X1 POP P,B POP P,A NXIN5: MOVE T,LINPT(LP) ;IF END# ENTERS HERE. PUSHJ P,INLINE ;READ THE LINE AND GET FIRST CHAR. TLNE C,F.CR ;NULL LINE? JUMPL X1,CPOPJ1 ;YES. ALLOW THIS ON MAT INPUT NXIN4: MOVE T,LINPT(LP) JUMPE LP,NXIN6 NXIN8: PUSHJ P,NXCH TLNE C,F.CR JRST NXIN5 SKIPL REAINP-1(LP) ;EXPECT A LINE NUMBER? JRST NXIN6 ;NO. MOVEI A,4 TLNN C,F.DIG JRST IMP NXLAB2: PUSHJ P,NXCHD TLNN C,F.DIG JRST NXLAB1 SOJGE A,NXLAB2 JRST IMP NXLAB1: TLNE C,F.CR ;EMPTY LINE? JRST NXIN5 ;YES. TLNE C,F.SPTB ;DELIMITER AFTER LINE NUMBER JRST NXIN3 ;MUST BE A SPACE, A TAB, OR THE LETTER D. HRRZ A,C CAIE A,"D" JRST IMP NXIN3: PUSH P,T PUSHJ P,NXCH TLNN C,F.CR JRST NXLAB3 POP P,T ;LINE NO. FOLLOWED BY EMPTY LINE. JRST NXIN5 NXLAB3: POP P,T MOVEI C,40 DPB C,T NXIN6: SKIPN IFIFG JRST NXIN2 MOVEM T,PINPNM-1(LP) JRST NXIN9 NXIN2: MOVEM T,PINPUT PUSHJ P,DATCHK ;CHECK JFCL NXIN9: HRRZ T,(P) CAIN T,EOF32 POPJ P, ;BACK TO IF END#. SETZM EOFFLG-1(LP) JUMPE X1,DATAER ;GET NUMBER ITEM JUMPG X1,SDATAE ;GET STRING ITEM POPJ P, INPERP: POP P,X1 ;GET RID OF CALL TO NXVINP! INPERR: SKIPE IFIFG JRST IMP NFERR (50,0) PUSHJ P,INLMES ASCIZ / ? Input data not in correct form/ SKIPE CHAFL2 ;CHAINING? PUSHJ P,ERRMS3 PUSHJ P,INLMES ASCIZ /--please retype / SETZM PINPUT INPER1: HRRZ X1,INPFLA MOVE P,INPRES ;RESTORE P TO POINT OF ERROR JRST (X1) ;START LINE OVER. ;R.A. READ/INPUT ROUTINES. RANUM1: PUSH P,40 ;NUM 1 DIM. SETZM 40 PUSHJ P,RANUM POP P,40 JRST AST1ER RANUM2: PUSH P,40 ;NUM 2 DIM. SETZM 40 PUSHJ P,RANUM POP P,40 JRST AST2ER RANSTR: SKIPG STRLEN-1(LP) ;STR. JRST RNERR1 MOVE T,POINT-1(LP) CAMLE T,LASREC-1(LP) JRST EOFFL HLRZ B,STRLEN-1(LP) MOVEI X1,^D128 IDIVI X1,(B) ;X1=NO. OF RECS/BLK. IDIVI T,(X1) ;T=BLK NO. - 1. IMULI T1,(B) ;T1=NO. OF WORDS INTO BLK. JRST RANNM1 RANUM: SKIPL STRLEN-1(LP) ;NUM. JRST RNERR1 MOVE T,POINT-1(LP) CAMG T,LASREC-1(LP) JRST RANNM7 MOVNI X2,2 ;-2 IS FOR VIRTUAL ARRAY CAME X2,ACTBL-1(LP) ;IS THIS ONE ? JRST EOFFL ;NO, EOF ERROR SETZ N, ;YES, RETURN 0 OR NULL STR. POPJ P, RANNM7: AOJ T, IDIVI T,^D128 RANNM1: AOJ T, CAMN T,BLOCK-1(LP) JRST RANNM3 SKIPN MODBLK-1(LP) JRST RANNM2 MOVE X2,BLOCK-1(LP) PUSHJ P,OUTRAN RANNM2: MOVEI X2,(T) PUSHJ P,LOCKON ;SET INTERLOCK PUSHJ P,INRAN MOVEM T,BLOCK-1(LP) SETZM MODBLK-1(LP) PUSHJ P,LOCKOF ;REMOVE INTERLOCK RANNM3: HLRZ A,BA-1(LP) ADDI A,3(T1) SKIPL STRLEN-1(LP) JRST RANNM4 MOVE T,(A) ;READ NO. HRRZ X1,40 MOVEM T,(X1) AOS POINT-1(LP) POPJ P, RANNM4: MOVE T,(A) ;READ STR. CAIG T,^D132 JUMPGE T,RMLAB1 JRST RNERR3 RMLAB1: PUSHJ P,PNTADR SKIPE (X1) SETZM VPAKFL JUMPN T,RANNM5 SETZM (X1) JRST RANNM6 RANNM5: PUSHJ P,VCHCKC MOVE X2,(A) HRLI T,1(A) MOVEI X2,-1(X2) PUSH P,Q IDIVI X2,5 POP P,Q ADDI X2,(T) PUSH P,T BLT T,(X2) POP P,T HRRM T,(X1) MOVN T,(A) HRLM T,(X1) MOVEI X2,1(X2) HRRM X2,VARFRE RANNM6: AOS POINT-1(LP) POPJ P, ;USING STATEMENT ROUTINES ;CHKIMG SETS UP THE STARTING AND CURRENT POINTER TO THE IMAGE IN MASAPP, ;THE TOTAL AND THE CURRENT NUMBER OF CHARS IN THE IMAGE IN B AND X2, ;AND BEGFLG IN T1. THE CURRENT POINTER IS ALSO IN X1. CHKIMG: TLNN N,777777 ;GET IMAGE KEY. JRST IMGER1 TLNE N,377777 JRST CHKIM1 MOVE T,N MOVE N,(T) TLNN N,777777 JRST IMGER1 CHKIM1: JUMPL N,CHKIM2 PUSHJ P,STRETT TLNN N,777777 JRST IMGER1 CHKIM2: HLRE B,N MOVM B,B CAILE B,^D132 JRST IMGER2 MOVEI X2,(B) HRLI N,440700 PUSHJ P,MASTST ;CHECK ENOUGH SPACE AOS T1,MASAPP ;SAVE ORIGINAL AND CURRENT POINTERS MOVEM N,(T1) ;ON MASAPP TO PROTECT THEM FROM PUSHJ P,MASTST ;CHECK ENOUGH SPACE AOS T1,MASAPP ;SHIFTING CORE. MOVEM N,(T1) SETO T1, POP P,X1 PUSH P,B PUSH P,X2 PUSH P,T1 JRST (X1) IMGLIN: SETZM 40 PUSHJ P,PRDLER MOVE G,HPOS(LP) ;END LINE IF NECESSARY. ADD G,TABVAL(LP) JUMPN G,CHKIM3 SKIPE G,MARWAI(LP) MOVEM G,MARGIN(LP) PUSHJ P,NUMINS JRST CRLF1 CHKIM3: JUMPE LP,CKLAB1 CAIN G,^D6 SKIPL WRIPRI-1(LP) CKLAB1: JRST CKLAB2 POPJ P, CKLAB2: PUSH P,X2 PUSHJ P,PCRLF JUMPN LP,CKLAB3 OUTPUT CKLAB3: POP P,X2 POPJ P, ;MISC. UTILITY ROUTINES FOR USING STATEMENTS. NXCHU: ILDB C,X1 ;GET NEXT CHAR OF IMAGE. HLL C,CTTAB(C) TRNE C,100 HRL C,CTTAB-100(C) SOJ X2, ;DECREMENT COUNTER. POPJ P, SCNOUT: PUSH P,F ;OUTPUT A CHAR. MOVE F,HPOS(LP) CAIL F,^D132 ;USING MARGIN IS 132. JRST SCNER3 POP P,F JRST OUCH IMGAPZ: JUMPN LEFT,CPOPJ1 ;USED BY IMGAPS. JUMPN EXTEND,CPOPJ1 JUMPN RIGHT,CPOPJ1 JUMPN CENTER,CPOPJ1 POPJ P, ;SCNIMG LOOKS FOR NEXT FIELD. ;X1 IS A FLAG THAT PREVENTS LOOPING IF AN IMAGE WITH NO FIELDS IS SEEN. SCNIMN: TDZA A,A ;ARG IS NUMBER. SCNIMS: SETO A, ;ARG IS STRING. POP P,X1 POP P,T1 POP P,X2 POP P,B PUSH P,X1 MOVE X1,MASAPP ;RETRIEVE CURRENT POINTER. MOVE X1,(X1) SCNIM1: JUMPN X2,SCNIM2 ;CHAR LEFT IN IMAGE? JUMPN T1,SCNER1 ;NO--ANY FIELDS SEEN? MOVE X1,MASAPP ;YES, OKAY. O'E, FAIL. MOVE X1,-1(X1) ;MOVE PNTR AND MOVE X2,B ;CHAR COUNT BACK TO BEGINNING. SETO T1, PUSH P,X2 PUSHJ P,PCRLF ;END LINE, BEGIN NEW LINE. JUMPN LP,SILAB1 OUTPUT SILAB1: POP P,X2 SCNIM2: PUSHJ P,NXCHU SCNIM0: TLNN C,F.APOS JRST SCNIM3 JUMPE A,SCNER2 ;APOS SEEN, BETTER BE STR ARG. SETZ T1, PUSHJ P,IMGAPS SCNEND: MOVE A,MASAPP ;PROTECT POINTER. MOVEM X1,(A) POP P,X1 PUSH P,B PUSH P,X2 PUSH P,T1 JRST (X1) ;BACK TO USER CODE. SCNIM3: PUSHJ P,SCNIM6 JRST SCNIM1 JRST SILAB2 JRST SCNIM0 SILAB2: JUMPN A,SCNER2 SETZ T1, PUSHJ P,IMGPND JRST SCNEND SCNIM6: TLNN C,F.DOLL+F.STAR CAMN C,[XWD F.STR,43] JRST SCNIM4 SCNM35: JRST SCNOUT ;PRINTABLE CHAR. SCNIM4: JUMPE X2,SCNOUT MOVE G,C PUSHJ P,NXCHU CAMN C,G JRST CPOPJ1 EXCH C,G PUSHJ P,SCNOUT MOVE C,G POP P,G JRST 2(G) ;ENDIMG ENDS A USING STATEMENT. ENDIMG: POP P,C POP P,T1 POP P,X2 POP P,B PUSH P,C MOVE X1,MASAPP MOVE X1,(X1) ENDIM3: JUMPE X2,ENDIM1 ;OUTPUT PRINTABLE CHARS PUSHJ P,NXCHU ;UP TO THE NEXT FIELD. ENDIM0: TLNE C,F.APOS JRST ENDIM1 PUSHJ P,SCNIM6 JRST ENDIM3 JRST ENDIM1 JRST ENDIM0 ENDIM1: PUSHJ P,PCRLF ;END LINE. ENDIM2: JUMPN LP,EILAB1 OUTPUT EILAB1: SETZM FMTPNT(LP) SETOM ZONFLG(LP) SOS MASAPP SOS MASAPP POPJ P, ;IMGAPS ANALYZES STR FIELD AND OUTPUTS STR. CENTER=G EXTEND=E LEFT=D RIGHT=R IMGAPS: TLNN N,777777 ;GET OUTPUT STR KEY. JRST IMGA1 TLNE N,377777 JRST IMGAP1 MOVE T,N MOVE N,(T) JRST IMGAPS IMGAP1: JUMPLE N,IMGA1 PUSHJ P,STRETT IMGA1: SETZB CENTER,EXTEND ;CLEAR FLAGS. SETZB LEFT,RIGHT IMGAP0: JUMPE X2,IMGAP4 ;FIND C, E, L, AND R'S. MOVE F,X1 PUSHJ P,NXCHU TLNE C,F.LETT JRST IMGAP2 IMGP01: MOVE X1,F AOJA X2,IMGAP4 IMGAP2: TLZ C,777777 CAIE C,"L" JRST IMGA21 JUMPN LEFT,IALAB1 PUSHJ P,IMGAPZ IALAB1: AOJA LEFT,IMGAP0 IMGA21: CAIE C,"E" JRST IMGA22 JUMPN EXTEND,IALAB2 PUSHJ P,IMGAPZ IALAB2: AOJA EXTEND,IMGAP0 IMGA22: CAIE C,"C" JRST IMGP23 JUMPN CENTER,IALAB3 PUSHJ P,IMGAPZ IALAB3: AOJA CENTER,IMGAP0 IMGP23: CAIE C,"R" JRST IMGP01 JUMPN RIGHT,IALAB4 PUSHJ P,IMGAPZ IALAB4: AOJA RIGHT,IMGAP0 JRST IMGP01 IMGAP4: JUMPE LEFT,IALAB5 IMGA41: AOJA LEFT,IMGAP5 IALAB5: JUMPE EXTEND,IALAB6 AOJA EXTEND,IMGAP5 IALAB6: JUMPE CENTER,IALAB7 AOJA CENTER,IMGAP5 IALAB7: JUMPE RIGHT,IMGA41 AOJA RIGHT,IMGAP5 IMGAP5: HLRE F,N ;HAVE ANALYZED FIELD. MOVM F,F HRLI N,440700 ;GET PTR AND CHAR COUNT FOR ARG SKIPN T,LEFT ;IN N AND F. SKIPE T,EXTEND JRST IALAB8 SKIPN T,CENTER MOVE T,RIGHT IALAB8: CAIGE F,(T) JRST IMGAP6 JUMPN EXTEND,IMGP51 ;OVERFLOW. MOVEI F,(T) IMGP51: ILDB C,N PUSHJ P,SCNOUT SOJG F,IMGP51 POPJ P, IMGAP6: SUBI T,(F) JUMPE CENTER,IMGAP7 ;CENTER. IDIVI T,2 ADDI T1,(T) JUMPE T,IMGP61 MOVEI C," " IALABA: PUSHJ P,SCNOUT SOJG T,IALABA IMGP61: MOVEI T,(T1) SETZ T1, ;RESTORE FLAG. JRST IMGAP8 IMGAP7: JUMPE RIGHT,IMGAP8 ;RIGHT. JUMPE T,IMGP71 MOVEI C," " IALABB: PUSHJ P,SCNOUT SOJG T,IALABB IMGP71: JUMPE F,IMGP82 JRST IMGP51 IMGAP8: JUMPE F,IMGP81 ;LEFT OR EXTEND. IALABC: ILDB C,N PUSHJ P,SCNOUT SOJG F,IALABC IMGP81: JUMPE T,IMGP82 MOVEI C," " IALABD: PUSHJ P,SCNOUT SOJG T,IALABD IMGP82: POPJ P, ;IMGPND ANALYZES NUM FIELD AND THEN CALLS IMGINT, IMGDEC, OR IMGEXP. COMMA=G EXPON=E LCOUNT=D RCOUNT=R IMGPND: MOVEI LCOUNT,2 ;SET UP FLAGS. SETZB COMMA,EXPON SETZB RCOUNT,TRAIL MOVEM C,LEAD ;SAVE TYPE OF FIELD. IMGPN2: JUMPE X2,IMGINT ;SORT THRU #,$, *, AND COMMAS MOVE F,X1 ;IN LH OF FIELD. PUSHJ P,NXCHU CAME C,[XWD F.STR,43] CAMN C,LEAD AOJA LCOUNT,IMGPN2 TLNN C,F.COMA JRST IMGP21 SETO COMMA, AOJA LCOUNT,IMGPN2 IMGP21: TLNE C,F.PER ;NOT LH ANYMORE; DEC PT? JRST IMGPN3 TLNE C,F.MINS ;-? JRST IMGP22 MOVE X1,F AOJA X2,IMGINT IMGP22: SETOM TRAIL JRST IMGINT IMGPN3: JUMPE X2,IMGDEC ;MUST BE DEC OR EXP FIELD, SINCE ".". MOVE F,X1 PUSHJ P,NXCHU CAME C,[XWD F.STR,43] ;SORT THRU #,$,*, AND COMMAS IN RH. CAMN C,LEAD AOJA RCOUNT,IMGPN3 TLNN C,F.COMA JRST IMGP31 SETO COMMA, AOJA RCOUNT,IMGPN3 ;-? IMGP31: TLNN C,F.MINS JRST IALABE SETOM TRAIL JRST IMGDEC IALABE: CAIN C,"^" ;POSSIBLY EXPON? JRST IMGP32 MOVE X1,F AOJA X2,IMGDEC IMGP32: MOVEI EXPON,1 IMGPN4: JUMPN X2,IMGP41 ;REALLY 4 UP-ARROWS? ADDI X2,(EXPON) IMGP40: SUBI EXPON,5 IALABF: IBP X1 AOJL EXPON,IALABF HRRI X1,-1(X1) JRST IMGDEC IMGP41: PUSHJ P,NXCHU CAIE C,"^" AOJA EXPON,IMGP40 ;NOT REALLY EXPON FIELD. AOJ EXPON, CAIGE EXPON,4 JRST IMGPN4 JUMPE X2,IMGEXP ;SEEN 4 UP-ARROWS. MOVE F,X1 PUSHJ P,NXCHU TLNE C,F.MINS ;ALSO -? JRST IALABG MOVE X1,F AOJA X2,IMGEXP IALABG: SETOM TRAIL JRST IMGEXP ;IMGINT OUTPUTS NUMBER WITHOUT DECIMAL POINT AND WITHOUT EXPON. IMGINT: PUSH P,[Z IMGIN3] IMG0: MOVE C,LEAD ;IF THE NO. WILL BE MINUS AND CAMG N,MINONE ;THE SIGN LEADS AND THE FIELD IS SKIPE TRAIL ;* OR $, FAIL BECAUSE ILLEGAL. JRST IALABH TLNE C,F.DOLL+F.STAR JRST IMGER4 IALABH: MOVEI F,(LCOUNT) ;F = NO. OF PLACES FOR DIGITS AND COMMAS. TLNE C,F.DOLL SOJA F,CPOPJ ;$ TAKES ONE PLACE. SKIPN TRAIL CAME C,[XWD F.STR,43] POPJ P, SOJA F,CPOPJ IMGIN3: MOVE A,N ;A HAS ARG. MOVM N,N ;N HAS /ARG/. CAML N,ONE JRST IMGN31 MOVEI C,1 ;ANSWER IS 0. SETZ COMMA, SETZB N,A JRST IMGIN7 IMGN31: PUSH P,[Z IMGIN1] IMGDE2: SETZ C, FAD N,FIXCON FSB N,FIXCON JUMPE N,CPOPJ IMGD10: CAMG N,D1E14 JRST IMGD11 ADDI C,^D14 FDVR N,D1E14 JRST IMGD10 IMGD11: MOVEI T,^D14 IALABI: CAML N,DECTAB(T) JRST IMGD12 SOJGE T,IALABI SETZ T, MOVE N,DECTAB IMGD12: ADDI C,1(T) POPJ P, IMGIN1: FDVR N,DECTAB(T) FMPR N,DECTAB+8 ;FORCE 9 DIGITS. CAMGE N,DECTAB+8 MOVE N,DECTAB+8 CAMGE N,DECTAB+9 JRST IMGN44 MOVE N,DECTAB+8 AOJ C,IMGN44 IMGN44: MOVE T,N MULI T,400 ASH T1,-243(T) MOVE N,T1 PUSH P,[Z IMGIN7] IMG1: JUMPE COMMA,IMGIN5 ;COMMA BECOMES NO. OF ,'S TO BE OUTPUT. MOVEI T,-1(C) IDIVI T,3 MOVEI COMMA,(T) IMGIN5: MOVEI T,(COMMA) ;CHECK TO SEE IF IT OVERFLOWS THE FIELD. ADDI T,(C) CAIG T,(F) POPJ P, PUSH P,C JUMPL A,IMGIN6 SKIPE TRAIL JRST IMGIN6 MOVE C,LEAD CAME C,[XWD F.STR,43] JRST IMGIN6 CAIG T,1(F) JRST IMGN76 IMGIN6: MOVEI C,"&" ;OVERFLOWS THE FIELD. PUSHJ P,SCNOUT EXCH T,LCOUNT ;WIDEN FIELD. CAIN T,(F) JRST IMGN76 MOVE C,LEAD TLNE C,F.DOLL JRST IMGN73 CAME C,[XWD F.STR,43] JRST IMGN76 JUMPGE A,IMGN76 IMGN73: AOJA LCOUNT,IMGN76 IMGN76: POP P,C POPJ P, IMGIN7: PUSH P,[Z IMGIN8] IMG2: MOVEI T,(LCOUNT) ;OUTPUT EVERYTHING BEFORE THE DIGITS. MOVEI T1,(C) ADDI T1,(COMMA) SUBI T,(T1) ;T = LEADING PLACES. MOVE T1,LEAD CAMN T1,[XWD F.STR,43] JRST IMGN71 TLNE T1,F.DOLL JRST IMGN72 JUMPE T,CPOPJ ;* FIELD. PUSH P,C MOVEI C,"*" IALABJ: PUSHJ P,SCNOUT SOJG T,IALABJ POP P,C POPJ P, IMGN71: JUMPE T,CPOPJ ;# FIELD. SKIPN TRAIL JUMPL A,IMGN74 PUSH P,C MOVEI C," " IALABK: PUSHJ P,SCNOUT SOJG T,IALABK POP P,C POPJ P, IMGN72: SKIPA T1,[777777777777] ;$ FIELD. IMGN74: MOVEI T1,0 PUSH P,C SOJLE T,IMGN75 MOVEI C," " IALABL: PUSHJ P,SCNOUT SOJG T,IALABL IMGN75: MOVEI C,"-" JUMPE T1,IALABM MOVEI C,"$" IALABM: PUSHJ P,SCNOUT POP P,C POPJ P, IMGIN8: JUMPN N,IMGN81 ;NOW OUTPUT DIGITS. PUSH P,C MOVEI C,"0" PUSHJ P,SCNOUT POP P,C JRST IMGIN9 IMGN81: PUSH P,[Z IMGIN9] INTOUT: JUMPE COMMA,IMGN80 ;GENERAL OUTPUT ROUTINE FOR DIGITS AND COMMAS. MOVEI T,-1(C) ;AT ENTRY, C= NO. OF DIGITS REQ, IDIVI T,3 ;N=/NUMBER/, COMMA=0 UNLESS ,'S TO BE OUTPUT. IMULI T,3 ;T, T1, AND N ARE DESTROYED. MOVEI T1,(C) SUBI T1,(T) ;N.B. - N HAS THE LEADING DIGITS. IMGN80: MOVE T,N MOVE N,T1 PUSH P,C PUSH P,A MOVEI A,(C) PUSHJ P,IALABN JRST IMGN84 IALABN: IDIVI T,^D10 JUMPE T,IMGN82 PUSH P,T1 PUSHJ P,IALABN POP P,T1 IMGN82: JUMPE COMMA,IMGN87 JUMPLE A,IMGN87 JUMPN N,IMGN83 MOVEI C,"," PUSHJ P,SCNOUT MOVEI N,3 IMGN83: SOJ N, IMGN87: SOJL A,IALABO MOVEI C,60(T1) PUSHJ P,SCNOUT IALABO: POPJ P, IMGN84: JUMPLE A,IMGN86 IMGN89: JUMPE COMMA,IMGN88 JUMPN N,IMGN85 MOVEI C,"," PUSHJ P,SCNOUT MOVEI N,3 IMGN85: SOJ N, IMGN88: MOVEI C,"0" PUSHJ P,SCNOUT SOJG A,IMGN89 IMGN86: POP P,A POP P,C POPJ P, IMGIN9: SETZ T1, ;RESTORE FLAG. SKIPN TRAIL POPJ P, MOVEI C," " ;OUTPUT TRAILING SIGN. JUMPGE A,IALABP MOVEI C,"-" IALABP: JRST SCNOUT ;IMGDEC OUTPUTS NUMBERS WITH DECIMAL POINTS BUT WITHOUT EXPONENTS. IMGDEC: PUSHJ P,IMG0 ;ERROR CHECKING AND CALC ;F=NO. OF PLACES FOR DIGITS AND COMMAS. JUMPE N,IMGX16 PUSH P,N MOVE A,N PUSHJ P,IMGEX1 POP P,N MOVSI T1,(0.5) ;ROUND. JUMPG C,IMGD34 CAILE RCOUNT,9 JRST IMGD21 IMGD20: FDVR T1,DECTAB(RCOUNT) JRST IMGD26 IMGD21: MOVM C,C ADDI C,9 CAILE C,(RCOUNT) JRST IMGD20 IMGD31: CAIG C,^D14 JRST IMGD32 FDVR T1,D1E14 SUBI C,^D14 JRST IMGD31 IMGD32: FDVR T1,DECTAB(C) JRST IMGD26 IMGD34: ADDI C,(RCOUNT) CAIGE C,9 JRST IMGD20 SUBI C,9(RCOUNT) JUMPGE C,IMGD27 MOVM C,C JRST IMGD32 IMGD27: CAIG C,^D14 JRST IMGD28 FMPR T1,D1E14 SUBI C,^D14 JRST IMGD27 IMGD28: FMPR T1,DECTAB(C) IMGD26: MOVM N,N FAD N,T1 JUMPL A,IALABQ SKIPA A,N IALABQ: MOVN A,N PUSHJ P,IMGEX1 JUMPL C,IMGDE6 MOVEI T1,(RCOUNT) ADDI T1,(C) IMGD61: CAILE T1,9 MOVEI T1,9 ;T1 IS NO. OF DIGITS REQ. JRST IMGD62 IMGDE6: MOVEI T1,1(RCOUNT) ADD T1,C JUMPGE T1,IMGD61 SETZ T1, IMGD62: ADDI T,1 SUBI T,(T1) JUMPE T,IMGD51 JUMPL T,IMGD52 FDVR N,DECTAB(T) JRST IMGD51 IMGD52: MOVM T,T FMPR N,DECTAB(T) IMGD51: FAD N,FIXCON FSB N,FIXCON JUMPN T1,IALABR SETZ N, JRST IMGD53 IALABR: CAMGE N,DECTAB-1(T1) MOVE N,DECTAB-1(T1) CAMGE N,DECTAB(T1) JRST IMGD53 MOVE N,DECTAB-1(T1) AOJ C, IMGD53: PUSH P,A MOVEI A,(T1) MOVE T,N MULI T,400 ASH T1,-243(T) MOVE T,T1 SETZB T1,N JUMPLE C,IMGD64 CAIL C,(A) JRST IMGD69 SUBI A,(C) IDIV T,INTTAB(A) MOVEI N,(A) JUMPE T1,IMGD69 IALABT: CAMGE T1,INTTAB(A) SOJA A,IALABT SUBI N,1(A) JRST IMGD69 IMGD64: MOVE T1,T SETZ T, MOVM N,C CAILE N,(RCOUNT) MOVEI N,(RCOUNT) IMGD69: POP P,A JUMPGE A,IMGDE7 ;CHECK AGAIN FOR NEG. * OR $ FIELD. SKIPE TRAIL JRST IMGDE7 PUSH P,N MOVE N,LEAD TLNE N,F.DOLL+F.STAR JRST IALABU POP P,N JRST IMGDE7 IALABU: POP P,N JUMPN T,IMGER4 JUMPN T1,IMGER4 IMGDE7: PUSH P,T1 PUSH P,N JUMPG C,IALABV MOVEI C,1 IALABV: PUSH P,T PUSHJ P,IMG1 PUSHJ P,IMG2 ;OUTPUT EVERYTHING BEFORE THE DIGITS. POP P,N PUSHJ P,INTOUT ;OUTPUT LH DIGITS AND COMMAS. MOVEI C,"." PUSHJ P,SCNOUT POP P,N POP P,T PUSHJ P,INTTRA ;OUTPUT RH SIDE. JRST IMGIN9 IMGX16: SETZB COMMA,A ;ZERO ARG. MOVEI C,1 PUSHJ P,IMG2 ;LEADING *,$, ETC. PUSHJ P,IMGX17 JRST IMGIN9 ;IMGEXP OUTPUTS NUMBERS WITH DECIMAL POINTS AND EXPONENTS. IMGEXP: MOVE T,LEAD TLNE T,F.STAR+F.DOLL JRST IMGER3 JUMPE N,IMGEX8 MOVEI F,(LCOUNT) ;F= NO. OF PLACES FOR DIGITS IN LH. SKIPN TRAIL SOJ F, JUMPE COMMA,IMGEX4 MOVEI T,-1(F) IDIVI T,4 SUBI F,(T) AOJ T, IMULI T,3 CAILE F,(T) MOVEI F,(T) IMGEX4: MOVEI T1,(F) ADDI T1,(RCOUNT) CAILE T1,9 MOVEI T1,9 PUSH P,[Z IMGEX2] MOVE A,N ;NUMBER TO A. IMGEX1: MOVM N,N ;/NUMBER/ TO N. SETZ C, ;C = TRUE EXPONENT. IMGE51: CAMG N,D1E14 JRST IMGE50 ADDI C,^D14 FDVR N,D1E14 JRST IMGE51 IMGE50: CAML N,ONE JRST IMGE52 SUBI C,^D14 FMPR N,D1E14 JRST IMGE50 IMGE52: MOVEI T,^D14 IALABW: CAML N,DECTAB(T) JRST IMGE53 SOJGE T,IALABW MOVE N,DECTAB SETZ T, IMGE53: ADDI C,1(T) POPJ P, IMGEX2: SUBI T,-1(T1) JUMPE T,IMGE54 JUMPL T,IALABX FDVR N,DECTAB(T) JRST IMGE54 IALABX: MOVM T,T FMPR N,DECTAB(T) IMGE54: FADRI N,200400 ;ROUND. FAD N,FIXCON FSB N,FIXCON PUSH P,[Z IMGEX9] IMGDIV: CAMGE N,DECTAB-1(T1) ;GET LH AND RH IN MOVE N,DECTAB-1(T1) ;T AND T1 IN FIXED POINT. CAMGE N,DECTAB(T1) JRST IMGEX7 MOVE N,DECTAB-1(T1) AOJ C,IMGEX7 IMGEX7: MOVE T,N CAIL F,(T1) JRST IMGE71 PUSH P,A MOVEI A,(T1) SUBI A,(F) MULI T,400 ASH T1,-243(T) MOVE T,T1 IDIV T,INTTAB(A) MOVEI N,(A) JUMPE T1,IALABY IALABZ: CAMGE T1,INTTAB(A) SOJA A,IALABZ SUBI N,1(A) IALABY: POP P,A POPJ P, ;T HAS LEADING NUMBER OF DIGITS. IMGE71: MULI T,400 ;T1 HAS TRAILING NO. OF DIGITS. ASH T1,-243(T) MOVE T,T1 ;N HAS NO. OF LEADING ZEROES IN FRONT OF T1. SETZB T1,N POPJ P, IMGEX9: SUBI C,(F) CAIGE C,^D100 CAMG C,[-^D100] JRST IALAB. JRST IMGE91 IALAB.: PUSH P,C MOVEI C,"&" PUSHJ P,SCNOUT POP P,C IMGE91: SKIPE TRAIL JRST IMGX10 PUSH P,C MOVEI C," " JUMPGE A,IALAB$ MOVEI C,"-" IALAB$: PUSHJ P,SCNOUT POP P,C IMGX10: PUSH P,C MOVEI C,(F) ;NO. OF DIGITS TO C. PUSH P,T1 PUSH P,N MOVE N,T ;N = NUMBER. PUSHJ P,INTOUT MOVEI C,"." PUSHJ P,SCNOUT POP P,N POP P,T PUSH P,[Z IMGX12] INTTRA: JUMPE RCOUNT,CPOPJ ;OUTPUT RH SIDE. JUMPLE N,INTTR0 MOVEI C,"0" IALAB%: PUSHJ P,SCNOUT SOJ RCOUNT, SOJG N,IALAB% JUMPE RCOUNT,CPOPJ INTTR0: PUSHJ P,IALZB1 JRST INTTR2 IALZB1: IDIVI T,^D10 JUMPE T,INTTR1 PUSH P,T1 PUSHJ P,IALZB1 POP P,T1 INTTR1: SOJL RCOUNT,CPOPJ MOVEI C,60(T1) JRST SCNOUT SOJA RCOUNT,CPOPJ INTTR2: JUMPLE RCOUNT,CPOPJ MOVEI C,"0" IALZB2: PUSHJ P,SCNOUT SOJG RCOUNT,IALZB2 POPJ P, IMGX12: POP P,N IMGX11: MOVEI C,"E" ;PRINT EXPONENT. PUSHJ P,SCNOUT MOVEI C,"+" JUMPGE N,IALZB3 MOVEI C,"-" IALZB3: PUSHJ P,SCNOUT MOVM T,N IDIVI T,^D10 CAIGE T,^D10 JRST IMGX13 PUSH P,T1 IDIVI T,^D10 MOVEI C,60(T) PUSHJ P,SCNOUT MOVE T,T1 POP P,T1 IMGX13: MOVEI C,60(T) PUSHJ P,SCNOUT MOVEI C,60(T1) PUSHJ P,SCNOUT JRST IMGIN9 IMGEX8: SOJ LCOUNT, ;EXP FIELD IS 0. MOVEI C," " IALZB4: PUSHJ P,SCNOUT SOJG LCOUNT,IALZB4 PUSH P,[Z IMGE81] IMGX17: MOVEI C,"0" PUSHJ P,SCNOUT MOVEI C,"." PUSHJ P,SCNOUT JUMPE RCOUNT,CPOPJ MOVEI C,"0" IALZB5: PUSHJ P,SCNOUT SOJG RCOUNT,IALZB5 POPJ P, IMGE81: SETZB N,A JRST IMGX11 INTTAB: ^D1 ^D10 ^D100 ^D1000 ^D10000 ^D100000 ^D1000000 ^D10000000 ^D100000000 ^D1000000000 ;RESTORE DATA POINTER RESTOR: PUSHJ P,RESTOS ;RESTORE BOTH NUMBERS AND STRINGS RESTON: TDZA X1,X1 ;RESTORE NUMERIC DATA RESTOS: MOVEI X1,1 ;RESTORE STRINGS MOVE T,DATAFF ADD T,FLLIN SUB T,[XWD 1,1] MOVEM T,DATLIN(X1) SETZM PREAD(X1) ;CLEAR CURRENT LINE POINTER POPJ P, NXRE2: INLERR(57,52,</ ? Out of DATA/>) HRRZ T,L JRST GOSR2 INLBSY(8,</ ? Data file line too long/>) INLBSY(9,</ ? Illegal character in string/>) FNMX0: MOVEI LP,(X1) FNMXER: SKIPN ACTBL-1(LP) JRST FNR FNMX1: INLERR(32,10,</ ? Mixed random & seq. access/>) JRST GOSR2 PTXER2: INLERR(35,11,</ ? Output item too long for line/>) JRST GOSR2 IMP: INLERR(50,12,</ ? Bad DATA/>) JRST GOSR2 FNR: INLERR(9,13,</ ? File never established - referenced/>) JRST GOSR2 LKFAIL: INLERR(5,14,</ ? Failure on lookup/>) JRST GOSR2 ENFAIL: INLERR(4,15,</ ? Failure on enter/>) JRST GOSR2 ILWRT: CAIE X2,1 JRST ILWRT1 INLERR(10,16,<% ? Attempt to WRITE# or PRINT# to a file which is in READ# or INPUT# mode%>) JRST GOSR2 ILWRT1: INLERR(10,17,<% ? Attempt to WRITE# or PRINT# to a file which has not been SCRATCH#ed%>) JRST GOSR2 ILRD: CAIE X1,3 JRST ILRD1 INLERR(10,18,<% ? Attempt to READ# or INPUT# from a file which is in WRITE# or PRINT# mode%>) JRST GOSR2 ILRD1: INLERR(9,19,<% ? Attempt to READ# or INPUT# from a file which does not exist%>) JRST GOSR2 RANSRF: INLERR(36,53,</ ? Cannot erase file on channel />) RAN2: HRRZ T,LP PUSHJ P,ERRXCX PUSHJ P,PRTNUM PUSHJ P,ERRXCY JRST GOSR2 LOKFAL: SETZM ODF INLERR(37,20,</ ? File not found by RESTORE command/>) JRST GOSR2 INLBSY(21,</ ? EOF/>) CHAERR: INLERR(28,22,</ ? Line number/>) JRST OUTBND RNERR1: INLERR(41,23,</ ? Mixed strings and numbers/>) JRST GOSR2 RNERR2: INLERR(10,24,</ ? Output string length greater than record length/>) JRST GOSR2 RNERR3: INLERR(10,25,</ ? File not in correct form/>) JRST GOSR2 CHAER1: INLERR(2,26,</ ? Illegal filename/>) JRST GOSR2 WRPRER: INLERR(10,27,<" ? Mixed WRITE#/PRINT#">) JRST GOSR2 SCNER1: INLERR(42,54,</ ? No fields in image/>) JRST GOSR2 SCNER2: INLERR(70,28,</ ? Attempt to output a number to a string field or a string to a numeric field/>) JRST GOSR2 SCNER3: INLERR(71,29,</ ? Output line more than 132 characters/>) JRST GOSR2 IMGER1: INLERR(72,55,</ ? No characters in image/>) JRST GOSR2 IMGER2: INLERR(73,30,</ ? More than 132 characters in image/>) JRST GOSR2 IMGER3: INLERR(74,31,</ ? Exponent requested for * or $ field/>) JRST GOSR2 IMGER4: INLERR(75,32,</ ? Attempt to output a negative number to a * or $ field/>) JRST GOSR2 MARERR: INLERR(76,33,</ ? MARGIN too small/>) JRST GOSR2 REINER: INLERR(10,34,<" ? Mixed READ#/INPUT#">) JRST GOSR2 MARER1:INLERR(77,56,</ ? MARGIN />) OUTBND: INLERR(34,35,</ out of bounds/>) JRST GOSR2 PAGERR: INLERR(78,36,</ ? PAGE length/>) JRST OUTBND PLTERR: INLERR (79,68,</ ? File opened TO PLOT/>) JRST GOSR2 CNER1: INLERR(46,37,</ ? Channel number is <1 or >9/>) JRST GOSR2 ;RUNTIME MAT INPUT ROUTINE MATIN: SETZM IFIFG PUSHJ P,DOINPT ;SETUP INPUT LOOP HRRZ X1,40 ;GET VECTOR 2-WD BLOCK ADDRESS HRRZ X2,(X1) ;GET ADDRESS OF FIRST ELEMENT HRRZ T,1(X1) ;GET COL. DIM SOJE T,MATINA ;ADJ COUNT UNLESS 0 ADDI X2,1(T) ;ELSE SKIP COL. 0 MATINA: MOVEM T,ELECT1 ;SET MASTER COUNT MOVEM T,ELECT2 ;AND RUNNING COUNT MOVEM X2,NUMRES ;SAVE THIS VALUE FOR COUNTING ELEMENTS LATER HLRZ X1,(X1) ;GET MAXIMUM VECTOR SIZE ADD X1,X2 ;UPPER BOUND OF VECTOR SUBI X1,1 MOVEM X1,ELETOP ;SAVE FOR COMPARISON LATER HRRM X2,40 ;SET UP ELEMENT ADDRESS FOR DATA ROUTINES MATIN1: MOVEI X1,MATIN4 ;POINT "INPUT ERR" TO SPECIAL ROUTINE HRL X1,ELECT2 ;GET CURRENT COUNT HLRZM X1,ELECT3 ;REMEMBER IT HRL X1,40 ;REMEMBER FIRST ELEMENT ON LINE MOVEM X1,INPFLA PUSHJ P,NXVINP ;INPUT THE LINE MATIN5: JRST MILAB1 ;THERE IS ANOTHER ELEMENT. JRST MATIN6 ;NULL LINE. NO MORE ELEMENTS. MILAB1: HRRZ X1,40 ;MAY WE ACCEPT ANOTHER ELEMENT? CAML X1,ELETOP JRST MATIN3 ;NO SKIPN ELECT1 ;VECTOR ? JRST MTIN5A ;YES, SKIP MATRIX CODE SOSL ELECT2 ;SKIP ELEMENT 0 ? JRST MTIN5A ;NO MOVE T,ELECT1 ;RESET THE COUNT SOJ T, ;BACK OFF ONE MOVEM T,ELECT2 AOS 40 ;DONT STORE IN ELEMENT 0 MTIN5A: AOS 40 ;POINT TO NEXT ELEMENT PUSH P,[EXP MATIN2] ;YES. SETUP RETURN FROMDATA ROUTINE CAML X1,SVRBOT ;NUMBER OR STRING VECTOR? JRST SDATAE ;STRING JRST DATAER ;NUMBER MATIN2: TLNE C,F.CR ;END OF INPUT? JRST MATIN6 ;YES, SET UP "NUM" FUNCTION AND RETURN. CAIE C,"&" JRST MATIN7 MOVE T,(R) PUSHJ P,NXCH TLNN C,F.CR JRST INPERR JRST MATIN1 MATIN7: TLNN C,F.COMA JRST INPERR MOVE T,(R) PUSHJ P,NXCH TLNE C,F.CR JRST MATIN6 CAIE C,"&" JRST MATIN5 PUSHJ P,NXCH TLNN C,F.CR JRST MATIN5 JRST MATIN1 MATIN3: NFERR (94,0) PUSHJ P,INLMES ASCIZ / ? Too many elements/ SKIPE CHAFL2 PUSHJ P,ERRMS3 PUSHJ P,INLMES ASCIZ /-- retype line / JRST INPER1 MATIN4: HLRZ X1,INPFLA ;AN ERROR HAS OCCURRED. START LINE OVER HRRM X1,40 ;WITH SAME ELEMENT MOVE X1,ELECT3 ;GET REMEMBERED COUNT MOVEM X2,ELECT2 ;AND RESTORE IT JRST MATIN1 MATIN6: HRRZ X1,40 ;CALCULATE NUMBER OF ELEMENTS SUB X1,NUMRES MOVEM X1,NUMRES POPJ P, REDSTR: SKIPE INPFLA JRST REDS9 TLNN C,F.LETT+F.QUOT POPJ P, REDS9: SKIPN IFIFG SKIPN INPFLA JRST REDS91 SKIPE INLNFG JRST REDS91 TLNE C,F.COMA ;TEST FOR LEADING COMMA FOR INPUT. POPJ P, REDS91: AOS (P) ;THIS IS A LEGITIMATE STRING PUSH P,G PUSH P,E SETOM VIRWRD ;GOING TO WRITE INTO VIRTUAL STRING (MAYBE) PUSHJ P,SPVIRS ;SET UP F&G IF VIRTUAL STRING JRST PVIRS1 ;NON SKIP RETURN MEANS VIRTUAL STRING PUSHJ P,GETSTR MOVEI N,(X1) MOVE G,T SETZ T, PUSHJ P,VCHCKC ;MAKE SPACE EXCH G,T PVIRS1: SKIPN INLNFG ;DOING INPUT LINE? JRST REDS41 ;NO, CONTINUE MOVEI X1,F.CR ;ONLY END-OF LINE IS END CLEARM INLNFG ;RESET FLAG SETZM QUOFL1 ;CLEAR QUOTE FLAG JRST REDS1 ;INPUT THE STRING REDS41: SKIPN IFIFG JRST REDS4 MOVEI X1,F.COMA+F.CR+F.SPTB+F.QUOT JRST REDS3 REDS4: MOVEI X1,F.COMA+F.CR ;ASSUME A STRING WITHOUT QUOTES SKIPN INPFLA ADDI X1,F.APOS REDS3: SETZM QUOFL1 TLNN C,F.QUOT ;IS IT A QUOT STRING? JRST REDS1 ;NO SETOM QUOFL1 MOVEI X1,F.QUOT+F.CR PUSHJ P,NXCHD ;SKIP QUOTE REDS1: SETZ X2, SKIPE VIRSIZ ;VIRTUAL STRING? JRST REDS2 ;YES. SKIP THIS STUFF MOVE X2,N SKIPE (X2) ;NEW STRING? SETZM VPAKFL ;NO, GARBAGE NOW EXISTS SETZ X2, ;INITIALIZE COUNT. HRRI F,(G) ;GET FREE LOCATION PUSH P,T MOVE T,N HRRM F,(T) POP P,T REDS2: TLNN C,(X1) JRST REDS6 SKIPE QUOFL1 JRST REDQOT TLNN C,F.QUOT JRST REDS8 REDS7: POP P,E POP P,G SOS (P) POPJ P, REDQOT: TLNN C,F.QUOT JRST REDS7 PUSHJ P,NXCHD JRST REDS8 REDS6: CAMG X2,[-^D132] ;STRING TOO LONG ? JRST [INLEMS(7,2,OPNER4) JRST GOSR2] IDPB C,F ;STORE A CHAR PUSHJ P,NXCHD SOJA X2,REDS2 ;COUNT THE CHAR REDS8: HRRZ X1,F ;GET NEW FREE LOCATION POP P,E SKIPE VIRSIZ ;VIRTUAL STRING? JRST REDS84 ;YES. JUST RETURN MOVE G,N JUMPN X2,REDS82 SETZM (G) JRST REDS84 REDS82: HRLM X2,(G) AOJ X1, HRRM X1,VARFRE REDS84: POP P,G POPJ P, SSKIP: SKIPE INPFLA ;IS THIS INPUT OR READ? JRST INPERR ;INPUT. CANT SKIP ANY FIELDS PUSHJ P,SKIPDA ;SKIP OVER A DATA FIELD HALT . ;IMPOSSIBLE ERROR POP P,X1 TLNE C,F.TERM ;END OF DATA LINE? JRST -10(X1) ;YES. FORCE DATA SEARCH JRST -7(X1) ;RETURN TO DATAER OR SDATAE SUBTTL RUN-TIME ROUTINES FOR PRINTING FINPNT: MOVE X1,FMTPNT(LP) ;FINISH WITH CR? CAIE X1,1 POPJ P, SETOM ZONFLG(LP) PUSHJ P,PCRLF FINPT4: JUMPN LP,FPLAB1 OUTPUT FPLAB1: POPJ P, PCRLF: MOVEI C,15 ;ROUTINE TO END A LINE AND PUSHJ P,OUCH ;POSSIBLY BEGIN A NEW LINE. MOVEI C,12 PUSHJ P,OUCH PCRLF3: SETZM TABVAL(LP) SETZM HPOS(LP) SKIPG C,PAGLIM(LP) JRST PCRLF2 AOS PAGCNT(LP) CAME C,PAGCNT(LP) JRST PCRLF2 MOVEI C,14 PUSHJ P,OUCH SETZM HPOS(LP) SETZM PAGCNT(LP) PCRLF2: SKIPE C,MARWAI(LP) MOVEM C,MARGIN(LP) PCRLF1: JUMPE LP,FINPT3 MOVE C,MARGIN(LP) CAIL C,^D7 JRST FINPT3 SKIPGE WRIPRI-1(LP) JRST MARERR FINPT3: HRRZ X2,(P) CAIE X2,FINPT4 CAIN X2,CRLF8 POPJ P, CAIE X2,ENDIM2 PUSHJ P,NUMINS POPJ P, CRLF: MOVE C,HPOS(LP) ;ROUTINE USED BY "EMPTY" OUTPUT ADD C,TABVAL(LP) ;STATEMENTS, AND RESTORE AND UXIT. JUMPE C,CRLF4 JUMPE LP,CRLF5 CAIN C,^D6 SKIPL WRIPRI-1(LP) JRST CRLF5 JRST CRLF3 CRLF5: PUSHJ P,PCRLF CRLF8: JRST CRLF2 CRLF4: PUSHJ P,PCRLF2 CRLF3: MOVEI C,15 PUSHJ P,OUCH MOVEI C,12 PUSHJ P,OUCH SETZM TABVAL(LP) SETZM FMTPNT(LP) SKIPG T,PAGLIM(LP) JRST CRLF2 AOS PAGCNT(LP) CAME T,PAGCNT(LP) JRST CRLF2 MOVEI C,14 PUSHJ P,OUCH SETZM PAGCNT(LP) CRLF2: SETZM HPOS(LP) CRLF1: SETZM TABVAL(LP) SETZM FMTPNT(LP) JUMPN LP,CRLAB1 OUTPUT CRLAB1: SETOM FIRSFL(LP) POPJ P, ;RUN-TIME NUMBER PRINTER PRNMER: MOVE X1,40 ;GET UUO SETZM FTYPE ;ASSUME REAL TLZE X1,400 ;IS IT? SETOM FTYPE ;NO, MARK AS INTEGER MOVEM X1,40 ;PUT BACK LESS INTEGER BIT PUSHJ P,TABBR PUSHJ P,FIRCHK SKIPGE TABVAL(LP) PUSHJ P,PCRLF PUSHJ P,NUMINS MOVE N,@40 ;GET THE NUMBER SKIPGE FTYPE ;IS IT REAL PUSHJ P,FLTPNT ;NO, FLOAT IT PUSHJ P,OUTNUM AOS TABVAL(LP) ;CAUSE A SPACE TO FOLLOW NUMBER. SETZM ZONFLG(LP) JRST FINPNT ;RUN-TIME TAB PRINTER PRNTBR: PUSHJ P,TABBR PUSHJ P,FIRCHK SKIPGE B,TABVAL(LP) ;IGNORE ZERO AND MINUS TABS. PUSHJ P,PCRLF JUMPL N,FINPNT PUSHJ P,NUMINS MOVE X1,N MOVE N,MARGIN(LP) IDIV X1,N SUB X2,HPOS(LP) SUB X2,TABVAL(LP) JUMPL X2,FINPNT ADDM X2,TABVAL(LP) SETOM ZONFLG(LP) JRST FINPNT ;RUNTIME DELIMITER SPACING ROUTINE. PRDLER: SKIPE X1,FMTPNT(LP) CAIN X1,4 SETOM ZONFLG(LP) PUSHJ P,TABBR SKIPGE TABVAL(LP) PUSHJ P,PCRLF PUSHJ P,NUMINS PUSHJ P,FIRCHK JRST FINPNT FIRCHK: SKIPN FIRSFL(LP) JRST FCLAB1 PUSHJ P,PCRLF1 SETZM FIRSFL(LP) FCLAB1: SKIPN T,HPOS(LP) JRST MARCH2 JUMPE LP,CPOPJ CAIN T,^D6 SKIPL WRIPRI-1(LP) POPJ P, MARCH2: SKIPE T,MARWAI(LP) MOVEM T,MARGIN(LP) POPJ P, NUMINS: JUMPE LP,CPOPJ SKIPGE WRIPRI-1(LP) ;NEED A LINE NUMBER? SKIPE HPOS(LP) POPJ P, ;NO. MOVEI X2,12 ;YES. ADDB X2,LINNUM-1(LP) CAILE X2,^D99999 JRST NUMLRG PUSH P,T MOVE T,@OUTCNT-1(LP) JUMPLE T,NUMIN2 IDIVI T,5 JUMPE T1,NUMIN2 NILAB1: SETZ C, ;PAD WITH NULLS SO THAT THE LINE PUSHJ P,OUCH ;NUMBER STARTS IN A NEW WORD. SOJG T1,NILAB1 NUMIN2: MOVE T,LINNUM-1(LP) SETZM NUMCOT PUSHJ P,PRTNUM MOVEI T,5 MOVEM T,HPOS(LP) MOVE T,NUMCOT SUBI T,5 MOVE T1,@OUTPT-1(LP) MOVE T1,(T1) JUMPE T,NUMIN3 NUMIN4: LSH T1,-7 ;PAD WITH LEADING ZEROES (RE- TLO T1,300000 ;QUIRED BY THE LINED CUSP). IBP @OUTPT-1(LP) SOS @OUTCNT-1(LP) AOJL T,NUMIN4 NUMIN3: TRO T1,1 ;SET THE "SEQ. NO." BIT. MOVE T,@OUTPT-1(LP) MOVEM T1,(T) POP P,T MOVEI C,11 ;TAB. PUSHJ P,OUCH POPJ P, NUMLRG: PUSHJ P,TTYIN INLERR(80,38,</ ? Attempt to write a line number greater than 99999/>) JRST GOSR2 ;TAB CONTROL ;"TABBR" ANALYSES THE LAST FORMAT CHARACTER USING "TABB0", "TABB1", AND ;"TABB3", WHICH HANDLE THE <PA>, COMMA, AND SEMICOLON, RESPECTIVELY. ;"TABVAL" CONAINS THE NUMBER OF SPACES WAITING TO BE TYPED OUT ;(OR IS NEGATIVE IF A <RETURN> MUST FOLLOW.) CHROOM: MOVE B,TABVAL(LP) ADD X1,B ;TOTAL SPACE NEEDED FOR FIELD ADD X1,HPOS(LP) CAML X1,MARGIN(LP) JRST PCRLF ;NO ROOM, GO TO NEXT LINE. JUMPL B,PCRLF JUMPE B,CPOPJ ;NO SPACING TO DO. COLAB1: MOVEI C," " ;HERE TO PUT OUT SPACES PUSHJ P,OUCH SOJG B,COLAB1 SETZM TABVAL(LP) POPJ P, TABBR: LDB X1,[POINT 4,40,12] EXCH X1,FMTPNT(LP) ;GET OLD POSITION AND SAVE NEW FORMAT SKIPGE A,TABVAL(LP) POPJ P, ADD A,HPOS(LP) JRST .+1(X1) POPJ P, ;NO FMT CHAR POPJ P, ;<CR> WAS TYPED WHEN FIRST SEEN. JRST TABB3 ;SEMICOLON JRST TABB1 ;COMMA TABB0: PUSH P,FMTPNT(LP) ;<PA> PUSHJ P,PAGE1 POP P,FMTPNT(LP) POPJ P, TABB1: MOVE X1,MARGIN(LP) JUMPE LP,TBLAB1 SKIPGE WRIPRI-1(LP) ;FIRST ZONE STARTS AFTER LINE NUMBER. SUBI X1,6 TBLAB1: IDIVI X1,^D14 SUBI X1,1 IMULI X1,^D14 JUMPE LP,TBLAB2 SKIPGE WRIPRI-1(LP) SUBI A,6 TBLAB2: CAMLE A,X1 JRST SETCR IDIVI A,^D14 JUMPE B,TBLAB3 SETOM ZONFLG(LP) JRST TABB2 TBLAB3: SKIPN ZONFLG(LP) JRST TBLAB4 MOVEI B,^D14 JRST TABB31 TBLAB4: SETOM ZONFLG(LP) POPJ P, TABB2: SUBI B,^D14 MOVNS B TABB31: ADDM B,TABVAL(LP) POPJ P, TABB3: MOVE X1,MARGIN(LP) CAML A,X1 JRST SETCR POPJ P, SETCR: SETOM TABVAL(LP) ;FORCE <RETURN TO BE NEXT> POPJ P, SUBTTL RUN-TIME STRING MANIPULATION ROUTINES. ;GETSTR IS CALLED WITH THE ADDRESS OF A POINTER IN REG. ;THE ROUTINE SETS UP THE POINTER IN F, AND THE NEGATIVE COUNT OR ;(FOR LITERAL STRINGS) A POSITIVE QUANTITY IN G. (G=0 IF NULL STRING) GETSTR: PUSHJ P,PNTADR ;GET ADDRESS OF STRING POINTER MOVE F,(X1) HLRE G,F ;PUT NEGATIVE CHAR LENGTH IN G, IF NOT APP BLK OR 0. JUMPG G,CPOPJ HRLI F,440700 ;NOTAPP BLK, INITIALIZE POINTER. POPJ P, ;ROUTINE TO SET UP A NUMBER VECTOR INSTEAD OF A STRING GETVEC: CLEARM FTYPE ;ASSUME REAL VECTOR CAILE X1,6 ;IS VECTOR REAL? SETOM FTYPE ;NO, MARK AS INTEGER HRRZ F,@40 ;THE LEFT SIDE OF (F) IS ZERO MOVE G,(F) ;GET VECTOR LENGTH JUMPL G,GETVF ;NEGATIVE? SKIPGE FTYPE ;IS IT ALREADY AN INTEGER? JRST GETVIN ;YES, DON'T FIX IT FAD G,FIXCON ;FIX THE LENGTH TLZ G,777400 GETVIN: HLRZ X1,@40 ;DOES THE LENGTH EXCEED VECTOR BOUNDS? MOVNS G ADD X1,G JUMPLE X1,GETVF SKIPGE FTYPE ;REAL VECTOR? TLO F,1 ;NO, MARK AS INTEGER AOJA F,CPOPJ ;NO. POINT TO FIRST "CHAR" AND RETURN GETVF: INLERR(81,39,</ ? Impossible vector length/>) JRST GOSR2 ;ROUTINE TO GET NEXT VECTOR ELE AS A CHARACTER GETEL: AOJG G,CPOPJ ;IS THERE ANOTHER ELEMENT? MOVE C,(F) ;YES. GET IT JUMPL C,GETELF ;TOO SMALL TO BE AN ASCII SKIPGE FTYPE ;IS VECTOR INTEGER? JRST GETEIN ;YES, NO FIXING NEEDED PUSH P,R LDB R,[POINT 8,C,8] ;GET EXPONENT TLZ C,777000 ;TURN IT OFF LSH C,-233(R) ;SHIFT INTO INTEGER POSTION POP P,R GETEIN: CAIGE C,^D128 CAIGE C,0 JRST GETELF CAIG C,^D13 CAIGE C,^D10 AOJA F,CPOPJ1 SKIPN CRTVAL ;ARE 10-13 LEGAL? JRST GETELF ;NO, GIVE AN ERROR AOJA F,CPOPJ1 ;BUMP ELEMENT POINTER AND RETURN GETELF: INLERR(82,40,</ ? Illegal char seen/>) JRST GOSR2 ;ROUTINE TO STORE "NUMERIC" CHARS INTO A STR. STRCHA: CLEARM FTYPE ;ASSUME VECTOR IS REAL TLZE F,1 ;IS IT? SETOM FTYPE ;NO, MARK AS INTEGER PUSH P,F PUSH P,G SETOM VIRWRD ;MAY DO A VIRTUAL STR WRITE PUSHJ P,SPVIRS ;CHECK IF 40 POINTS TO VIRTUAL ROLL ETC. JRST [POP P,G POP P,F MOVE T,VIRWRD JRST STRCH1] POP P,G POP P,F PUSHJ P,PNTADR MOVM T,G ;GETVEC SET UP F AND G. PUSH P,X1 PUSHJ P,VCHCKC POP P,X1 SKIPE (X1) SETZM VPAKFL MOVEM T,(X1) HRLM G,(X1) HRLI T,440700 STRCH1: PUSHJ P,GETEL JRST CPOPJ IDPB C,T JRST STRCH1 ;ROUTINE TO MOVE "STRING" CHARS INTO A VECTOR PUTVEC: CLEARM FTYPE ;ASSUME VECTOR IS REAL CAILE X1,6 ;ARE WE RIGHT? SETOM FTYPE ;NO, MARK AS INTEGER PUSH P,40 SETZM VIRWRD MOVE X1,N PUSHJ P,CKVSTR MOVE N,X1 POP P,40 TLNN N,777777 JRST PUTV3 TLNE N,377777 JRST PUTV2 MOVE T,N MOVE N,(T) JRST PUTV3 PUTV2: JUMPLE N,PUTV3 PUSHJ P,STRETT PUTV3: HLRE G,N HRRZ F,N HRLI F,440700 HRRZ X1,40 HRRZ N,(X1) ;SAVE FIRST LOC ADDRESS FOR LENGTH STORE HLRZ X2,(X1) ;GET SIZE HRRZ X1,(X1) PUTV1: JUMPE G,PUTV9 ;GET CHAR. ILDB C,F AOJ G, SOJL X2,PUTVF ;ROOM FOR ANOTHER CHAR? SKIPGE FTYPE ;IS RECEIVING VECTOR REAL JRST PUTV4 ;NO, THEN DON'T FLOAT IT TLO C,233400 ;YES. FLOAT IT FSB C,FIXCON PUTV4: MOVEM C,1(X1) AOBJP X1,PUTV1 ;COUNT CHARS IN LEFT HALF OF X1 PUTV9: HLRZ X1,X1 ;GET SIZE SKIPGE FTYPE ;IS VECTOR REAL? JRST PUTV5 ;NO, DON'T FLOAT IT HRLI X1,233400 ;FLOAT IT FSB X1,FIXCON PUTV5: MOVE X2,N MOVEM X1,(X2) ;FIRST ELEMENT GETS SIZE POPJ P, PUTVF: INLERR(83,41,</ ? No room for string/>) JRST GOSR2 ;STORE STR FOR LET STATEMENT. PUTSTR: PUSH P,40 ;CKVSTR DESTROYS 40 SETZM VIRWRD ;CHECKING FOR FETCH MOVE X1,N ;SEE IF N IS A VIRTUAL STRING ARRAY PUSHJ P,CKVSTR MOVE N,X1 ;RESET N TO FIXED POINTER POP P,40 ;RESTORE 40 MOVE X1,40 MOVE X1,0(X1) ;SEE IF 40 POINTS TO VIRTUAL ARRAY SETOM VIRWRD ;SET VIRTUAL ARRAY FLAG PUSHJ P,CKVSTR TLNN N,777777 JRST PUTST2 TLNE N,377777 JRST PUTST1 MOVE T,N MOVE N,(T) JRST PUTSTR PUTST1: JUMPG N,PUTST4 PUTST2: HLRE G,N JUMPN G,PUTST5 SKIPE VIRWRD ;VIRTUAL STRING? JRST PUTXX9 PUSHJ P,PNTADR SKIPE (X1) SETZM VPAKFL SETZM (X1) POPJ P, PUTST5: MOVM T,G SKIPN VIRSIZ ;PUTTING A STRING IN VIRTUAL ARRAY? JRST PUTST9 ;NO. CAMLE G,VIRSIZ ;STRING BIGGER THAN PLACE TO PUT IT? JRST RNERR2 PUTST9: PUSHJ P,MASTST ;CHECK ENOUGH SPACE AOS F,MASAPP MOVEM N,(F) PUSHJ P,VCHCKC MOVE N,(F) SOS MASAPP HRRZ F,N HRLI F,440700 PUSHJ P,PNTADR SKIPE (X1) SETZM VPAKFL HRRZM T,(X1) HRLM G,(X1) SKIPE VIRWRD SKIPA T,VIRWRD HRLI T,440700 PUTST3: ILDB C,F IDPB C,T SOS VIRSIZ ;DECREMENT VIRTUAL ARRAY ELEMENT SIZE TOO AOJL G,PUTST3 SKIPN VIRWRD ;VIRTUAL STRING? SETZM VIRSIZ ;NO, 0 VIRSIZ SETZM VIRWRD SKIPG VIRSIZ ;DO WE NEED TO NULL FILL VIRTUAL STR? POPJ P, ;HERE TOO NULL FILL REST OF VIRTUAL STRING ELEMENT SETZ C, ;NULL TO C PSLAB1: IDPB C,T ;PUT NULL IN VIRTUAL STR. SOS VIRSIZ ;DECREMENT COUNT OF VIRTUAL STRING SIZE SKIPLE VIRSIZ ;MORE TO NULL FILL? JRST PSLAB1 ;YES. KEEP NULL FILLING. POPJ P, ;NO. RETURN PUTST4: PUSHJ P,STRETR MOVE T,N SKIPE VIRWRD ;VIRTUAL ARRAY STORE JRST PUTST2 ;HAS HANDLE DIFFERENTLY PUSHJ P,PNTADR SKIPE (X1) SETZM VPAKFL MOVEM T,(X1) POPJ P, PUTXX9: SETZ C, ;YES FILL VIRT. STR. WITH NULLS MOVE T,VIRWRD ;PICK UP POINTER MOVE G,VIRSIZ ;GET STRING SIZE PSLAB2: JUMPN G,PUTXX1 POPJ P, PUTXX1: IDPB C,T ;PUT IN NULL SOJA G,PSLAB2 ;COMSTR COMPARES TWO STRINGS. ONE HAS BEEN FETCHED. THE POINTER ;TO THE OTHER IS IN REG. THE COMPARE RELATION IS IN (P) ;COMSTR GETS A PAIR OF CHARS, ONE FROM EACH STRING, USING "GETPCH". ;WHEN IT REACHES THE END OF ONE OR BOTH STRINGS, OR WHEN IT FINDS ;AN UNEQUAL CHAR PAIR, THE ROUTINE USES THIS PAIR OF CHARACTERS ;WHILE EXECUTING THE RELATION (NOTE: FIRST, HOWEVER, A CHECK IS MADE ;FOR TRAILING BLANKS). COMSTR: PUSH P,40 SETZM VIRWRD ;VIRTUAL STRING READ MOVE X1,N PUSHJ P,CKVSTR ;SEE IF N POINTS TO VIRTUAL STR MOVE N,X1 POP P,40 TLNN N,777777 JRST COMST2 TLNE N,377777 JRST COMST1 MOVE T,N MOVE N,(T) JRST COMST2 COMST1: JUMPLE N,COMST2 PUSHJ P,STRETT COMST2: PUSHJ P,MASTST ;CHECK ENOUGH SPACE AOS F,MASAPP MOVEM N,(F) PUSHJ P,SPVIRS ;SETUP X1 WITH VIRTUAL STR POINTER JRST [MOVE N,X1 ;RETURNS HERE IF IT IS JRST COMST3] PUSHJ P,PNTADR MOVE N,(X1) TLNN N,777777 JRST COMST3 JUMPLE N,COMST3 PUSHJ P,STRETT COMST3: HRRZ F,N HLRE G,N HRLI F,440700 SOS T,MASAPP MOVE T,1(T) HLRE T1,T HRLI T,440700 IFST1: PUSHJ P,GETPCH ;GET PAIR OF CHARS IN (A) AND (C) JUMPG X2,IFST3 ;HAVE BOTH STRINGS ENDED? JUMPE X2,IFST2 ;HAS ONE STRING ENDED? CAMN C,A ;ARE THESE TWO CHARS THE SAME? JRST IFST1 ;YES. LOOK AT NEXT PAIR IFST2: SETOI X2, ;CHECK BOTH STRINGS FOR TRAILING BLANKS IFLAB1: CAIN C," " ;IS THIS CHAR A BLANK? PUSHJ P,IFST4 ;YES, GO CHECK STRING PUSHJ P,EXCH6 ;LOOK AT OTHER STRING AOJLE X2,IFLAB1 IFST3: HLLZ X1,@(P) ;GET RELATION AOS (P) IOR X1,[Z A,C] ;SETUP COMPARE XCT X1 POPJ P, ;RETURN AND "GOTO" JRST CPOPJ1 ;RETURN AND STAY IN LINE IFST4: JUMPN G,IFLAB2 ;IS BLANK REALLY A TRAILING BLANK? SETO C, POPJ P, IFLAB2: ILDB C,F AOJ G, CAIN C," " ;IS NEXT CHAR A BLANK? JRST IFST4 ;YES KEEP LOOKING IFST5: MOVEI C," " ;NO. USE BLANK FOR COMPARE POPJ P, ;ROUTINE TO GET A PAIR OF CHARS GETPCH: SETOI X2, ;COUNT TERMINATED STRINGS IN X2 PUSHJ P,GETCH PUSHJ P,EXCH6 ;LOOK AT OTHER STRING PUSHJ P,GETCH EXCH6: EXCH T,F ;MOVE OTHER STRING INFO TO (C),(F),(G) EXCH T1,G EXCH A,C POPJ P, GETCH: JUMPE G,GCLAB1 ILDB C,F AOJA G,CPOPJ GCLAB1: SETO C, AOJA X2,CPOPJ ;PRSTRR PRINTS A STRING WHOSE POINTER IS ADDRESSED IN (40) PRSTRR: PUSHJ P,TABBR PUSHJ P,FIRCHK MOVEI X1,0 PUSHJ P,CHROOM PUSHJ P,NUMINS SKIPE QUOTBL(LP) ;QUOTE MODE? JRST PRSTDS ;YES. PUSH P,G ;SAVE G (FOR MAT READ AND PRINT) SETZM VIRWRD ;FETCH A VIRTUAL STRING (MAYBE) PUSHJ P,SPVIRS ;SEE IF VIRTUAL STRING JRST PRST1 ;IT WAS. F HAS RIGHT POINTER PUSHJ P,GETSTR ;SETUP STRING FETCH JUMPLE G,PRST1 MOVE N,(X1) PUSHJ P,STRETT HLRE G,N HRR F,N HRLI F,440700 PRST1: JUMPE G,PRST2 SETZM ZONFLG(LP) PRST3: ILDB C,F PUSHJ P,OUCH0 ;PRINT CHAR AOJL G,PRST3 PRST2: POP P,G JRST FINPNT PRSTDS: SETZM VIRWRD ;FETCH A VIRTUAL STRING (MAYBE) PUSHJ P,SPVIRS ;SEE IF VIRTUAL STRING JRST PRST4 ;IT WAS. F HAS RIGHT POINTER PUSHJ P,GETSTR ;QUOTE MODE JUMPLE G,PRST4 MOVE N,(X1) PUSHJ P,STRETT HLRE G,N HRR F,N HRLI F,440700 PRST4: MOVMS G,G PUSH P,F PUSH P,G JRST PRTXD1 PRTXD8: MOVEI C," " ;OUTPUT A DELIMITER. PUSHJ P,OUCH PUSHJ P,PRTXD4 JUMPE G,PRTXD3 PRTXD5: ILDB C,F PUSHJ P,OUCH SOJG G,PRTXD5 PRTXD3: PUSHJ P,PRTXD4 JRST FINPNT PRTXD4: SKIPN QUOFLG ;OUTPUT A QUOTE? POPJ P, ;NO. MOVEI C,42 ;YES. JRST OUCH PRTXD1: SETZM QUOFLG ;QUOFLG NE 0 SAYS MUST SETZM ZONFLG(LP) PRTXD9: MOVE X1,MARGIN(LP) ;WRITE THIS STRING WITH QUOTES. SUBI X1,1 SUB X1,HPOS(LP) JUMPG X1,PXLAB1 PUSHJ P,PCRLF JRST PRTXD9 PXLAB1: SETO X2, JUMPE G,PRTXD2 PRTXD7: SOJGE G,PXLAB2 ;SEE IF FINISHED JRST PRTXD0 ;YES, RETURN PXLAB2: ILDB C,F CAIN C,42 JRST PTXER1 HLL C,CTTAB(C) TRNE C,100 HRL C,CTTAB-100(C) TLNE C,F.CR ;IF STR CONTAINS SPACE, TAB, JRST PTXER1 ;OR COMMA, IT MUST BE WRITTEN WITH QUOTES. TLNN C,F.SPTB+F.COMA JRST PRTXD6 SKIPN QUOFLG PRTXD2: SUBI X1,2 ;ONCE ONLY, SUBTRACT THE 2 SPACES SETOM QUOFLG ;THE QUOTES TAKE UP. PRTXD6: SOJGE X1,PRTXD7 JUMPE X2,PTXER2 ;STRING IS TOO LONG FOR LINE. MOVE D,MARGIN(LP) SUB D,HPOS(LP) SUB D,X1 PUSHJ P,PCRLF ADD D,HPOS(LP) CAML D,MARGIN (LP) JRST PTXER2 MOVE X1,MARGIN(LP) SUB X1,D SETZ X2, JRST PRTXD7 PRTXD0: POP P,G POP P,F JRST PRTXD8 ;ROUTINE TO PUT ADDRESS OF POINTER IN REG PNTADR: HRRZ X1,40 ;GET UUO ADDRESS MOVE X2,(X1) JUMPGE X2,CPOPJ ;ALL DONE IF THIS IS 0 OR AN APP BLK. TLNN X2,377777 ;ALL DONE IF THIS IS NEGATIVE COUNT MOVEI X1,(X2) POPJ P, ;STRRET IS A UTILITY ROUTINE WHICH RETRIEVES A STRING FROM ;AN APPEND BLOCK AND CREATES THE ACTUAL STRING EITHER IN THE ;TEMPORARY STRING AREA OR IN THE REAL STRING AREA, DEPENDING ON ;WHICH OF THE ENTRY POINTS STRETT AND STRETR IS USED. STRRET EXPECTS ;THE APPEND KEY IN AC N. IT RETURNS THE ANSWER KEY IN AC N. IT ;DESTROYS NO AC'S EXCEPT T. STRETT: SETOM REATMP ;STORE IN TEMP SPACE. JRST SRLAB1 STRETR: SETZM REATMP ;STORE IN REAL SPACE. SRLAB1: PUSH P,X1 PUSH P,X2 PUSH P,T1 PUSH P,C PUSH P,E ; Delete [3] MOVE X1,N ;SAVE APP KEY. PUSHJ P,MASTST ;[3] CHECK FOR SPACE AOS X1,MASAPP ;[3] AND PROTECT THE KEY MOVEM N,(X1) ;[3] ON THE MASTER APP. LIST PUSHJ P,LENAPB MOVE T,N ;LENGTH TO T FOR CORE MANAGER. SKIPN REATMP JRST SRLAB2 PUSHJ P,VCHTSC ;GET SPACE FOR THE STRING. JRST SRLAB3 ;LOWER BOUND IS RETURNED IN T. SRLAB2: PUSHJ P,VCHCKC SRLAB3: MOVN N,N HRLZ N,N HRRI N,(T) ;ALMOST ANSWER KEY. MOVE X1,(X1) ;[3] GET BACK THE KEY SOS MASAPP ;[3] ADJUST MASTER APP. LIST HLRZ E,X1 HRLI T,440700 ;DESTINATION POINTER. HRRZI X1,(X1) STRET1: HRR X2,1(X1) HRLI X2,440700 ;ORIGINAL POINTER. HLRE T1,1(X1) ;LOOP COUNTER. JUMPE T1,STRET2 SRLAB4: ILDB C,X2 IDPB C,T AOJL T1,SRLAB4 STRET2: AOJ X1, SOJG E,STRET1 POP P,E POP P,C POP P,T1 POP P,X2 POP P,X1 POPJ P, ;EXIT. ;UTILITY ROUTINE TO HANDLE THE "+" OPERATOR FOR STRINGS. APPEND: MOVE T,MASAPP MOVE T,(T) MOVE X1,N PUSHJ P,CKVSTR ;CHECK IF VIRTUAL STRING PUSH P,X1 ;SAVE NEW N MOVE X1,T PUSHJ P,CKVSTR ;SEE IF T IS VIRTUAL STRING MOVE T,X1 POP P,N TLNN T,777777 JRST APPOU1 ;T IS NULL STR. TLNN N,777777 JRST APPOU2 ;N IS NULL STR. TLNE T,377777 JRST APPND1 MOVE T,(T) TLNN T,777777 JRST APPOU1 ;T IS NULL STR. APPND1: PUSH P,X1 TLNE N,377777 JRST APPND2 MOVE X1,N MOVE N,(X1) TLNN N,777777 JRST APPOU3 ;N IS NULL STR. APPND2: JUMPG T,APPND3 JUMPG N,APPND4 PUSHJ P,MASTST ;CHECK ENOUGH SPACE MOVE X1,MASAPP ;BOTH REAL. MOVEM N,1(X1) ;PROTECT THE KEYS. MOVEM T,(X1) AOS MASAPP PUSHJ P,VCHAPP ;GET AN APP BLK. MOVE N,(X1) ;SET UP THE BLK. MOVEM N,1(T) MOVE N,1(X1) MOVEM N,2(T) HRLI N,2 HLRZM N,(T) HRRI N,(T) ;KEY IN N. SOS MASAPP JRST APPOU0 ;EXIT. APPND3: PUSH P,X2 JUMPG N,APPND5 HLRZ X1,T ;T IS APP BLK, N IS REAL. CAIL X1,APBMAX-1 ;MAKE SURE NO OVERFLOW JRST APPERR ;THERE WAS HRRZ X2,T ADDI X1,1(X2) MOVEM N,(X1) ;STORE N. AOS (X2) HRL N,(X2) ;KEY IN N. HRRI N,(T) JRST APPOUT ;EXIT. APPND4: PUSH P,X2 ;T IS REAL, N IS APP BLK. HLRZ X1,N CAIL X1,APBMAX-1 ;MAKE SURE NO OVERFLOW JRST APPERR ;THERE WAS HRRZ X2,N ADDI X1,(X2) MOVEM T,(X2) ;STORE T IN ZEROTH LOC IN N. HLRZ T,N AOJ T, HRL N,T APPN41: MOVE X2,(X1) MOVEM X2,1(X1) SOJ X1, SOJG T,APPN41 HLRZM N,1(X1) JRST APPOUT ;EXIT. APPND5: HLRZ X1,T ;BOTH N AND T ARE APP BLKS. HRRZ X2,T ADDI X2,1(X1) HRRZ X1,N HRLI X2,1(X1) HLRZ X1,N ADDB X1,(T) ;UPDATE APP. BLK. CAIL X1,APBMAX-1 ;MAKE SURE NO OVERFLOW JRST APPERR ;THERE WAS HRLM X1,T ;AND POINTER T ADDI X1,(T) BLT X2,(X1) ;MOVE BLOCK MOVE N,T ;NEW POINTER TO KEY IN N APPOUT: POP P,X2 APPOU0: POP P,X1 APPOU1: SOS MASAPP POPJ P, APPOU3: POP P,X1 APPOU2: MOVE N,T SOS MASAPP POPJ P, MASTST: PUSH P,T MOVEI T,MASAPP+MASMAX-1 ;ANY MORE AND WE OVERFLOW CAMG T,MASAPP ;SAFE ? JRST APPERR ;NO POP P,T ;YES POPJ P, APPERR: INLERR(6,71,</ ? Out of static list space/>) JRST GOSR2 SUBTTL SUBSCRIPTED VARIABLE FETCH/STORE ROUTINES ;MATRIX ELEMENT FETCH/STORE UUO ROUTINES SAD1ER: MOVE D,[JRST SADEND] ;FETCH ADR OF ARRAY ELEMENT MOVE A,UUOH HLRZ B,1(A) TRZ B,100 CAIE B,(JUMP ) JRST AFT1ER+1 JRST AFT2ER+1 ASN1ER: MOVE D,[MOVNM N,(A)] ;NEGATIVE ARRAY STORE JRST ASLAB1 AST1ER: SKIPA D,[MOVEM N,(A)] ;POSITIVE ARRAY STORE AFT1ER: MOVSI D,A(MOVE N,) ;ARRAY FETCH ASLAB1: MOVEI A,0 ;PSEUDO LEFT HALF MOVE B,40 ;ARRAY ADDRESS HRRZ C,1(B) ;TRY RIGHT DIMENSION TRNN C,777776 ;ROW VECTOR? HLRZ C,1(B) ;NO, MUST BE COLUMN VECTOR JRST AFT2C ;FINISH UP WITH 2-DIM CODE ASN2ER: MOVE D,[MOVNM N,(A)] ;NEGATIVE ARRAY STORE JRST ASLAB2 AST2ER: SKIPA D,[MOVEM N,(A)] ;POSITIVE ARRAY STORE AFT2ER: MOVSI D,A(MOVE N,) ;ARRAY FETCH ASLAB2: MOVE B,40 ;ARRAY ADDRESS HLRZ C,1(B) ;LEFT DIMENSION PUSHJ P,SUBSCR ;GET AND FIX SUBSCRIPT IN E HRRZ A,1(B) IMUL A,E ;LEFT SCRIPT TIMES RIGHT DIM! HRRZ C,1(B) ;RIGHT DIMENSION AFT2C: PUSHJ P,SUBSCR ;GET AND FIX SUBSCRIPT IN E ADD A,E ;ADD TO LEFT DIM HLRZ X1,0(B) TRZE X1,(1B0) ;VIRTUAL ARRAY? JRST VIRST ;YES.GO DO VIRTUAL STUFF ADD A,(B) ;ADD ARRAY ADDRS XCT D ;DO THE OPERATION POPJ P, ;RETURN VIRST: ADD X1,FLVIR ;X1 POINTS TO VIRTUAL ARRAY ROLL PUSH P,LP ;SAVE LP HRRZ LP,1(X1) ;CHANNEL # TO LP FOR R.A. HRRZ X2,ACTBL-1(LP) ;GET ACCESS CODE CAIE X2,-2 ;IS THIS FOR A VIRTUAL ARRAY? JRST FNMXER ;NO, GIVE ERROR TLNE D,40000 ;JRST IN D? JRST VIRGAR ;YES. MUST BE STRING (VIRTUAL) ADD A,0(X1) ;STARTING WORD + ARRAY ELEMENT MOVEM A,POINT-1(LP) ;MAKE LOOK LIKE RECORD # FOR R.A. TLNE D,2000 ;MOVEM OR MOVNM? JRST VIROUT ;YES. DO VIRTUAL OUTPUT VIRGIN: SETZM 40 ;SO RANUM WILL STORE RESULT IN N PUSHJ P,RANUM ;DO R.A. INPUT VIRGEX: POP P,LP ;RESTORE LP POPJ P, ;RETURN VIROUT: PUSH P,A ;SAVE A SETZ A, XCT D ;MOVE N TO N POP P,A ;RESTORE A PUSHJ P,RNNUMO ;DO R.A. OUTPUT JRST VIRGEX ;RESTORE LP AND RETURN VIRGAR: HRRZ N,UUOH ;VIRTUAL STRING SOJ N, HRLI N,440000 ;VIRTUAL STRING IF 440000 JRST VIRGEX ;RESTORE LP AND RETURN ;CHECK IF VIRTUAL STRING REFERENCE ;IF IS CHANGE POINTERS TO POINT TO DSTRING IN TEMP ARREA CKVSTR: PUSH P,X2 LDB X2,[POINT 6,X1,5] CAIE X2,44 ;SET TO 440000 IF VIRTUAL STRING REFERENCE JRST [SETZM VIRWRD ;CLEAR VIRTUAL STRING FLAG SETZM VIRSIZ ;VIRSIZ NOT 0 MEANS VIRTUAL ARRAY POP P,X2 POPJ P, ] PUSH P,N PUSH P,LP PUSH P,T ;SAVE T PUSH P,C ;SAVE C HLRZ X2,2(X1) ;CHECK FOR JUMP T1, FOR 2 DIM TRZ X2,100 CAIE X2,(JUMP ) ;2 DIM VIRTUAL STRING ARRAY? JRST SUBVR1 ;NO, DO ONE DIM MOVE B,(X1) ;POINT TO SVRROL HLRZ C,1(B) ;GET FIRST DIMENSION MOVE E,1(X1) ;GET FIRST SUBSCRIPT PUSHJ P,SUBVIR ;CONVERT TO INTEGER AND CHECK HRRZ X2,1(B) ;GET SECOND DIMENSION IMUL X2,E ;TRANSLATE HRRZ C,1(B) ;GET SECOND SUBSCRIPT MOVE E,2(X1) ;GET ADDRESS OF SUBSCRIPT JRST SUBVR2 ;CARRY ON AS 1 DIM SUBVR1: MOVEI X2,0 ;BAS IS ZERO FOR ONE DIM MOVE B,(X1) ;PUT TO SVRROL HRRZ C,1(B) ;COLUMN VECTOR? TRNN C,777776 ;IS IT 1? HLRZ C,1(B) ;YES, ROW VECTOR MOVE E,1(X1) ;ADDRESS OF SUBSCRIPT SUBVR2: PUSHJ P,SUBVIR ;CONVERT TO INTEGER AND CHECK LIMIT ADD X2,E ;ADD IN SUBSCRIPT MOVE A,0(X1) HLRZ X1,0(A) TRZ X1,400000 ADD X1,FLVIR ;POINTS TO VIRTUAL ROLL ENTRY HRRZ LP,1(X1) ;CHANNEL # TO LP HLRZ A,1(X1) ;GET SIZE TO A MOVEM A,VIRSIZ ;PUTSTR MIGHT NEED IMUL A,X2 ;ELEMENT # TIMES SIZE HLRZ X2,0(X1) ;GET BYTE # ADD A,X2 ;POINTS TO BYTE IN ARRAY IDIVI A,^D512 HRRZ X2,0(X1) ;GET BLOCK # OF START SOJ X2, ADD X2,A ;+ REL BLOCK # IN ARRAY PUSH P,B ;SAVE REMAINDER LSH X2,7 ;TIMES 128 TO LOOK LIKE R.A. POINTER AOJ X2, ; MOVEM X2,POINT-1(LP) ;SET UP R.A. RECORD # PUSH P,X1 ;SAVE X1 SKIPE VIRWRD ;WRITING? JRST [PUSHJ P,RNNUMO ;YES JRST CKVIR2] SETZM 40 ;SO INPUT WILL ONLY CLOBBER N PUSHJ P,RANUM ;DO R.A. INPUT CKVIR2: POP P,X1 ;GET X1 BACK SKIPE VIRWRD ;WRITING? JRST CKVIR5 ;YES HLRZ T,1(X1) ;GET SIZE OF STRING PUSH P,X1 ;SAVE X1 SKIPN VRFBOT ;CORE SET? PUSHJ P,SETCOR ;NO, DO IT PUSHJ P,VCHTSC ;GET THAT MANY BYTES FROM TEMP POP P,X1 ;RESTORE X1 HRLI T,440700 ;7 BIT BYTE POINTER TO T HLRZ X2,1(X1) ;SIZE TO X2 CKVIR5: POP P,B ;GET BACK REMAINDER HLRZ A,BA-1(LP) ;GET BUFFER ADDRES FOR THIS CHANNEL ADDI A,4 ;STRING BUFFER STARTS IN 3RD WORD ADDI B,4 ;ADD 4 TO REMAINDER IDIVI B,5 ;5 BYTES PER WORD ADD A,B ;A NOW POINTS TO RIGHT WORD HRLI A,440700 ;MAKE BYTE POINTER CKVIR3: JUMPE C,CKVIR4 ;RIGHT POSITION? IBP A ;NO. GO TO NEXT BYTE SOJA C,CKVIR3 ;LOOP TILL GET TO RIGHT BYTE CKVIR4: SKIPE VIRWRD ;WRITING? JRST [MOVEM A,VIRWRD ;YES SETUP VIRWR WITH POINTER JRST CKVEXT] PUSH P,T ;SAVE POINTER SETZ X1, ;ZERO TO COUNT OF NON NULL BYTES CKVIR7: JUMPE X2,CKVIR6 ;X2 HAS SIZE ORIGINALLY ILDB C,A IDPB C,T JUMPE C,CKVIR9 ;NULL BYTE? IGNORE IF YES AOJ X1, ;+1 TO BYTE COUNT CKVIR9: SOJA X2,CKVIR7 ;DO WHOLE STRING CKVIR6: POP P,T ;GET BACK POINTER TO TEMP MOVE X2,X1 ;GET + SIZ OF STRING JUMPE X2,CKVIR8 ;NULL STRING? MOVN X2,X2 ;MAKE NEGATIVE CKVIR8: HRL T,X2 ;NEG COUNT TO T MOVE X1,T ;REGULAR POINTER IN X1 CKVEXT: POP P,C ;RESTORE C POP P,T ;RESTORE T POP P,LP POP P,N POP P,X2 POPJ P, SPVIRS: MOVE X1,40 ;PICK UP UUO MOVE X1,0(X1) ;PICK UP WHAT UUO POINTS TO PUSH P,40 PUSHJ P,CKVSTR ;CHECK IF VIRTUAL STRING POP P,40 SKIPN VIRSIZ ;WAS IT ? JRST CPOPJ1 ;NO MOVN G,VIRSIZ ;NEG. STRING SIZE TO G MOVE F,X1 ;POINTER TO F SKIPE VIRWRD ;WRITING INTO VIRT. STRING? JRST VIRPT ;YES HRLI F,440700 ;JUST READING SO ADDRES POINTS TO TEMP POPJ P, VIRPT: MOVE X2,VIRWRD ;POINTER TO X2 SETZ X1, ;NULL CHAR. VIRPT2: JUMPE G,VIRPT1 ;FINISHED? IDPB X1,X2 ;NO. KEEP FILLING WITH NULLS AOJA G,VIRPT2 ;DO G TIMES VIRPT1: MOVN G,VIRSIZ ;SETUP G WITH NEG. COUNT MOVE F,VIRWRD ;SETUP F WITH BYTE POINTER POPJ P, SADEND: HRRZI N,(A) ;PUT STRING VECTOR POINTER ADDRESS IN N TLO N,(1B0) ;MAKE IT LOOK LIKE AN ADDRESS, NOT A POINTER POPJ P, ;ROUTINE TO FETCH AND CHECK SUBSCRIPT ;CALL: MOVE C,DIMENSION ; PUSHJ P,SUBSCR SUBSCR: MOVE E,@-1(P) ;GET SUBSCRIPT AOS -1(P) ;SKIP ARGUMENT SUBVIR: PUSHJ P,SUBCHK ;CHECK TYPE OF SUBSCRIPT CAMGE E,C ;CHECK DIMENSION POPJ P, ;DIMENSION ERR ROUTINE DIMERR: INLERR(84,42,</ ? DIMENSION error/>) JRST GOSR2 SUBCHK: TLNN E,100 ;IS SUBSCRIPT REAL? JRST SUBINT ;NO, JUST PICK IT UP MOVE E,(E) ;GET THE VALUE JUMPL E,DIMERR ;<0 IS AN ERROR FAD E,FIXCON ;FIX IT TLZ E,777400 ; POPJ P, ;AND RETURN SUBINT: MOVE E,(E) ;GET THE VALUE JUMPL E,DIMERR ;<0 IS AN ERROR POPJ P, ;AND RETURN SUBTTL MATRIX OPERATION RUN-TIME ROUTINES ;SET MATRIX DIMENSION -- SDIM UUO SDIMER: MOVSI C,1 ;DONT FAIL IN SUBSCR PUSHJ P,SUBSCR ;FIRST DIM HRLZ A,E ;SAVE IT PUSHJ P,SUBSCR ;SECOND DIM HRR A,E AOBJP A,MS0CHK ;GO CHECK DIMS AND STORE THEM ;MATRIX OPERATION SETUP ROUTINE ;USE ENTRY POINT MS2 IF 2 ARGS, MS1 IF 1 ARG, MS0 OR MS0CHK IF 0 ARGS. ;ALL ENTRIES EXPECT MS0 EXCEPT DIMENSION [XWD ROWS,COLS] ; OF DESTINATION TO BE SET UP IN A AND CHECK FOR ROOM ; AND SET DIMENSION OF DESTINATION. ;AT CALL, LOCATION 40 CONTAINS THE ADDRS OF DESTINATION DOPE VECTOR, ; RIGHT SIDE OF T1 CONTAINS ADDRS OF DOPE VECTOR FOR ARG 1 ; RIGHT SIDE OF T CONTAINS ADDRS OF DOPE VECTOR FOR ARG 2 ;RIGHT SIDES OF T1,T,B ARE REPLACED WITH ADDRESSES OF ELEMENTS 0,0 ; OF ARG 1, ARG 2, DEST, RESPECTIVELY, WITHOUT CHANGING LEFT SIDES, ; AND THE RESULTS ARE STORED IN TEMP1, TEMP2, AND TEMP3, RESPECTIVELY. ;THE MAXIMUM ROW NUMBER OF DEST IS STORED IN SB1M1, THE MAXIMUM ; COLUMN NUMBER OF DEST IS STORED IN SB2M1 ;E, T1, AND G ARE SET TO FIRST ROW NUMBER, FIRST COL NUMBER, ; AND RELATIVE LOCATION OF FIRST ELEMENT, RESPECTIVELY ;IT IS INTENDED THAT E, T1, G, TEMP1, TEMP2, TEMP3 BE SET UP FOR ; IMMEDIATE CALL TO MLP, AND THAT ELEMENTS OF FIRST ; ARGUMENT, SECOND ARGUMENT, AND DESTINATION BE ACCESSED ; BY INDIRECT ADDRESSING THROUGH TEMP1, TEMP2, AND TEMP3, RESPECTIVELY. MS2: HRR T,(T) ;ADDRS OF FIRST ARG MS1: HRR T1,(T1) ;ADDRS OF SECOND OR ONLY ARG MS0CHK: HRR B,40 ;DOPE VECTOR OF DEST HLLZ X1,A ;CHECK NEW DIMENSION IMULI X1,(A) ;X1 := (TOTAL SIZE)0 CAMLE X1,0(B) ;IS THERE ROOM IN ARRAY? JRST DIMERR ;NO. DIMENSION ERROR MOVEM A,1(B) ;STORE NEW DIMENSION MS0: HRR B,40 ;ENTER HERE FOR NO DIM CHECK MOVE A,1(B) ;FETCH DIMENSIONS SUB A,[XWD 1,1] ;E := (MAX ROW)MAX COL HLRZM A,SB1M1 ;FIRST DIMENSION -1 HRRZM A,SB2M1 ;SECOND DIMENSION -1 HRR B,(B) ;ADDRS OF DEST (LEAVE IN B FOR MINV) MOVEM T1,TEMP1 ;STORE FIRST XCT INSTRUCTION MOVEM T,TEMP2 ;STORE SECOND XCT INSTRUCTION MOVEM B,TEMP3 ;STORE THIRD XCT INSTRUCTION ;NOW SETUP E, T1, AND G FOR "MLP" SKIPE E,SB1M1 ;MORE THAN 0'TH ROW? MOVEI E,1 ;YES. USE FIRST SKIPE T1,SB2M1 ;MORE THAN 0'TH COL MOVEI T1,1 ;YES. USE FIRST MOVE G,SB2M1 ;CALCULATE FIRST ELT OF RESLT ADDI G,1 IMULI G,(E) ADDI G,(T1) POPJ P, ;MATRIX OPERATION MAIN LOOP ;ON CALLING, T, T1, G ARE SET UP TO ROW NUMBER, COL NUMBER, AND ; REL LOC OF CURRENT ELEMENT IN DESTINATION MATRIX. ;MLP EXECUTES THE CONTENT OF TEMP1, TEMP2, TEMP3 FOR EACH ; ELEMENT OF CURRENT ROE. AT END OF ROW, MLP RETURNS ; WITHOUT SKIP TO ALLOW ONCE-PER-ROW OPERATIONS TO BE PERFORMED. ; WHEN ALL ROWS HAVE BEEN PROCESSED, MLP RETURNS WITH SKIP. ;NOTE SPECIAL CODING SO THAT ROW AND COLUMN VECTORS ARE ; HANDLED CORRECTLY. MLP: XCT TEMP1 XCT TEMP2 XCT TEMP3 SKIPN INVFLG JRST MLP2 PUSH P,G MOVM G,A CAMLE G,INVLRG MOVEM G,INVLRG POP P,G MLP2: ADDI G,1 CAMGE T1,SB2M1 AOJA T1,MLP SKIPE SB2M1 ;MORE THAN A 0'TH COL? AOJA G,MLLAB1 ;YES. SKIP 0'TH COL TDZA T1,T1 ;NO. SET TO USE 0'TH COL MLLAB1: MOVEI T1,1 ;YES AGAIN. SET TO USE COL 1. CAML E,SB1M1 ;ALL ROWS USED? AOS (P) ;YES. SET FOR SKIP RETURN AOJA E,CPOPJ ;BUMP ROW AND RETURN ;MATRIX READ ROUTINE ;SET UP AND CALL MLP. FOR EACH ELEMENT, THE FOLLOWING ;ARE PERFORMED: ; TEMP1: PUSHJ P,MTRELT ; TEMP2: ... ;(SKIPPED) ; TEMP3: MOVEM N,<DEST>(G) ;MTRELT READS A NUMBER INTO N MTRDER: SETZM IFIFG SETZM FTYPE ;ASSUME REAL MATRIX MOVE X1,40 ;CHECK TYPE BIT TLNE X1,400 ;IS IT INTEGER? SETOM FTYPE ;YES, MARK FOR READ MOVE T1,[PUSHJ P,MTRELT] PUSHJ P,DOREAD HRRZ X1,@40 ;GET ADRESS OF ZEROTH ELEMENT CAML X1,SVRBOT ;IS THIS A STRING VECTOR? JRST MTRDS ;ELEMENTS WILL BE STRINGS. HRLI B,G(MOVEM N,) MTRD1: PUSHJ P,MS0 ;SET UP FOR LOOP SETZM 40 ;NOP THE STORE THAT DATAER USES MTRD2: PUSHJ P,MLP ;EXECUTE LOOP JRST MTRD2 ;NO ACTION ON ROW POPJ P, ;ROUTINE CALLED BY MTRDER TO PRINT AN ELEMENT MTRELT: PUSHJ P,DATAER JRST CPOPJ1 ;SKIP SECOND XCT MTRDS: MOVSI T1,(SKIPA) MOVSI B,G(STRIN) JRST MTRD1 ;MATRIX PRINT ROUTINE ;SET UP AND CALL MLP: ; TEMP1: PUSH P,T ; TEMP2: PRNM <FORMAT CODE>,<DEST>(G) ; TEMP3: POP P,T MTPRER: MOVE T1,[PUSH P,T1] ;TO SAVE T1 AROUND PRNM PUSHJ P,MS0 ;SET UP FOR LOOP HLL B,40 ;PICK UP UUO AC FIELD TLZ B,777000 ;CONSTRUCT PRNM INSTR SKIPN SB2M1 ;COLUMN VECTOR? JRST MPLAB1 ;YES. ALLOW <CR> FORMAT TLNN B,(Z 16,) ;OH, NO. TREAT <RET> FORMAT ==<COMA> FORMAT. HRLI B,(Z 3,) MPLAB1: HRRZ X1,@40 CAMGE X1,SVRBOT ;NUMBER ARRAY? TLO B,G(PRNM) ;YES, SETUP NUMBER UUO CAML X1,SVRBOT ;STRING ARRAY? TLO B,G(PRSTR) ;YSE SEUP STRING PRINT UUO.$ MOVEM B,TEMP2 ;SET UP TEMP2 AND TEMP3 MOVE X1,[POP P,T1] MOVEM X1,TEMP3 SETZM ODF SETZB LP,HPOS SETZM TABVAL SETZM FMTPNT MTP2D: PUSHJ P,MTP3D ;TWO BLANK LINES MTP1D: SKIPE SB2M1 ;FOR THE SPECIAL CASE OF A COLUMN JRST MTP5D ;VECTOR IN COMMA OR SEMICOLON MOVE LP,TEMP2 TLNN LP,(Z 16,) ;FORMAT, DON'T ZERO THE FLAGS JRST MTP5D ;BECAUSE WE ARE IN THE MIDDLE OF THE ROW. SETZ LP, JRST MTP4D MTP5D: SETZB LP,HPOS SETZM TABVAL SETZM FMTPNT MTP4D: PUSHJ P,MLP ;PRINT A ROW JRST MTPRE1 ;NOW SEE WHETHER TO SPACE BETW ROWS MTP3D: PUSHJ P,INLMES ASCIZ / / OUTPUT SETZM HPOS SETZM TABVAL SETZM FMTPNT POPJ P, MTPRE1: SKIPE SB1M1 ;VECTOR OR ARRAY? SKIPN SB2M1 JRST MTP1D ;ARRAY... SPACE BETW ROWS JRST MTP2D ;VECTOR...DONT SPACE BETW ROWS ;MATRIX ADD AND SUBTRACT ROUTINES ;SET UP AND CALL MLP: ; TEMP1: MOVE N,<ARG 2>(G) ;OR MOVN ; TEMP2: FADR N,<ARG 1>(G) ; TEMP3: MOVEM N,<DEST>(G) MTADER: TLOA T1,G(MOVE N,) ;MAKE ADD INSTR (T LOADED WITH MOVEI) MTSBER: HRLI T1,G(MOVN N,) ;MAKE SUBTRACT INSTR HRLI T,G(FADR N,) ;FETCH MOVE X1,40 ;CHECK THE TYPE TLNE X1,400 ;IS IT INTEGER HRLI T,G(ADD N,) ;YES, MAKE INTEGER ADD HRLI B,G(MOVEM N,) MOVE A,1(T) ;GET AND CHECK DIMENSIONS OF ARGS CAME A,1(T1) JRST DIMERR PUSHJ P,MS2 ;SET UP MATRIX LOOP JRST MTRD2 ;FINISH -- NO EACH ROW RTN ;MATRIX SCALE ROUTINE ;SET UP AND CALL MLP: ; TEMP1: MOVE A,<ARG 1>(G) ; TEMP2: FMPR A,N ; TEMP3: MOVEM A,<DEST>(G) MTSCER: HRLI T1,G(MOVE A,) MOVSI T,(FMPR A,N) MOVE X1,40 ;CHECK THE TYPE TLNE X1,400 ;IS IT INTEGER? MOVSI T,(IMUL A,N) ;YES, MAKE INTEGER MULTIPLY MTSC1: HRLI B,G(MOVEM A,) MOVE A,1(T1) PUSHJ P,MS1 JRST MTRD2 ;MATRIX ZERO, IDENTITY, AND ONE ROUTINES ;SET UP AND CALL MLP: ; ..IDEN.. ..ZERO.. ..ONE.. ; TEMP1: SETZM@TEMP3 SETZM @TEMP3 CAIA ; TEMP2: CAMN T,T1 CAIA ... ; TEMP3: MOVEM A,<DEST>(G)...................... MTIDER: SKIPA T,[CAMN E,T1] MTZRER: MOVSI T,(CAIA) SKIPA T1,[SETZM @TEMP3] MTCNER: MOVSI T1,(CAIA) MTCN1: HRLI B,G(MOVEM D,) MOVSI D,(DEC 1.0) ;CONSTANT 1.0 TO STORE MOVE X1,40 ;CHECK THE TYPE TLNE X1,400 ;IS IT INTEGER? MOVEI D,1 ;USE INTEGER CONSTANT 1 JRST MTRD1 ;GO FINISH WITH READ CODE ;MATRIX TRANSPOSE ROUTINE ;SET UP AND CALL MLP: ;A CONTAINS RELATIVE LOC OF CURRENT ELE IN SOURCE ; TEMP1 : FETCH SOURCE ELEMENT ; TEMP2 : UPDATE SOURCE INDEX ; TEMP3 : STORE DESTINATION ELEMENT MTTNER: MOVS A,1(T1) ;FETCH DESTINATION DIMENSION HRLI T1,A(MOVE N,) HLRZ T,A ;E := ADDI A,<NBR ROWS> HRLI T,(ADDI A,) HRLI B,G(MOVEM N,) PUSHJ P,MS1 ;SET UP AND CHK DIMENSION MTTN1: MOVE A,SB1M1 ;A := <NBR ROWS>*COL + ROW ADDI A,1 IMUL A,T1 ADD A,E PUSHJ P,MLP ;MOVE A ROW JRST MTTN1 POPJ P, ;MATRIX MULTIPLY ROUTINE ;SET UP AND CALL MLP ;FOR EACH ELEMENT OF DESTINATION MATRIX, CALL SUBROUTINE ; MYELT TO FORM THE DOT PRODUCT OF THE APPROPRIATE ROW AND COLUMN MTMYER: CLEARM FTYPE ;ASSUME FLOATING MATRIX MOVE X1,40 ;CHECK THE TYPE TLNE X1,400 ;IS IT INTEGER? SETOM FTYPE ;YES, MARK IT MOVE A,1(T) ;CHECK DIMENSIONS HLRZ D,1(T1) ;D := INNER DIMENSION CAIE D,(A) ;SAME AS FIRST ARG? JRST DIMERR ;NO HRR A,1(T1) HRLI T1,T1(MOVEI X2,) ;TO COMPUTE ADDRS OF 1ST ELT 2ND ARG HRLI T,(MOVEI X1,) ;DITTO 1ST ARG HRLI B,G(MOVEM N,) ;STORE INSTR PUSHJ P,MS2 ;SETUP NEW DIMENSIONS AND MLP ARGS MOVEI X1,1(A) ;PREPARE TO SKIP ROW ZERO IF.. CAIE D,1 ;INNER DIM=1? ADDM X1,TEMP1 MOVE B,[PUSHJ P,MYELT] ;CALL TO ELT COMPUTATION EXCH B,TEMP2 CAIE D,1 ;INNER DIM 1? (IE PROD OF VECTORS) ADDI B,1 ;NO. SKIP 0'TH COL OF 1'ST ARG JUMPE E,MTMY2 ;DONT SKIP FIRST ROW IF ONLY 1 MTMY1: ADDM D,B ;NEXT ROW OF FIRST ARG MTMY2: PUSHJ P,MLP JRST MTMY1 POPJ P, ;SUBROUTINE TO COMPUTE ELEMENT OF PRODUCT ;X1 CONTAINS ADDRS OF 1ST ELT OF 1ST ARG FOR DOT PRODUCT, ; AFTER FIRST XCT BELOW, X2 CONTAINS ADDRS OF SAME FOR 2ND ARG MYELT: XCT B MOVEI N,0 ;TO ACCUMULATE DOT PRODUCT MOVEI C,-1(D) ;NUMBER OF ADDS= REAL INNER DIMENSION MYEL1: PUSH P,R MOVE R,(X1) ;PRODUCT OF 2 ELTS SKIPGE FTYPE ;FLOATING MATRICES JRST MYEL2 ;NO, DO INTEGER STUFF FMPR R,(X2) FADR N,R ; JRST MYEL3 ; MYEL2: IMUL R,(X2) ; ADD N,R ; MYEL3: ADDI X2,1(A) ;NEXT ROW OF 2ND ARG POP P,R SOJLE C,CPOPJ ;DONE? AOJA X1,MYEL1 ;NO. TO NEXT ELT SUBTTL RUN-TIME MATRIX INVERTER ;SUBROUTINE TO CALL MATRIX INVERTER MTIVER: SETOM INVFLG SETZM INVLRG MOVS A,1(T1) ;MAKE SURE SQUARE MATRIX CAME A,1(T1) JRST DIMERR HRLI T1,G(SKIPA A,) ;MOVE DESTINATION PUSHJ P,MTSC1 ;(USE MTCNER CODE) SKIPE SB1M1 ;GO INVERT UNLESS ONLY ELT IS (0,0) JRST MINVB SUBI B,3 MOVEM B,TEMP3 ;ONLY ELEMENT IS (0,0) AOS SB1M1 ;FOOL MINV INTO THINKING ITS (1,1) JRST MINVB ;THIS PORTION OF THE MAT INVERSE PROG RUNS IN ACS 0-7 JLOOP: PHASE 0 ZERO: CAMN JX,NT ;SKIP SAME COL JRST JXIT MOVE IX,@TEMP1 ;A(I,J)=A(I,J)+A(NT,J)*A(I,NT) FMPR IX,(KX) ;*** MOD: FADRM IX,0(JX) ;ADDR MODIFIED BY OUTER LOOP JXIT: CAMGE JX,SB1M1 ;LOOP DONE? AOJA JX,ZERO JRST IXIT2 ;YES RETURN DEPHASE ;SOME AC DEFS FOR MINV NT=10 ;OUTERMOST LOOP INDEX IX=11 ;I SUBSCRIPT JX=12 ;J SUBSCRIPT KX=13 ;SCRATCH INDEX REG LX=14 ; " " " TAC1=16 ; " (MUST BE SAVE & RESTORED) ;MAIN ROUTINE ENTERS HERE TO SET UP REGS ;ROUTINE EXPECTS 1) ARRAY ADDR IN TEMP3 ; 2) ORDER OF ARRAY IN SB1M1 ;ROUTINE USES 1) VECT1 & VECT2 AS SCRATCH ; 2) SB2M1 AS CNT OF ELEMENTS / ROW MINVB: SETZM LIBFLG SETZM INVFLG HRRZS TEMP3 ;MAKE SURE ADDR ONLY PUSH P,TAC1 MOVE TAC1,SB1M1 ;GET ORDER ADDI TAC1,1 ;ADD ONE FOR 0'TH ROW & COL MOVEM TAC1,SB2M1 ;SAVE IN SB2 MOVSI TAC1,(1.0) ;INIT DETERM. MOVEM TAC1,DETER HRLZI TAC1,JX ;SET INDEX REG IN HLLZM TAC1,TEMP1 ;TEMP1 FOR INDIRECT MOVE TAC1,[XWD JLOOP,ZERO] BLT TAC1,7 ;PUT JLOOP INTO ACS MOVEI NT,1 ;INITIALIZE OUTER LOOP MINVLP: MOVE TAC1,NT IMUL TAC1,SB2M1 ;CALC (NT,NT) SUBSCR ADD TAC1,NT ADD TAC1,TEMP3 ;*** MOVEM TAC1,TEMP2 ;SAVE IT FOR LATER CAMN NT,SB1M1 ;LAST ITER? JRST FOUND1 ;SAVE SEARCH STUFF MOVM TAC1,(TAC1) ;GET A(NT,NT) MOVE IX,NT ;INITIALIZE SEARCH LUPI: MOVE KX,SB2M1 ;CALC I INDEX IMUL KX,IX ADD KX,TEMP3 ;*** MOVE JX,NT ;INIT J INDEX LUPJ: MOVE LX,KX ADD LX,JX ;FINISH INDEX FOR ELEMENT MOVM LX,(LX) ;GET IT CAMGE LX,TAC1 ;IS IT LARGER THAN PRESENT JRST LUPEND ;NO MOVE TAC1,LX ;YES SAVE IT MOVEM IX,VECT1(NT) ;AND INDEXES MOVEM JX,VECT2(NT) LUPEND: CAMGE JX,SB1M1 ;END OF J LOOP LOGIC AOJA JX,LUPJ CAMGE IX,SB1M1 AOJA IX,LUPI FOUND: CAMN NT,VECT1(NT) MOVNS DETER CAMN NT,VECT2(NT) MOVNS DETER PUSHJ P,FSWAP FOUND1: SKIPN INVLRG ;TEST FOR SINGULARITY. JRST SING FOUND2: MOVE TAC1,@TEMP2 ;GET PIVOT ELEMENT MOVEM TAC1,PIVOT ;SAVE IT FMPRB TAC1,DETER ;PERPETUATE DETERM JUMPE TAC1,SING MOVSI TAC1,(1.0) ;1./A(NT,NT) FDVRM TAC1,PIVOT ;*** MOVEI IX,1 ;SET UP I ILOOP: CAMN IX,NT ;SKIP SAME ROW JRST IXIT ;AS PIVOT ROW MOVE LX,SB2M1 ;CALCULATE ALL ROW OFFSETS IMUL LX,IX ADD LX,TEMP3 ;LX= IX*N+A MOVE KX,LX ADD KX,NT ;KX=LX+NT MOVN TAC1,PIVOT ;GET -PIVOT FMPRM TAC1,(KX) ;A(I,NT)=A(I,NT)/(-A(NT,NT)) MOVEI JX,1 ;SET J LOOP START MOVE TAC1,SB2M1 IMUL TAC1,NT ADD TAC1,TEMP3 ;TAC=NT*N+A HRRM TAC1,TEMP1 ;STORE FOR @TEMP1(JX) HRR MOD,LX ;SAT ADDR IN INNER LOOP PUSH P,IX JRST ZERO ;GO IXIT2: POP P,IX IXIT: CAMGE IX,SB1M1 ;RETURN HERE FROM ACS AOJA IX,ILOOP MOVEI JX,1 ;SET LOOP FOR LAST COL MOVE TAC1,PIVOT ;GET PIVOT LCOL: FMPRM TAC1,@TEMP1 ;A(NT,J)=A(NT,J)/A(NT,NT) CAMGE JX,SB1M1 ;DONE AOJA JX,LCOL MOVEM TAC1,@TEMP2 ;A(NT,NT)=PIVOT CAMGE NT,SB1M1 ;INVERSE DONE? AOJA NT,MINVLP ;NOPE, ITER AGAIN ;HERE WHEN INVERSE DONE PUT MATRIX BACK TOGETHER MOVE NT,SB1M1 ;DO LOOP IN REVERSE ORDER INVFIX: SOJLE NT,OUT ;FINISHED PUSHJ P,BSWAP ;SWAP ROW - COL IN REV. JRST INVFIX BSWAP: MOVE KX,VECT2(NT) MOVE LX,VECT1(NT) ;SET REGS JRST SWAP FSWAP: MOVE KX,VECT1(NT) MOVE LX,VECT2(NT) SWAP: MOVE TAC1,NT IMUL TAC1,SB2M1 IMUL KX,SB2M1 ;CALC BOTH ROW OFFSETS ADD TAC1,TEMP3 ADD KX,TEMP3 ;*** MOVEI JX,1 HRLI TAC1,JX HRLI KX,JX SWP1: MOVE IX,@TAC1 EXCH IX,@KX ;EXCHANGE ITEMS IN ROWS MOVEM IX,@TAC1 CAMGE JX,SB1M1 AOJA JX,SWP1 MOVEI IX,1 MOVE TAC1,NT MOVE KX,SB2M1 ADD KX,TEMP3 ;GET COL ADDR HRLI TAC1,KX HRLI LX,KX SWP2: MOVE JX,@LX EXCH JX,@TAC1 MOVEM JX,@LX CAML IX,SB1M1 ;CHECK DONE POPJ P, ;RETURN ADD KX,SB2M1 ;TO NEXT COL AOJA IX,SWP2 ;HERE TO RETURN OR MAKE SINGULAR SING: SETZB ZERO,DETER NFERR (56,0) PUSHJ P,INLMES ASCIZ / % Singular matrix inverted/ PUSHJ P,GOSR3 OUT: SKIPE LIBFLG JRST OUT2 OUT3: POP P,TAC1 POPJ P,0 OUT2: NFERR (95,0) PUSHJ P,INLMES ASCIZ / % Over or underflow occurred during MAT INV/ PUSHJ P,GOSR3 JRST OUT3 XLIST IFN BASTEK,< LIST SUBTTL PLOT FUNCTIONS OPDEF IMAGE [TTCALL 15,] EXTERN XORG,YORG,XABS,YABS,PLTTMP,PLTOUT,PLTIN EXTERN XMAX,YMAX EXTERN INCNT,INDSK,INPT,STADSK PAGPLT: MOVEI N,33 ;SETUP ESC CHARACTER PUSHJ P,PLTSAV ;OUTPUT IT IN IMAGE MOVEI N,14 ;SETUP FORM FEED PUSHJ P,PLTSAV ;OUTPUT IT IN IMAGE MOVEI N,1 ;SLEEP FOR PAGE SLEEP N, ;GOOD NIGHT POPJ P, ;RETURN INIPLT: SETZM XORG ;CLEAR X ORIGIN SETZM YORG ;CLEAR Y ORIGIN SETZM XABS ;CLEAR X ABSOLUTE SETZM YABS ;CLEAR Y ABSOLUTE POPJ P, ;RETURN STRPLT: MOVEI N,35 ;SETUP GRAPHICS MODE PUSHJ P,PLTSAV ;OUTPUT AS IMAGE MOVEI N,^D767 ;SET HIGH VALUE MOVEM N,YMAX ;FOR YMAX MOVEI N,^D1014 ;SET HIGH VALUE MOVEM N,XMAX ;FOR XMAX JRST LINPL1 ;MOVE TO (X,Y) ORGPLT: POP Q,X1 ;GET Y ORGIN ADDM X1,YORG ;SAVE IT POP Q,X1 ;GET X ORIGIN ADDM X1,XORG ;SAVE IT POPJ P, ;RETURN MOVPLT: OUTPUT ;OUTPUT ANYTHING IN TTY BUFFER MOVEI X1,5 ;ENQ FOR MOVING JRST FNDPNT ;FIND OUT WHERE WE ARE WHRPLT: PUSHJ P,MOVPLT ;MOVE WITHOUT OUTPUT PUSHJ P,RETPNT ; JRST 2(A) ;AND RETURN HOME CURPLT: OUTPUT ; MOVEI X1,32 ; PUSHJ P,FNDPNT ; MOVE N,PLTTMP ; MOVE X1,2(A) ;INTEGER OF FLOATING TLNE X1,100 ;FLOAT BIT SET FSC N,233 ; MOVEM N,@2(A) ; PUSHJ P,RETPNT ; JRST 3(A) ; LINPLT: MOVEI N,35 ;SETUP GRAPHICS MODE PUSHJ P,PLTSAV ;OUTPUT AS IMAGE MOVEI N,^D781 ;SET HIGH VALUE MOVEM N,YMAX ;FOR Y MOVEI N,^D1023 ;SET HIGH VALUE MOVEM N,XMAX ;FOR X POP Q,N ;GET UP-DOWN INDICATOR CAILE N,0 ;INVISIBLE LINE? PUSHJ P,LASTPT ;NO, MOVE TO LAST POINT LINPL1: POP Q,X1 ;Y-COORDINATE ADD X1,YORG ;ADD IN Y ORIGIN SKIPGE X1 ;TOO SMALL? SETZ X1, ;YES, MIN VALUE IS ZERO CAMLE X1,YMAX ;TOO BIG? MOVE X1,YMAX ;YES, MAKE LARGEST MOVMM X1,YABS ;SAVE IT POP Q,X1 ;X COORDINATE ADD X1,XORG ;ADD IN X ORIGIN SKIPGE X1 ;TOO SMALL? SETZ X1, ;YES, MIN VALUE IS ZERO CAMLE X1,XMAX ;WITHIN BOUNDS MOVE X1,XMAX ;NO, MAKE LARGEST MOVMM X1,XABS ;SAVE IT PUSHJ P,LASTPT ;OUTPUT IT MOVEI N,37 ;BACK TO ALPHA PUSHJ P,PLTSAV ;OUTPUT AS IMAGE POPJ P, ;RETURN LASTPT: MOVE X1,YABS ;Y COORDINATE IDIVI X1,^D32 ;MODULO 32 MOVE N,X1 ;PUT INTEGRAL PART IN N ADDI N,^D32 ;CONVERT TO TEK PUSHJ P,PLTSAV ;OUT IN IMAGE MOVE N,YABS ;Y COORDINATE ADDI N,140 ; IMULI X1,^D32 ; SUB N,X1 ; PUSHJ P,PLTSAV ;OUT IN IMAGE MOVE X1,XABS ;X COORDINATE IDIVI X1,^D32 ;MODULO 32 MOVE N,X1 ;INTEGRAL PART TO N ADDI N,^D32 ; PUSHJ P,PLTSAV ;OUTPUT IN IMAGE MOVE N,XABS ;X COORDINATE ADDI N,100 ;TEK SCALE IMULI X1,^D32 ; SUB N,X1 ; PUSHJ P,PLTSAV ;OUTPUT AS IMAGE POPJ P, ;RETURN FNDPNT: MOVEI N,33 ;ESC IMAGE N ;OUTPUT AS IMAGE IMAGE X1 ;OUTPUT CONTROL CHARACTER CLRBFI ;CLEAR INPUT BUFFER INCHWL PLTTMP ;INPUT AND WAIT SETZ X1, ;INIT COUNTER FNDPN1: INCHSL X2 ;INPUT AND SKIP IF NONE JRST FNDPN2 ; AOJ X1, ;UP ONE CAIG X1,4 ;ONLY WANT FOUR MOVEM X2,PLTTMP(X1) ;SAVE VALUE JRST FNDPN1 ;DO MORE FNDPN2: MOVE X1,PLTTMP+1 ;HIGH X MOVE N,PLTTMP+2 ;LOW X PUSHJ P,CLCPNT ;CALULATE X SUB X1,XORG ;PLUS X ORIGIN MOVEM X1,XABS ;SAVE IT PUSH Q,X1 ;PUSH FOR LINPLT MOVE X1,PLTTMP+3 ;HIGH Y MOVE N,PLTTMP+4 ;LOW Y PUSHJ P,CLCPNT ;CALCULATE Y SUB X1,YORG ;PLUS Y ORIGIN MOVEM X1,YABS ;SAVE IT PUSH Q,X1 ;PUSH FOR LINPLT SETZ X1, ;CLEAR X1 PUSH Q,X1 ; JRST LINPLT ;MOVE IT RETPNT: MOVE N,XABS ;X LOCATION SUB N,XORG ;LESS ORIGIN MOVE X1,0(A) ; TLNE X1,100 ; FSC N,233 ;FLOAT IT MOVEM N,@0(A) ;RETURN X VALUE MOVE N,YABS ;Y LOCATION SUB N,YORG ;LESS ORIGIN MOVE X1,1(A) ; TLNE X1,100 ; FSC N,233 ;FLOAT IT MOVEM N,@1(A) ;RETURN IT POPJ P, ;RETURN CLCPNT: SUBI X1,^D32 ; IMULI X1,^D32 ; ADD X1,N ; SUBI X1,^D32 ; POPJ P, ; PLTSAV: IMAGE N ;OUTPUT AS IMAGE SKIPN L,PLTOUT ;SAVING PLOT POPJ P, ;RETURN SETOM ODF ;SETUP FOR DISK OUTPUT MOVE C,N ;GET THE CHARACTER PUSHJ P,OUCH ;OUTPUT IT POPJ P, ;RETURN SAVPLT: CAME LP,PLTIN ;CHANNEL OPENED FOR INPUT PLOTTING JRST FNR ;TOO BAD SETOM IFIFG ;SETUP FOR DISK INPUT PUSHJ P,DOINPT ;DO INPUT SVPLT1: SOSGE @INCNT-1(LP) ;ROOM FOR CHARACTER JRST PLTFIL ;NO, FILLED BUFFER ILDB C,@INPT-1(LP) ;GET THE CHARACTER IMAGE C ;OUTPUT AS IMAGE CAIE C,33 ;POSSIBLE PAGE? JRST SVPLT1 ;NO, GO FOR NEXT SOSGE @INCNT-1(LP) ;ANOTHER CHARACTER READY JRST PLTFIL ;NO, FILL BUFFER ILDB C,@INPT-1(LP) ;GET A CHARACTER IMAGE C ;OUTPUT AS IMAGE CAIE C,14 ;LAST PART OF PAGE JRST SVPLT1 ;NO, GO FOR NEXT MOVEI C,1 ;SETUP FOR SLEEP SLEEP C, ;SLEEP FOR PAGE JRST SVPLT1 ;GO FOR NEXT PLTFIL: DPB LP,[POINT 4,INDSK,12] ;DISK INPUT XCT INDSK ; DPB LP,[POINT 4,STADSK,12] XCT STADSK POPJ P, DPB LP,[POINT 4,STODSK,12] XCT STODSK JRST SVPLT1 SETZM ACTBL-1(LP) INLEMS(1,70,INLSYS) JRST GOSR2 XLIST > LIST SUBTTL INTRINSIC FUNCTIONS (ADAPTED FROM LIB40) ;FLOATING POINT SINGLE PRECISION ARCTANGENT FUNCTION ;ATAN(X) = X(B0+A1(Z+B1-A2(Z+B2-A3(Z+B3)**-1)**-1)**-1) ;WHERE Z=X^2, IF 0.LT.X.LE.1 ;IF X.GT.1, THEN ATAN(X) = PI/2 - ATAN(1/X) ;IF X.GT.1, THEN RH(A) =-1, AND LH(A) = -SGN(X) ;IF X.LT.1, THEN RH(A) = 0, AND LH(A) = SGN(X) ATANB: ;ENTRY TO ARCTANGENT ROUTINE MOVM T, N ;GET ABSF OF ARGUMENT CAMG T, A1 ;IF A.LT.2^-33, THEN RETURN WITH... POPJ P, ;ATAN(X)=X HLLO B, N ;SAVE SIGN, SET RH(A) = -1 CAML T, A2 ;IF A.GT.2^33, THEN RETURN WITH JRST AT4 ;ATAN(X) = PI/2 MOVSI T1, (1.0) ;FORM 1.0 IN T1 CAMG T, T1 ;IS ABSF(X).GT.1.0? TRZA B, -1 ;IF T .LE. 1.0, THEN RH(A) = 0 FDVM T1, T ;B IS REPLACED BY 1.0/B TLC B, (B) ;XOR SIGN WITH .G. 1.0 INDICATOR MOVEM T, C3 ;SAVE THE ARGUMENT FMP T, T ;GET B^2 MOVE T1, KB3 ;PICK UP N CONSTANT FAD T1, T ;ADD B^2 MOVE N, KA3 ;ADD IN NEXT CONSTANT FDVM N, T1 ;FORM -A3/(B^2 + B3) FAD T1, T ;ADD B^2 TO PARTIAL SUM FAD T1, KB2 ;ADD B2 TO PARTIAL SUM MOVE N, KA2 ;PICK UP -A2 FDVM N, T1 ;DIVIDE PARTIAL SUM BY -A2 FAD T1, T ;ADD B^2 TO PARTIAL SUM FAD T1, KB1 ;ADD B1 TO PARTIAL SUM MOVE N, KA1 ;PICK UP A1 FDV N, T1 ;DIVIDE PARTIAL SUM BY A1 FAD N, KB0 ;ADD B0 FMP N, C3 ;MULTIPLY BY ORIGINAL ARGUMENT TRNE B, -1 ;CHECK .G. 1.0 INDICATOR FSB N, PIOT ;ATAN(N) = -(ATAN(1/A)-PI/2) JRST NEGANS ;SKIP AT4: MOVE N, PIOT ;GET PI/2 AS ANSWER NEGANS: SKIPGE B ;LH(A)= -SGN(T) IF B.GT.1.0 MOVNS N ;NEGATE ANSWER POPJ P, ;EXIT A1: 145000000000 ;2**-33 A2: 233000000000 ;2**33 KB0: 176545543401 ;0.1746554388 KB1: 203660615617 ;6.762139240 KB2: 202650373270 ;3.316335425 KB3: 201562663021 ;1.448631538 KA1: 202732621643 ;3.709256262 KA2: 574071125540 ;-7.106760045 KA3: 600360700773 ;-0.2647686202 PIOT: 201622077325 ;PI/2 ;FLOATING POINT TRUNCATION FUNCTION ;TRUNCATES FRACTIONAL PART OF FLOATING POINT NUMBER ;AND RETURNS ANSWER AS N FLOATING POINT NUMBER. THE ;ALGORITHM MAKES USE OF THE NORMALIZING PROPERTIES OF FAD. ;ROUTINE EXITS WITH (T)=ZERO IF NUMBER WAS AN INTEGER. INTB: MOVE B,N ;SAVE ARGUMENT MOVMS N ;GET ABSF(ARG) SKIPGE B ;NEGATIVE? FAD N,ALMST1 ;YES. MAKE AINT[-2.3]=-3 ETC. INTB1: CAML N,MOD1 ;IS ARGUMENT.LE.2**26? JRST INTB2 ;YES; IT MUST BE AN INTEGER ALREADY FAD N,MOD1 FSB N,MOD1 ;NOW FRACTIONAL PART HAS BEEN LOST INTB2: PUSHJ P,FIXPNT ;MAKE IT INTEGER INTEGER JRST NEGANS ;CHECK SIGN AND EXIT. MOD1: XWD 233400,000000 ; 2**26 ALMST1: XWD 200777,777777 ;1.0-<SMALLEST QUANTITY> ;FIX FUNCTION FIXPNT: MULI N,400 EXCH N,T JUMPGE T,FIXPT1 TRC T,-1 MOVNS N FIXPT1: ASH N,-243(T) SKIPGE T MOVNS N POPJ P, FLTPNT: HLRE T,N HLL N,T FSC N,233 SKIPGE N AOJE T,CPOPJ FSC T,255 FADR N,T POPJ P, ; ; ECHO FUNCTION ; GL.NEC==1B15 ;ECHO/NO ECHO BIT ECHOB: PUSH P,X1 ;SAVE X1 PUSH P,X2 ;SAVE X2 SETO X1, ;WANT LINE CHARACTERISTICS OF USER TTY GETLCH X1 ;ASK THE MONITOR MOVE X2,X1 ;SAVE TO RETURN OLD ECHO VALUE TLO X1,(GL.NEC) ;ASSUME NO ECHO SKIPN N ;IS THAT WHAT HE WANTS? TLZ X1,(GL.NEC) ;NO, TURN ON ECHO SETLCH X1 ;SET LINE CHARACTERISTICS CLEAR N, ;ASSUME ECHO WAS CURRENT SETTING TLNE X2,(GL.NEC) ;WAS ECHO OFF? MOVEI N,1 ;YES, RETURN 1 POP P,X2 ;RESTORE X2 POP P,X1 ;RESTORE X1 POPJ P, ;RETURN FROM ECHO ; ; FIX FUNCTION ; FIXB: MOVE B,N ;ARGUMENT MOVMS N ;ABS JRST INTB1 ;LET INTB HANDLE ;PI PIB: EXP 3.14159265 ;LINE # ERRB: MOVE N,ERR ;PICK UP ERROR # POPJ P, ;FLOAT IT ERLB: PUSH P,X1 ;SAVE X1 MOVE X1,ERL ;PICK UP LINE # OF ERROR (POINTER) JRST LINEB1 ;HANDLE LIKE LINEB LINEB: PUSH P,X1 ;SAVE X1 MOVE X1,SORCLN ;SOURCE CODE LINE LINEB1: SETZ N, ;IN CASE SAVFILNL SKIPN NOTLIN HRRZ N,0(X1) POP P,X1 ;RESTORE X1 POPJ P, ;PRINT HEAD POSITION POSB: SKIPL N ;MUST BE POSITIVE CAILE N,^D9 ;AND LESS THAN 9 JRST CNER1 ;IS WASN'T MOVE B,N MOVE N,HPOS(B) ;HEAD POSN JRST IFLOAT ;COMMON LOG FUNCTION (LOG TO THE BASE 10). CLOGB: JUMPE N,LZERO PUSHJ P,LOGB2 ;GET LOGE(N). FMPR N,[XWD 177674,557305] ;MULTIPLY BY LOG10(E). POPJ P, ;FLOATING POINT SINGLE PRECISION LOGARITHM FUNCTION ;LOG(ABSF(X)) IS CALCULATED BY THE SUBROUTINE, AND AN ;ARGUMENT OF ZERO IS RETURNED AS MINUS INFINITY. THE ALGORITHM IS ;LOGE(X) = (I + LOG2(F))*LOGE(2) ;WHERE X = (F/2)*2^(I+1), AND LOG2(F) IS GIVEN BY ;LOG2(F) = C1*Z + C3*Z^3 + C5*Z^5 - 1/2 ;AND Z = (F-SQRT(2))/(F+SQRT(2)) LOGB: JUMPE N, LZERO ;CHECK FOR ZERO ARGUMENT LOGB2: JUMPG N,LOGB3 JRST ALOGB1 ;SEND ERROR MESSAGE, GET ABS(ARG). LOGB3: CAMN N, ONE ;CHECK FOR 1.0 ARGUMENT JRST ZERANS ;IT IS 1.0 RETURN ZERO ANS. ASHC N, -33 ;SEPARATE FRACTION FROM EXPONENT ADDI N, 211000 ;FLOAT THE EXPONENT AND MULT. BY 2 MOVSM N, C3 ;NUMBER NOW IN CORRECT FL. FORMAT MOVSI N, 567377 ;SET UP -401.0 IN N FADM N, C3 ;SUBTRACT 401 FROM EXP.*2 ASH T, -10 ;SHIFT FRACTION FOR FLOATING TLC T, 200000 ;FLOAT THE FRACTION PART FAD T, L1 ;B = T-SQRT(2.0)/2.0 MOVE N, T ;PUT RESULTS IN N FAD N, L2 ;A = N+SQRT(2.0) FDV T, N ;B = B/A MOVEM T, LZ ;STORE NEW VARIABLE IN LZ FMP T, T ;CALCULATE Z^2 MOVE N, L3 ;PICK UP FIRST CONSTANT FMP N, T ;MULTIPLY BY Z^2 FAD N, L4 ;ADD IN NEXT CONSTANT FMP N, T ;MULTIPLY BY Z^2 FAD N, L5 ;ADD IN NEXT CONSTANT FMP N, LZ ;MULTIPLY BY Z FAD N, C3 ;ADD IN EXPONENT TO FORM LOG2(X) FMP N, L7 ;MULTIPLY TO FORM LOGE(X) POPJ P, ;EXIT LZERO: NFERR (53,0) PUSHJ P,INLMES ASCIZ / % LOG of zero/ PUSHJ P,GOSR3 ;PRINT LINE NUMBER. MOVE N, MIFI ;PICK UP MINUS INFINITY POPJ P, ;EXIT ;COMMON EXITS: ZERANS: SETZI N, ;MAKE ARG ZERO POPJ P, ;EXIT ;CONSTANTS FOR ALOGB ONE: 201400000000 L1: 577225754146 ;-0.707106781187 L2: 201552023632 ;1.414213562374 L3: 200462532521 ;0.5989786496 L4: 200754213604 ;0.9614706323 L5: 202561251002 ;2.8853912903 ALOGB1: PUSH P,N ;SAVE ARGUMENT NFERR (53,0) PUSHJ P,INLMES ASCIZ / % LOG of negative number/ PUSHJ P,GOSR3 ;PRINT LINE NUMBER POP P,N ;GET ARG MOVMS N,N JRST LOGB3 ;USE ABS VALUE. L7: 200542710300 ;0.69314718056 MIFI: XWD 400000,000001 ;GOAL POSTS. LARGEST NEGATIVE NUMBER. ; ; SLEEP FUNCTION ; HB.RWJ==1B15 ;ONLY THIS JOB CAN WAKE ITSELF HB.RTL==1B13 ;WAKE ON TTY LINE READY SLEEPB: OUTPUT ;DUMP TTY BUFFER PUSH P,X1 ;SAVE X1 SETO X1, ;SET UP CORRECT WAKE UP PRIVS. WAKE X1, ;WAKE ME UP JFCL ;DON'T CARE MOVSI X1,(HB.RWJ!HB.RTL) ;WAKE UP PRIVS. HIBER X1, ;HIBER TO SET JFCL ;DON'T CARE AGAIN POP P,X1 ;RESTORE X1 IMULI N,^D1000 ;CONVERT TO MSEC. HRLI N,(HB.RWJ!HB.RTL) ;SET WAKE UP CODES HIBER N, ;GOODNIGHT JFCL ;IGNORE HIBER NOT THERE SETO N, ;ASSUME WOKEN BY TTY INPUT LINE SKPINL ;IS THERE A LINE READY? CLEAR N, ;NO, WAKE UP BY TIMEOUT POPJ P, ;RETURN ;FLOATING POINT SINGLE PRECISION SINE AND COSINE FUNCTION ;THE ARGUMENT IS IN RADIANS. ;ENTRY POINTS ARE SIN AND COS. ;COS CALLS SIN TO CALCULATE SIN(PI/2 + X) ;THE ROUTINE CALCULATES SINES AFTER REDUCING THE ARGUMENT TO ;THE FIRST QUADRANT AND CHECKING THE OVERFLOW BITS TO DETERMINE ;THE QUADRANT OF THE ORIGINAL ARGUMENT ;000 - 1ST QUADRANT ;001 - 2ND QUADRANT, X=-(X-PI) ;010 - 3RD QUADRANT, X=-(X-PI) ;011 - 4TH QUADRANT, X=X-3*PI/2-PI/2 ;THE ALGORITHM USES N MODIFIED TAYLOR SERIES TO CALCULATE ;THE SINE OF THE NORMALIZED ARGUMENT. COSB: SETZM LIBFLG ;ENTRY TO COSINE RADIANS ROUTINE FADR N,PIOT ;ADD PI/2 SKIPE LIBFLG ;FALL INTO SINE ROUTINE. JRST SINLRG ; ; SIN FUNCTION ; SINB: ;ENTRY TO SINE RADIANS ROUTINE MOVEM N, SX ;SAVE THE ARG MOVM T,N ;GET ABS OF ARGUMENT CAMG T, SP2 ;SINX = X IF X.LT.2^-10 POPJ P, ;EXIT WITH ANS=ARG FDVR T, PIOT ;DIVIDE X BY PI/2 CAMG T, ONE ;IS X/(PI/2) .LT. 1.0? JRST S2 ;YES, ARG IN 1ST QUADRANT ALREADY MULI T, 400 ;NO, SEPARATE FRACTION AND EXP. CAILE T,232 JRST SINLRG ASH T1, -202(T) ;GET X MODULO 2PI MOVEI T, 200 ;PREPARE FLOATING FRACTION ROT T1, 3 ;SAVE 3 BITS TO DETERMINE QUADRANT LSHC T, 33 ;ARGUMENT NOW IN RANGE (-1,1) FADRI T,0 ;NORMALIZE THE ARGUMENT JUMPE T1, S2 ;REDUCED TO FIRST QUAD IF BITS 00 TLCE T1, 1000 ;SUBTRACT 1.0 FROM ARG IF BITS ARE FSBRI T,201400 ;01 OR 11 TLCE T1, 3000 ;CHECK FOR FIRST QUADRANT, 01 TLNN T1, 3000 ;CHECK FOR THIRD QUADRANT, 10 MOVNS T ;01,10 S2: SKIPGE SX ;CHECK SIGN OF ORIGINAL ARG MOVNS T ;SIN(-X) = -SIN(X) MOVEM T, SX ;STORE REDUCED ARGUMENT FMPR T, T ;CALCULATE X^2 MOVE N, SC9 ;GET FIRST CONSTANT FMP N, T ;MULTIPLY BY X^2 FAD N, SC7 ;ADD IN NEXT CONSTANT FMP N, T ;MULTIPLY BY X^2 FAD N, SC5 ;ADD IN NEXT CONSTANT FMP N, T ;MULTIPLY BY X^2 FAD N, SC3 ;ADD IN NEXT CONSTANT FMP N, T ;MULTIPLY BY X^2 FAD N, PIOT ;ADD IN LAST CONSTANT S2B: FMPR N, SX ;MULTIPLY BY X POPJ P, ;EXIT SC3: 577265210372 ;-0.64596371106 SC5: 175506321276 ;0.07968967928 SC7: 606315546346 ;0.00467376557 SC9: 164475536722 ;0.00015148419 SP2: 170000000000 ;2**-10 SINLRG: NFERR (96,0) PUSHJ P,INLMES ASCIZ / % Magnitude of SIN or COS arg too large to be significant/ PUSHJ P,GOSR3 SETZ N, POPJ P, ;FLOATING POINT SINGLE PRECISION SQUARE ROOT FUNCTION ;THE SQUARE ROOT OF THE ABSOLUTE VALUE OF THE ARGUMENT IS ;CALCULATED. THE ARGUMENT IS WRITTEN IN THE FORM ; X= F*(2**2B) WHERE 0.LT.F.LT.1 ;SQRT(X) IS THEN CALCULATED AS (SQRT(X))*(2**B) ;SQRT(F) IS CALCULATED BY N LINEAR APPROXIMATION, THE NATURE ;OF WHICH DEPENDS ON WHETHER 1/4 .LT. F .LT. 1/2 OR 1/2 .LT. F .LT. 1, ;FOLLOWED BY TWO ITERATIONS OF NEWTON'S METHOD. SQRTB: MOVE T, N ;PICK UP THE ARGUMENT IN T JUMPL T,SQRMIN ;SQRT OF NEGATIVE NUMBER? JUMPE T,SQRT1 ;CHECK FOR ARGUMENT OF ZERO SQRTB0: ASHC T, -33 ;PUT EXPONENT IN T, FRACTION IN T1 SUBI T, 201 ;SUBTRACT 201 FROM EXPONENT ROT T, -1 ;CUT EXP IN HALF, SAVE ODD BIT HRRM T,EX1 ;SAVE FOR FUTURE SCALING OF ANS ;IN FSC N,. INSTRUCTION LSH T, -43 ;GET BIT SAVED BY PREVIOUS INST. ASH T1, -10 ;PUT FRACTION IN PROPER POSITION FSC T1, 177(T) ;PUT EXPONENT OF FRACT TO -1 OR 0 MOVEM T1, N ;SAVE IT. 1/4 .LT. F .LT. 1 FMP T1, SQCON1(T) ;LINEAR FIRST APPROX,DEPENDS ON FAD T1, SQCON2(T) ;WHETHER 1/4.LT.F.LT.1/2 OR 1/2.LT.F.LT.1. MOVE T, N ;START NEWTONS METHOD WITH FRAC FDV T, T1 ;CALCULATE X(0)/X(1) FAD T1, T ;X(1) + X(0)/X(1) FSC T1, -1 ;1/2(X(1) + X(0)/X(1)) FDV N, T1 ;X(0)/X(2) FADR N, T1 ;X(2) + X(0)/X(2) XCT EX1 SQRT1: POPJ P, ;EXIT SQCON1: 0.8125 ;CONSTANT, USED IF 1/4.LT.FRAC.LT.1/2 0.578125 ;CONSTANT, USED IF 1/2.LT.FRAC.LT.1 SQCON2: 0.302734 ;CONSTANT, USED IF 1/4.LT.FRAC.LT.1/2 0.421875 ;CONSTANT, USED IF 1/2.LT.FRAC.LT.1 SQRMIN: PUSH P,T ;SAVE ARG NFERR (54,0) PUSHJ P,INLMES ASCIZ / % SQRT of negative number/ PUSHJ P,GOSR3 ;PRINT LINE NUMBER POP P,T ;GET ARG MOVMS T JRST SQRTB0 ;USE ABSOLUTE VALUE ;TAN - SINGLE PRECISION TANGENT ROUTINE. ; ;BASED ON ACM ALGORITHM 229, (COMM. ACM, 7, MAY 1964, J. MORELOCK). ;METHOD: ; ;TAN(N*(PI/2)+A) = -(1/TAN(A)) IF N IS ODD, ;TAN(N*(PI/2)+A) = TAN(A) IF N IS EVEN. ; ;/A/ IS .LE. 0.5*(PI/2). ;ON ENTRY, THE ARG IS IN AC N. ;ON EXIT, THE ANSWER IS IN AC N. ;COTAN (X)=TAN(PI/2-X) COTB: JUMPE N,TANB1 MOVNS N ;CALCULATE -X... FADR N,PIOT ;PLUS PI/2 TANB: PUSH P,T1 MOVM T1,N CAMG T1,[3.464102E-4] ;A CHECK FOR TAN(X)=X, JRST TAN55 ;MORE OR LESS. PUSH P,T PUSH P,A FDVR T1,PIOT MOVEI T,1 CAMGE T1,[XWD 200400,000000] ;REDUCE ARG? JRST TAN2 ;NO NEED. TAN0: MOVE T,T1 ;YES. MULI T1,400 SETZM LIBFLG ASH A,-243(T1) SKIPN LIBFLG JRST TAN05 SETZ N, JRST TAN52 TAN05: MOVE T1,T ANDI A,1 ;A POINTS TO QUADRANT. JUMPE A,TALAB1 MOVN N,N TALAB1: FSBRI T1,200400 MULI T1,400 EXCH T1,A MOVEI T,0 CAIL A,233 TDZA T1,T1 ASHC T,-200(A) ANDI T,1 ;T POINTS TO INVERSION. LSH T1,-10 TLO T1,200000 FSBRI T1,200400 MOVM T1,T1 TAN1: JUMPGE N,TALAB2 ;ORIGINAL ARG OR QUADRANT MOVN T1,T1 ;REQUIRES NEGATIVE. TALAB2: MOVE N,T1 FMPR N,PIOT MOVM A,N CAMGE A,[3.464102E-4] JRST TAN6 TAN2: PUSH P,B ;ROUTINE TO CALC TAN(A), MOVE A,N ;BASED ON ACM ALGORITHM FMPR A,A ;REFERENCED ABOVE. MOVE B,A FDVRI B,572340 ;-18. FADRI B,204700 ;14. MOVN T1,A FDVR T1,B FADRI T1,204500 ;10. MOVN B,A FDVR B,T1 FADRI B,203600 ;6. MOVN T1,A FDVR T1,B FADRI T1,202400 ;2. FMPRI N,202400 FMPR N,T1 FMPR T1,T1 FSBR T1,A FDVR N,T1 POP P,B TAN6: SETZM LIBFLG JUMPN T,TAN52 ;IF T =0, INVERT. HRLZI T,201400 FDVRM T,N SKIPE LIBFLG PUSHJ P,TANB1 TAN52: POP P,A POP P,T TAN55: POP P,T1 TAN4: POPJ P, TANB1: PUSH P,N NFERR (97,0) PUSHJ P,INLMES ASCIZ ? % TAN of PI/2 or COTAN of zero? PUSHJ P,GOSR3 ;PRINT LINE NUMBER AND EXIT WITH LARGE ANSWER. POP P,N JUMPL N,TALAB3 HRLOI N,377777 POPJ P, TALAB3: MOVE N,MIFI POPJ P, ;FLOATING POINT SINGLE PRECISION EXPONENTIAL FUNCTION ;THE ARGUMENT IS RESTRICTED TO THE FOLLOWING RANGE ; -88.028.LT.X.LT.88.028 ;IF X.LT.-88.028, THE PROGRAM RETURNS ZERO AS THE ANSWER ;IF X.GT.88.028, THE PROGRAM RETURNS +INFINITY AS THE ANSWER ;THE RANGE OF THE ARGUMENT IS REDUCED AS FOLLOWS: ;EXP(X) = 2**(X*LOG(B)BASE2) = 2**(M+F) ;WHERE M IS AN INTEGER AND F IS N FRACTION ;2**M IS CALCULATED BY ALGEBRAICALLY ADDING M TO THE EXPONENT ;OF THE RESULT OF 2**F. 2**F IS CALCULATED AS ;2**F = 2(0.5+F(A+B*F^2 - F-C(F^2 + D)**-1)**-1 ;THE ROUTINE HAS THE FOLLOWING CALLING SEQUENCE: ; PUSHJ P, EXP ; ;THE ARGUMENT IS IN N ;THE ANSWER IS RETURNED IN ACCUMULATOR N EXPB: ;ENTRY TO EXPONENTIAL ROUTINE MOVE T, N ;PICK UP THE ARGUMENT IN T MOVM N, T ;GET ABSF(X) CAMLE N, E7 ;IS ARGUMENT IN PROPER RANGE? JRST EXTOLG ;EXP TOO LARGE.;##MSG +CON OR STOP? EXP1: SETZM ES2 ;INITIALIZE ES2 MULI T, 400 ;SEPARATE FRACTION AND EXPONENT TSC T, T ;GET N POSITIVE EXPONENT MUL T1, E5 ;FIXED POINT MULTIPLY BY LOG2(B) ASHC T1, -242(T) ;SEPARATE FRACTION AND INTEGER AOSG T1 ;ALGORITHM CALLS FOR MULT. BY 2 AOS T1 ;ADJUST IF FRACTION WAS NEGATIVE HRRM T1, EX1 ;SAVE FOR FUTURE SCALING ASH A, -10 ;MAKE ROOM FOR EXPONENT TLC A, 200000 ;PUT 200 IN EXPONENT BITS FADB A, ES2 ;NORMALIZE, RESULTS TO A AND ES2 FMP A, A ;FORM X^2 MOVE N, E2 ;GET FIRST CONSTANT FMP N, A ;E2*X^2 IN N FAD A, E4 ;ADD E4 TO RESULTS IN A MOVE T, E3 ;PICK UP E3 FDV T, A ;CALCULATE E3/(F^2 + E4) FSB N, T ;E2*F^2-E3(F^2 + E4)**-1 MOVE T1, ES2 ;GET F AGAIN FSB N, T1 ;SUBTRACT FROM PARTIAL SUM FAD N, E1 ;ADD IN E1 FDVM T1, N ;DIVIDE BY F FAD N, E6 ;ADD 0.5 XCT EX1 ;SCALE THE RESULTS POPJ P, ;EXIT E1: 204476430062 ;9.95459578 E2: 174433723400 ;0.03465735903 E3: 212464770715 ;617.97226953 E4: 207535527022 ;87.417497202 E5: 270524354513 ;LOG(B), BASE 2 E6: 0.5 E7: 207540071260 ;88.028 EXTOLG: JUMPG T,EXTOL1 NFERR (98,0) PUSHJ P,INLMES ASCIZ / % Underflow in EXP/ PUSHJ P,GOSR3 SETZ N, POPJ P, EXTOL1: NFERR (99,0) PUSHJ P,INLMES ASCIZ / % Overflow in EXP/ PUSHJ P,GOSR3 ;PRINT LINE NUMBER HRLOI N,377777 ;GET LARGEST ANSWER AND RETURN. POPJ P, ;SINGLE PRECISION EXP.2 FUNCTION ;THIS ROUTINE CALCULATES A FLOATING POINT NUMBER TO A FIXED ;POINT POWER. THE CALCULATION IS A**B, WHERE T IS OF THE FORM ; T=Q(0) + Q(1)*2 + Q(2)*4 + ...WHERE Q(I)=0 OR 1 ;THE BASE IS IN ACCUMULATOR N ;AND THE EXPONENT IS IN ACCUMULATOR (N+1) WHEN THE ROUTINE IS ;CALLED. THE ANSWER IS RETURNED IN ACCUMULATOR N. ;EXP.2 IS CALLED ONLY BY EXP.3. IT IS GUARANTEED THAT THE ;BASE AND THE EXPONENT ARE NON-ZERO. EXP2.0: JUMPE T,EXP3A JUMPN N,EXP2A0 JUMPL T,EXPB3 POPJ P, EXP2A0: PUSH P,T ;SAVE FOR OVER/UNDERFLOW CHECKING. PUSH P,N SETZM LIBFLG ;CLEAR THE OVER/UNDERFLOW FLAG. MOVSI T1,(1.0) JUMPGE T,FEXP2 MOVMS T FDVRM T1,N MOVSI T1,(1.0) JRST FEXP2 FEXP1: FMP N, N ;FORM A**N, FLOATING POINT LSH T, -1 ;SHIFT EXPONENT FOR NEXT BIT FEXP2: TRZE T, 1 ;IS THE BIT ON? FMP T1, N ;YES, MULTIPLY ANSWER BY A**N JUMPN T, FEXP1 ;UPDATE A**N UNLESS ALL THROUGH MOVE N, T1 ;PICK UP RESULT FROM T1 SKIPE LIBFLG ;IF OVER/UNDERFLOW, JRST FEXP4 ;GO TO FEXP4. POP P,T ;CLEAR OFF PLIST. DO NOT POP INTO N!!!! POP P,T ;(BECAUSE THE ANSWER IS IN N). POPJ P, ;EXIT FEXP4: POP P,N ;OVER/UNDERFLOW ROUTINE. POP P,T MOVM T1,N CAMG T1,ONE JRST FXLAB1 ;/BASE/.GT.1,EXP.GT.0 MEANS OVER. JUMPG T,FXLAB2 ;/BASE/.GT.1,EXP.LT.0 MEANS UNDER. JRST EXP3D3 ;/BASE/.LT.1,EXP.GT.0 MEANS UNDER. FXLAB1: JUMPG T,EXP3D3 ;/BASE/.LT.1,EXP.LT.0 MEANS OVER. FXLAB2: JUMPG N,FXLAB3 ;THIS IS OVER. WHAT IS THE SIGN? TRNE T,1 JRST FEXP5 FXLAB3: PUSHJ P,EXP3D2 HRLOI N,377777 POPJ P, FEXP5: PUSHJ P,EXP3D2 MOVE N,MIFI POPJ P, ;SINGLE PRECISION FORTRAN IV EXP.3 FUNCTION ;THIS ROUTINE CALCULATES A FLOATING POINT NUMBER RAISED TO A ;FLOATING POINT POWER. THE CALCULATION IS ; A**B= EXP(B*LOG(N)) ;IF THE EXPONENT IS AN INTEGER THE ;RESULT WILL BE COMPUTED USING "EXP2.0" . ;THE CALLING SEQUENCE FOR THE ROUTINE IS AS FOLLOWS: ; PUSHJ P, EXP3.0 ;THE BASE IS IN ACCUMULATOR N ;AND THE EXPONENT IS IN ACCUMULATOR (N+1) WHEN THE ROUTINE ;IS CALLED. THE RESULT IS RETURNED IN ACCUMULATOR N. EXP3.0: JUMPE T,EXP3A ;IS EXPONENT ZERO? JUMPN N,EXP3A0 ;IS BASE ZERO? JUMPL T,EXPB3 ;ERROR IF BASE=0, EXP .LT.0. POPJ P, ;IMMED. RETURN IF BASE=0, EXP.GE.0. EXP3A0: MOVM A,T ;SET UP ABS VAL OF EXPON FOR SHIFTING JUMPL N,EXP3C ;IS BASE NEGATIVE? EXP3A1: MOVEI T1,0 ;CLEAR AC T1 TO ZERO LSHC T1,11 ;SHIFT 9 PLACES LEFT SUBI T1,200 ;TO OBTAIN SHIFTING FACTOR JUMPLE T1,EXP3GO ;IS T1 .GT. 0 HRRZ B,T1 ;SET UP B AS AN INDEX REG. CAILE B,43 JRST EXP3GO MOVEI T1,0 ;CLEAR OUT AC T1 LSHC T1,(B) ;SHIFT LFT BY CONTENTS OF B JUMPN A,EXP3GO ;IS EXPONENT AN INTEGER ? SKIPGE T ;YES, WAS IT NEG. ? MOVNS T1 ;YES, NEGATE IT MOVE T,T1 ;MOVE INTEGER INTO T JRST EXP2.0 ;OBTAIN RESULT USING EXP2.0 EXP3GO: PUSH P,T ;SAVE EXPONENT PUSHJ P,LOGB ;CALCULATE LOG OF N SETZM LIBFLG ;CLEAR THE OVER/UNDERFLOW FLAG. FMPR N,(P) ;CALCULATE B*LOG(N) POP P,T ;RESTORE EXP. SKIPE LIBFLG ;EXP3D AND EXP3D1 ARE ERROR ROUTINES. JRST EXP3D MOVM T,N CAMLE T,E7 JRST EXP3D1 PUSHJ P, EXPB ;CALCULATE EXP(B*LOG(N)) POPJ P, ;RETURN EXP3D: MOVM T,N CAML T,ONE JRST EXP3A ;UNDERFLOW IN ARG TO EXP MEANS ANS=1. EXP3D1: JUMPL N,EXP3D3 ;OVERFLOW MEANS OVER/UNDER IN ANS. EXP3D2: NFERR (100,0) PUSHJ P,INLMES ASCIZ / % Overflow/ JRST LRGNS1 EXP3D3: NFERR (101,0) PUSHJ P,INLMES ASCIZ / % Underflow/ PUSHJ P,GOSR3 SETZ N, POPJ P, EXP3A: MOVSI N,(1.0) ;ANSWER IS 1.0 POPJ P, EXPB3: NFERR (102,0) PUSHJ P,INLMES ASCIZ / % Zero to a negative power/ LRGNS1: PUSHJ P,GOSR3 HRLOI N,377777 ;LARGEST ANSWER. POPJ P, EXP3C: MOVE X1,A FAD X1,FIXCON FSB X1,FIXCON CAMN A,X1 JRST EXP3A1 ;NEGATIVE BASE, INTEGRAL POWER PUSH P,N ;SAVE ARGUMENTS PUSH P,T NFERR (103,0) PUSHJ P,INLMES ASCIZ / % Absolute value raised to power/ PUSHJ P,GOSR3 POP P,T POP P,N EXP3C0: MOVMS N JRST EXP3A0 EXP1.0: JUMPE T,[MOVEI N,1 POPJ P,] JUMPN N,BASNT0 ;GO IF BASE NE 0 JUMPL T,EXPB3 ;OVER FLOW POPJ P, BASNT0: JUMPL T,[TRNN T,1 MOVMS N CAIE N,1 CAMN N,[-1] POPJ P, MOVEI N,0 POPJ P,] MOVEI T1,1 PUSH P,T1 JUMPG N,IEXP2 ; TRNN T,1 JRST IEXP2 ; SETCMM (P) ; JRST IEXP2 ; ; IEXP1: IMUL N,N ; SKIPE LIBFLG ; JRST IOVER ; LSH T,-1 ; IEXP2: TRZE T,1 ; IMUL T1,N ; SKIPE LIBFLG ; JRST IOVER ; JUMPG T,IEXP1 ; MOVE N,T1 ; IEXP3: POP P,T1 ; POPJ P, IOVER: SETZM LIBFLG ; PUSHJ P,EXP3D2 ; SKIPL (P) ; JRST IEXP3 ; MOVNS N,N ; SUBI N,1 ; JRST IEXP3 ; SUBTTL INTRINSIC FUNCTIONS ;ASCIIB IS THE LIBRARY ROUTINE FOR ASCII ASCIIB: SOS T,MASAPP HRRZ X1,+1(T) MOVE N,0(X1) LSH N,-^D29 POPJ P, ;CHRB IS THE LIBRARY ROUTINE FOR CHR$. CHRB: CAIGE N,^D128 CAIGE N,0 ; JRST CHRERR ;ERROR CAIG N,^D13 CAIGE N,^D10 JRST CHRB1 ;OK SKIPN CRTVAL ;USER MAKE 10-13 LEGAL? JRST PTXER1 ;ILLEGAL LF, FF, VT CHARACTER. CHRB1: MOVEI T,1 PUSHJ P,VCHTSW ;GET SPACE FOR STRING. LSH N,^D29 MOVEM N,(T) HRRZI N,(T) HRLI N,777777 POPJ P, CHRERR: INLERR(85,43,</ ? CHR$ argument/>) JRST OUTBND ;INSTRB IS THE LIBRARY ROUTINE FOR INSTR. INSTRB: MOVEI N,1 ;ENTRY POINT. JRST INSTR1 JUMP POP P,T POP P,N PUSH P,T CAIGE N,1 JRST INSERR INSTR1: PUSH P,X1 PUSH P,X2 PUSH P,F MOVE F,N ;START POSITION IN F. SETZM VIRWRD MOVE X2,MASAPP MOVE X1,0(X2) PUSHJ P,CKVSTR ;CHECK IF VIRTUAL STR MOVEM X1,0(X2) MOVE X1,-1(X2) PUSHJ P,CKVSTR MOVEM X1,-1(X2) SOS N,MASAPP PUSHJ P,LENBF ;GET LEN OF 1ST STR. AOS MASAPP AOS X2,MASAPP CAMG F,N ;LEN .LT. START POSITION? JRST INSTR3 ;NO. INSOUT: SETZ N, INSOU1: POP P,F POP P,X2 POP P,X1 SOS MASAPP SOS MASAPP POPJ P, INSTR3: MOVE X1,-1(X2) PUSH P,C MOVE C,N ;FIRST LEN IN C. MOVE N,MASAPP PUSH P,X1 ;LENBF DESTROYS X1 PUSHJ P,LENBF ;GET LENGTH OF 2ND STR. POP P,X1 AOS MASAPP JUMPN N,INSTR4 ;NULL? POP P,C ;YES. MOVEI N,(F) JRST INSOU1 INSTR4: MOVE X2,(X2) PUSH P,G PUSH P,A PUSH P,B PUSH P,E PUSH P,T1 MOVE G,N ;2ND LEN IN G. MOVE A,MASAPP ;GET ANY APPD STRS TLNN X1,777777 ;IN TEMP. SPACE. JRST INSTR6 ;ALSO KEYS IN THE TLNE X1,377777 ;FORM -N,LOC. JRST INSTR5 MOVE X1,(X1) TLNN X1,777777 JRST INSTR6 INSTR5: JUMPLE X1,INSTR6 MOVE N,X1 PUSHJ P,STRETT MOVE X1,N MOVE X2,(A) INSTR6: TLNN X2,777777 JRST INSTR8 TLNE X2,377777 JRST INSTR7 MOVE X2,(X2) TLNN X2,777777 JRST INSTR8 INSTR7: JUMPLE X2,INSTR8 MOVEM X1,-1(A) MOVE N,X2 PUSHJ P,STRETT MOVE X2,N MOVE X1,-1(A) INSTR8: MOVEI A,(F) ;SEARCH. MOVEI B,1 INST85: MOVEI N,-1(A) ;GET C(A)TH CHAR OF 1ST IDIVI N,5 ;STR TO T1 AND C(B)TH ADDI N,(X1) ;CHAR OF 2ND STR TO E. HLL N,INSPTR(T) LDB T1,N MOVEI N,-1(B) IDIVI N,5 ADDI N,(X2) HLL N,INSPTR(T) LDB E,N CAIE T1,(E) ;CHARS EQUAL? JRST INST11 ;NO. AOJ B, ;YES. CAIG B,(G) ;FINISHED WITH 2ND STR? JRST INSTR9 ;NO. MOVEI N,(F) ;YES. INSOU2: POP P,T1 POP P,E POP P,B POP P,A POP P,G POP P,C JRST INSOU1 INSTR9: AOJ A, CAIG A,(C) ;AT END OF 1ST STR? JRST INST85 ;NO. INST11: AOJ F, ;YES. TRY AGAIN FROM NEXT PLACE. CAIG F,(C) ;NO MORE PLACES? JRST INSTR8 SETZ N, ;NO MORE. FAIL. JRST INSOU2 440700000000 INSPTR: 350700000000 260700000000 170700000000 100700000000 010700000000 INSERR: INLERR(86,44,</ ? INSTR argument/>) JRST OUTBND ;LEFTB IS THE LIBRARY ROUTINE FOR LEFT$. LEFTB: CAIGE N,1 ;ARG MUST BE .GE. 1. JRST LEFERR SOS T,MASAPP MOVE T,1(T) ;STRING KEY TO AC 1. MOVE X1,T SETZM VIRWRD PUSHJ P,CKVSTR ;CHECK IF VIRTUAL STRING MOVE T,X1 TLNE T,777777 JRST LEFTB1 LEFOU1: SETZ N, ;NULL ANSWER. POPJ P, LEFTB1: JUMPL T,LEFTB2 EXCH T,N ;APP BLK. IS KEY. JRST LEFTB4 LEFTB2: TLNE T,377777 JRST LEFTB3 MOVE T,(T) TLNN T,777777 JRST LEFOU1 LEFTB3: PUSH P,T1 HLRE T1,T EXCH N,T MOVN T,T CAMLE T,T1 HRL N,T POP P,T1 POPJ P, ;EXIT. LEFTB4: PUSH P,T1 PUSH P,X1 MOVE T1,N ;SAVE KEY IN T1. MOVE X1,T ;SAVE REQ. LEN IN X1. PUSHJ P,LENAPB CAILE N,(X1) JRST LEFTB5 MOVE N,T1 JRST LEFOU2 LEFTB5: HRRZ T,T1 LEFTB6: HLRE N,1(T) ;SUCCESSIVELY "SUBTRACT" ADD X1,N ;SUBSTRINGS UNTIL JUMPLE X1,LEFTB7 ;X1 BECOMES .LE. 0. AOJA T,LEFTB6 LEFTB7: JUMPE X1,LEFTB8 SUB X1,N ;TRUNCATE THE SUBSTRING KEY. MOVN X1,X1 HRLM X1,1(T) LEFTB8: SUBI T,-1(T1) ;TRUNCATE THE BLOCK. MOVEM T,(T1) HRLM T,T1 MOVE N,T1 LEFOU2: POP P,X1 POP P,T1 POPJ P, ;EXIT. LEFERR: INLERR(87,45,</ ? LEFT$ argument/>) JRST OUTBND ;LEN ROUTINE. LENB: LENBF: SOS T,MASAPP MOVE N,+1(T) MOVE X1,N SETZM VIRWRD PUSHJ P,CKVSTR ;CHECK IF VIRTUAL STRING MOVE N,X1 TLNE N,777777 ;NULL STRING? JRST LENB4 ;NO. LENB2: SETZ N, ;YES, NULL STRING. POPJ P, LENB4: JUMPG N,LENAPP ;APPEND KEY? TLNE N,377777 ;NO. REAL KEY? JRST LENB3 ;YES, REAL KEY. MOVE T,N ;NO, NOT REAL KEY, SO MOVE N,(T) ;RETRIEVE THE REAL KEY. JUMPGE N,LENB2 ;MUST BE EITHER NULL STRING OR LENB3: HLRE N,N ;LENGTH IN LH. MOVM N,N JRST LENAP2 LENAPP: PUSHJ P,LENAPB ;APPEND KEY. LENAP2: POPJ P, LENAPB: PUSH P,X1 ;LENGTH OF STRING IN APP BLK ROUTINE. PUSH P,X2 HLRZ T,N HRRZ X1,N SETZ N, LNLAB1: SOJL T,LENAP1 ;T HAS NUMBER OF KEYS. HLRE X2,1(X1) SUB N,X2 ;ADD UP THE LENGTHS AOJA X1,LNLAB1 LENAP1: CAILE N,^D132 ;CHECK LENGTH .LE. 132. JRST LENERR POP P,X2 POP P,X1 POPJ P, LENERR: INLERR(7,46,</ ? String formula more than 132 characters/>) JRST GOSR2 ;MIDB IS THE LIBRARY ROUTINE FOR MID$. MIDB: HRLOI T,377777 ;ENTRY POINT. MOVEM T,MIDSAV JRST MIDB1 CAIGE N,1 ;ENTRY POINT. JRST MIDERR MOVEM N,MIDSAV ;REQUESTED LENGTH. POP P,T ;CLEAR PLIST AND ALSO GET ARG. POP P,N PUSH P,T MIDB1: CAIGE N,1 JRST MIDERR SOJ N, PUSH P,C MOVE C,N PUSHJ P,LENBF AOS MASAPP SUBI N,(C) ;TOTAL LENGTH + 1 - STARTING POINT. JUMPLE N,MIDB2 CAMLE N,MIDSAV MOVE N,MIDSAV EXCH N,C MOVE T,MASAPP ;C HAS LEN OF SUBSTR, N HAS START POINT. JRST RIENTY ;GO TO RIGHT$ ROUTINE. MIDB2: SETZ N, JRST RIGOU1 MIDERR: INLERR(88,47,</ ? MID$ argument/>) JRST OUTBND ;RIGHTB IS THE LIBRARY ROUTINE FOR RIGHT$. IT IS ALSO ;USED BY MID$. RIGHTB: CAIGE N,1 ;ARG MUST BE .GE. 1. JRST RIGERR PUSH P,C MOVE C,N ;TOTAL LENGTH REQ. IN C. PUSHJ P,LENBF AOS T,MASAPP CAILE N,(C) ;REQ. LEN .GE. ACTUAL LEN? JRST RIGHT1 ;NO. MOVE N,(T) ;YES. RETURN THE ENTIRE STR. MOVE X1,N SETZM VIRWRD PUSHJ P,CKVSTR ;CHECK IF VIRTUAL STRING MOVE N,X1 JRST RIGOU1 RIGHT1: SUBI N,(C) ;START PLACE -1 IN N. RIENTY: PUSH P,T1 ;MID$ ENTERS HERE. PUSH P,A PUSH P,X1 PUSH P,X2 MOVE T1,(T) ;ORIGINAL KEY IN T1. MOVE X1,T1 SETZM VIRWRD PUSHJ P,CKVSTR ;CHECK IF VIRTUAL STR MOVE T1,X1 JUMPLE T1,RIGHT3 MOVE X1,N ;APPEND KEY. MOVE X2,T MOVE N,T1 PUSHJ P,STRETT ;GET APPENDED STRING MOVE T1,N ;INTO TEMP. SPACE. MOVE T,X2 MOVE N,X1 JRST RIGHT2 RIGHT3: TLNN T1,377777 ;NON-APP KEY. MOVE T1,(T1) HRRZI T1,(T1) CAML T1,VARFRE ;CAN THIS STR BE WRITTEN OVER? JRST RIGHT2 ;YES. MOVEI T,(C) ;NO. PUSHJ P,VCHTSC ;GET ROOM FOR NEW STR. HRRZI A,(T) ;NEW LOW WORD TO A. MOVE T1,MASAPP ;GET KEY MOVE T1,(T1) ;AGAIN IN T1. MOVE X1,T1 SETZM VIRWRD PUSHJ P,CKVSTR ;CHECK IF VIRTUAL STR MOVE T1,X1 TLNE T1,377777 JRST RIGH15 SKIPA T1,(T1) RIGHT2: MOVEI A,(T1) ;NEW LOW WORD IS OLD LOW WORD. RIGH15: IDIVI N,5 ;N HAS START CHAR -1. ADDI N,(T1) ;T1 HAS OLD START WORD. JUMPN T,RIGH16 ;BLT OR ILDB? HRL N,N ;BLT. HRRI N,(A) ;A HAS NEW START WORD. MOVEI X1,4(C) ;C HAS TOTAL SUBSTR. LENGTH. IDIVI X1,5 ;MOVE THIS MANY WORDS. ADDI X1,-1(A) PUSH P,N BLT N,(X1) POP P,N MOVN C,C HRL N,C ;KEY TO N. JRST RIGOUT RIGH16: HLL N,INSPTR-1(T) ;ILDB. HRRZI T,(A) HRLI A,440700 MOVN C,C HRL T,C ;KEY TO T. RGLAB1: ILDB T1,N IDPB T1,A AOJL C,RGLAB1 MOVE N,T ;KEY TO N. RIGOUT: POP P,X2 POP P,X1 POP P,A POP P,T1 RIGOU1: POP P,C SOS MASAPP POPJ P, RIGERR: INLERR(89,48,</ ? RIGHT$ argument/>) JRST OUTBND ;SPACEB IS THE LIBRARY ROUTINE FOR SPACE$. SPACEB: CAIL N,1 CAIL N,^D133 JRST SPACER PUSH P,X1 PUSH P,X2 MOVE T,N PUSHJ P,VCHTSC ;GET SPACE FOR STRING. MOVE X1,N ;SAVE NEGATIVE STRING LENGTH. SUBI X1,1 IDIVI X1,5 ADDI X1,(T) MOVE X2,[ASCIZ / /] MOVN N,N HRL N,N HRR N,T SPLAB1: MOVEM X2,(T) AOJ T, CAIG T,(X1) JRST SPLAB1 POP P,X2 POP P,X1 POPJ P, ;EXIT. SPACER: INLERR(90,49,</ ? SPACE$ argument/>) JRST OUTBND ;TIMEB IS THE LIBRARY FUNCTION FOR TIME OF DAY AS HH:MM:SS TIMEB: MOVEI T,10 ;SET UP FOR HRLOI N,-10 ;AN 8-CHAR STRING PUSHJ P,TIMDAT MSTIME X1, ;GET TIME IDIVI X1,^D1000 ;TO SECONDS IDIVI X1,^D60 ;TO MINS PUSH P,X2 ;SAVE SECONDS IDIVI X1,^D60 ;TO HOURS PUSH P,X2 ;SAVE MINS PUSHJ P,TWOTIM ;PUT OUT HOURS POP P,X1 ;GET MINS PUSHJ P,COLTIM ;PUT 'EM OUT POP P,X1 ;GET SECS PUSHJ P,COLTIM ;DO LIKEWISE RETTIM: POP P,X2 ;RESTORE POP P,X1 ;THE ACS POPJ P, ;AND RETURN COLTIM: MOVEI X2,":" ;PUT OUT COLON IDPB X2,T TWOTIM: IDIVI X1,^D10 ;DIGITS TO X1,X2 ADDI X1,"0" ;TO ASCII IDPB X1,T ADDI X2,"0" ;TO ASCII IDPB X2,T ;OUT POPJ P, ;RETURN ;DATEB IS THE LIBRARY FUNCTION FOR DATE AS DD-MON-YY ; ; DAY$ FUNCTION ; DAYB: PUSH P,X1 ;SAVE X1 PUSH P,X2 ;SAVE X2 DATE X1, ;ASK MONITOR FOR DEC'S DATE IDIVI X1,^D31 ;# MONTHS IN X1, # DAYS-1 IN X2 PUSH P,X1+1 ;SAVE DAY-1 FOR LATER IDIVI X1,^D12 ;YEAR+1964 IN X1, # MONTHS-1 IN X2 PUSH P,X1 ;SAVE YEAR MOVE N,X2 ;SAVE MONTH-1 IN N IDIVI X1,4 ;# OF LEAP YEARS SINCE 1964 SKIPN X2 ;IS THIS A LEAP YEAR? CAILE N,1 ;YES, JANUARY OF FEBRUARY? AOJ X1, ;LEAP DAY HAS PASSED, CORRECT FOR IT POP P,X2 ;RETURN YEARS SINCE 1964 SOJ X2, ;THIS IS NUMBER OF FULLYEARS IMULI X2,^D365 ;# DAYS (LESS LEAP DAYS) ADD X2,X1 ;ACCOUNT FOR LEAP DAYS MOVE X1,N ;GET MONTH-1 IMULI N,^D31 ;# DAYS IN 31 DAY MONTH ADD X2,N ;ADD TO TOTAL DAYS IMULI X1,-3 ;NEED SHIFT FACTOR FOR FUDGE MOVE N,[OCT 766555443300] ;FUDGE FACTOR LSH N,(X1) ;GET NUMBER OF EXTRA DAYS ADDED ANDI N,7 ;BECAUSE OF INCONSISTENT MONTHS SUB X2,N ;# DAYS IN FULL MONTHS POP P,X1 ;RETURN DAY-1 ADDI X1,1(X2) ;# DAYS SINCE 1-JAN-64 IDIVI X1,7 ;# WEEKS SINCE 1-JAN-64 IN X1 ;DAY NUMBER OF TODAY IN X2 MOVE T,[OCT 071431014411] ;NUMBER CHARACTERS IN DAY MOVE X1,X2 ;DAY NUMBER TO X1 IMULI X1,-5 ;SHIFT FACTOR LSH T,(X1) ;MOVE NUMBER OF CHARACTERS ANDI T,37 ;REMOVE GARBAGE MOVN N,T ;WILL NEED THIS MANY CHARACTERS MOVSS N ;FOR THE DAY PUSHJ P,VCHTSC ;GET THE SPACE HRR N,T ;ADDRESS OF STRING, RETURN IN N HRLI T,440700 ;BYTE POINTER TO SPACE LSH X2,1 ;CONVERT DAY NUMBER ADDI X2,MNEDAY ;INTO BYTE POINTER HRLI X2,440700 ;TO CORRECT DAY DAYB1: ILDB X1,X2 ;GET A CHARACTER OF THE DAY JUMPE X1,RETTIM ;NULL ENDS THE STRING IDPB X1,T ;MOVE TO SPACE JRST DAYB1 ;CONTINUE MNEDAY: ASCIZ /WEDNESDAY/ ASCIZ /THURSDAY/ ASCIZ /FRIDAY/ ASCIZ /SATURDAY/ ASCIZ /SUNDAY/ ASCIZ /MONDAY/ ASCIZ /TUESDAY/ ; ; DATE$ FUNCTION ; DATEB: MOVEI T,11 ;SET UP FOR HRLOI N,-11 ;A 9-CHAR STRING PUSHJ P,TIMDAT DATE X1, ;GET DATE IDIVI X1,^D31 ;GET DAYS PUSH P,X1 ;SAVE REST MOVEI X1,1(X2) ;DAY OF MONTH PUSHJ P,TWOTIM ;PUT IT OUT MOVEI X1,"-" ;- IDPB X1,T POP P,X1 ;GET BACK REST IDIVI X1,^D12 ;MONTH & YEAR PUSH P,X1 ;SAVE YEAR MOVEI X1,DATTBL(X2) ;MAKE BYTE HRLI X1,440700 ;FOR MONTH DATEB1: ILDB X2,X1 ;PUT OUT THREE IDPB X2,T ;CHAR MONTH JUMPN X2,DATEB1 ;DATTBL IS ASCIZ MOVEI X1,"-" ;- DPB X1,T ;OVERWRITES NULL POP P,X1 ;GET BACK YEAR ADDI X1,^D64 ;ADJUST PUSHJ P,TWOTIM ;PUT IT OUT JRST RETTIM ;GO RETURN TIMDAT: PUSHJ P,VCHTSC ;GET STRING SPACE HRR N,T ;GET ADDRESS HRLI T,440700 ;MAKE BYTE POINTER EXCH X1,(P) ;SAVE X1, GET RETURN P.C. PUSH P,X2 ;SAVE X2 JRST (X1) ;RETURN ;STRB IS THE LIBRARY ROUTINE FOR STR$. STRB: MOVEI T,3 PUSHJ P,VCHTSW ;GET SPACE FOR A THREE WORD HRLI T,440700 ;STRING. MOVEM T,STRPTR ;SET UP BYTE POINTER. SETZM STRCTR MOVEI X2,STLAB1 JRST SAVCS1 STLAB1: PUSH P,Q PUSH P,T PUSHJ P,OUTSRF ;FORM STRING POP P,N HRL N,STRCTR ;SET UP ADDRESS KEY. POP P,Q MOVEI X2,STLAB2 ;RESTORE AC'S. JRST RESACS STLAB2: POPJ P, ;EXIT. ;VALB IS THE LIBRARY ROUTINE FOR VAL. VALB: PUSHJ P,STRPL1 JRST VALERR PUSHJ P,EVANUM ;EVALUATE THE NUMBER JRST VALERR ;BAD FORMAT CAME T,VALPTR ;STOPPED AT RIGHT PLACE JRST VALERR ;NO POP P,Q ;RESTORE Q LIST MOVEI X2,VALAB1 ;SET RETURN FROM RESACS JRST RESACS ;RESTORE AC'S VALAB1: SOS MASAPP ;REMOVE ARGUMENT FROM LIST SKIPN TYPE ;DID NUMBER EVALUATE TO FLOATING POINT? POPJ P, ;YES, EXIT JRST FLTPNT ;NO, INTEGER, VAL IS FLOATING, CONVERT STRPL1: MOVE T,MASAPP MOVE T,(T) MOVE X1,T SETZM VIRWRD PUSHJ P,CKVSTR ;CHECK IF VIRTUAL STRING ARGUMENT MOVE T,X1 TLNN T,777777 POPJ P, TLNE T,377777 ;REAL KEY? JRST VALB2 MOVE T,(T) TLNN T,777777 POPJ P, VALB2: POP P,N PUSHJ P,SAVACS PUSH P,Q MOVE Q,N MOVE N,T HLRE T,N JUMPG N,VALB4 MOVM T,T ;NON-APP KEY. MOVEI X1,(T) ;SAVE NO. OF CHARS. IN X1. IDIVI T,5 ADDI T,1 ;TRANSFER THE STRING AND HRRZ X2,N ;GUARANTEE ROOM FOR "$" CAML X2,VARFRE ;TERMINATING CHARACTER. JUMPN T1,VALB5 ;NO NEED TO TRANSFER IF IT IS MOVE X2,MASAPP MOVEM N,(X2) PUSHJ P,VCHTSW ;ALREADY IN TEMP SPACE WITH HRLI T,440700 ;ROOM FOR "$". MOVE X2,MASAPP MOVE X2,(X2) HRLI X2,440700 HRRI N,(T) ;NEW KEY IN N. VALB3: ILDB T1,X2 ;TRANSFER. IDPB T1,T SOJG X1,VALB3 JRST VALB5 ;STRING IS SET UP, GO TO EVANUM. VALB4: HRRZ X2,N ;APP. KEY. ADDI T,(X2) HLRE X1,(T) SOJ X1, HRLM X1,(T) PUSHJ P,STRETT ;TRANSFER THE STRING. HLRE X1,N CAMN X1,[-1] JRST VALERR AOJ X1, HRLI N,(X1) VALB5: HRRZ T1,N ;GET BYTE POINTER TO LAST HLRE X1,N ;CHAR + 1 INTO T. MOVM X1,X1 IDIVI X1,5 ADDI T1,(X1) HRLI T1,440700 VALAB2: IBP T1 SOJGE X2,VALAB2 MOVEI X2,"$" DPB X2,T1 ;DEPOSIT "$" TO GUARANTEE MOVEM T1,VALPTR ;THAT EVANUM STOPS. HRR T,N HRLI T,440700 PUSHJ P,NXCH ;FIRST CHAR TO C. MOVEI T1,1(Q) POP P,Q PUSH P,Q JRST (T1) VALB6: PUSHJ P,EVANUM JRST VALERR ;FAIL. CAME T,VALPTR ;STOPPED AT RIGHT PLACE? JRST VALERR ;NO. POP P,Q ;YES. RESTORE AC'S. MOVEI X2,VALAB3 JRST RESACS VALAB3: SOS MASAPP POPJ P, ;EXIT. VALERR: INLERR(91,50,</ ? VAL argument not in correct form/>) JRST GOSR2 SUBTTL RANDOM NUMBER ROUTINES. ;THIS IS THE RANDOMIZE STATEMENT ROUTINE. RANDER: MSTIME N, CAME N,RANTST JRST RANDR2 AOS RANCNT MOVE T1,RANCNT RZLAB1: ADDI N,117 SOJG T1,RZLAB1 JRST RZLAB2 RANDR2: MOVEM N,RANTST SETZM RANCNT RZLAB2: IMUL N,N ;USE THE 31 LOW ORDER BITS OF MILLISECS IN DAY TLZ N,760000 ;FALL INTO THE DATA SETUP. ;THIS ROUTINE INITIALIZES THE RANDOM NUMBER GENERATOR DATA LOCATIONS ;(RNDDAT TO RNDDAT+6) AT THE START OF EXECUTION AND IS ALSO USED BY ;THE RANDOMIZE STATEMENT ROUTINE RANDER TO RESET THE LOCATIONS. ;ITS ALGORITHM IS UNKNOWN. ;IT EXPECTS AN ARGUMENT IN AC N. RANDOM: XOR N,[013702175435] ;MAGIC STARTING NUMBER. TLZ N,760000 JUMPE N,RANDOM MOVSI T1,-7 ;OUTER LOOP INDEX. RAND2: MOVNI A,6 ;INNER LOOP INDEX. RAND3: MOVE T,N ROT T,13 XOR T,N ROT T,-6 LSHC N,6 AOJN A,RAND3 MOVEM N,RNDDAT(T1) ADD T1,[000001000001] JUMPL T1,RAND2 MOVE N,[-7,,-4] ;INITIALIZE INDEX LOCATION FOR MOVEM N,RNDIDX ;RND FUNCTION. POPJ P, ;RND FUNCTION. ;N.B. THIS IS DEC CODE !!!!! THE AOBJN @ RNDB+5 CAN GIVE DIFFERENT ;RESULTS ON KA VS KI PROCESSORS. SINCE THE ALGORITHM IS UNKNOWN, SEE ;ABOVE, IT IS UNSURE WHICH IS RIGHT. WE SUSPECT KI, DESPITE THE FACT ;THAT THIS IS PDP-6 CODE ! RNDB: MOVE T1,RNDIDX ;GET INDEX TO DATA LOCATIONS. MOVE N,RNDDAT+7(T1) TRNN T1,400000 ;IF RH .GE. 0, GO BACK TO START OF TABLE. MOVE N,RNDDAT(T1) ADDB N,RNDDAT+4(T1) AOBJN T1,RNDB1 MOVE T1,[-7,,-4] RNDB1: MOVEM T1,RNDIDX LSH N,-9 JUMPE N,RNDB TLO N,200000 FADRI N,200000 ;NORMALIZE. POPJ P, ; ;SGN FUNCTION ; SGNB: MOVEI T,1 ;ASSUME POSITIVE, SET VAL=1 SKIPG N ;IS ARGUMENT POSITIVE? SETO T, ;NO, VAL=-1 MOVE N,T ;RETURN ANSWER IN N POPJ P, ;AND EXIT IFE BASDDT,< INTERN NPANIC,DPANIC DPANIC: > NPANIC: PUSH P,.JBREL POP P,.USREL POPJ P, END ���