!!Transcription by jsm February, September, October 2002 !!Page 7 ttl !Dartmouth Time-Sharing System 235 Executive!1 stl !Initial Loader loc 34000 !Date of latest reassembly goes here #date: bss 0 oct 1032 !Update August 26, 1965 [RPL] , Dartmouth College Time-Sharing System , 235 Executive , Richard P. Lacey [67] April 1965 - , John S. McGeachie [65] April 1964 - April 65 , Phase IV , For 44 teletype disk allocation of July 13, , 1965. , 16K Loader - will load 16K GAP cards into , upper or lower memory. Accepts single or , multiple origin cards and octal corrections. , Octal corrections may be single or multiple , origin. Scan terminated by single character , field. , Author Charles G. Moore [65] loc 3000 #r: bss 42 !read-in area #rw: bss 41 !analyze area octacc: bss 1 !working storage for octal corrections octadd: bss 1 #wdct: oct 2017777 !mask to leave address and sign bit #R2: dec #rw !card move constants dec -40 #mc: dec 2 !memory clear constants dec -1533 #mc1: dec #last+1 dec -12286 #addr: oct 1760000 !address correction mask #8k: dec 8192 octc: oct 3776000 !octal correction mask #load1: ldz !check switch 19 for memory clear sta #last !clear to contents of switches sta 1 ldx 8k,2 !get upper bit lda #date,2 !and save date sta #x3sv dld #mc mov 1 rcs !Check if clear later part sta #sflag !Set systems flag bod !!Page 8 bru #load !No dld #mc1 mov #last ldx #8k,1 !Restore at earliest lda #x3sv sta #date,1 !opportunity #load: rcb #r !Read first card - fill buffer hcr !but is loaded normally ldz !Make sure we start in lower bank sta #x3sv #r1: dld #r2 !Normal entrance for card read bcn bru *-1 !Wait for reader ready mov #r !and then move from read buffer sta #rw+40 !Set zero to end of card image ldx #zf,1 !Set up for scan ldx #x3sv,3 !Restore X3 lda #rw,1 !RW is working area - get control word bze bru #oct ext #wdct bze bru #t rcb #r hcr sra 13 #ze: sta 0 lda #rw,1 ext #addr !Leave address and sign bit bmi !If upper 8k add index bit #dart2: bru #dart1 !First Dartmouth-style card found sto 3 !Otherwise, GAL convention #ret: inx 1,1 !is return for each word in string lda #rw,1 sta 0,3 !Put it away add #rw-1,1 !totaling for checksum bov ado sta #rw,1 !Save present checksum inx -1,0 !Bump down word counter inx 1,3 !and bump up address counter - put away bxh 1,0 !and check for end of string bru #ret !If not, put away another word sub #rw+1,1 bze !Check checkword bru *+3 lda #rrr !If not, set up for error halt bru * !Recover is backspace A-I start inx 2,1 lda #rw,1 ext #wdct !!Page 9 bnz bru #ze-1 #rrr: bru #r1 !Go get another card #t: lda #rw,1 !Get transfer address bmi #dart3: ldx #8k,3 !If first Dartmouth-style, do not panic sto 3 !Else GAL lda #sflag !Save systems flag sta sload bru 0,3 !exit add #8k #dart1: lda *-1 !Set instructions for Dartmouth style sta #dart2 sta #dart3 !Reset transfer lda octe+1 sta #dart2+1 sta #dart3+1 bru #ze+1 !Get back , Free-form octal corrections - #oct: rcb #r hcr ldx #ze,2 stx #x3sv,3 !Save index register 3 bru octe octb: sra 10 ext octc !Get left half of word, and dump rest nor 16 sla 1 lda octacc bov !If overflow, there is a word bru octd bxl 2,3 bru octe bxl 3,3 bru #r1 !Single character field - get out bxh 7,3 bru octf sta octadd !Or address octe: ldz sta 3 lqa bru octa-1 octd: sld 3 ext 0 bno chs sta octacc octa: inx 1,3 bxh 40,1 !!Page 10 bru #r1 !Card finished lda octc lqa lda #rw,1 bxl 1,2 spb octb,2 inx 1,1 ldx #ze,2 bru octb+1 octf: ldx octadd,3 sta 0,3 inx 1,3 stx octadd,3 bru octf #x3sv: bss 1 !X 3 temporary save #sflag: bss 1 !Systems temporary flag #last: equ * tcd #load1 stl !Disk loader for systems and executive ejt !!Page 11 , Load checks switch 7 - if down, then no , billing is desired, so KBILL and IREC are , inhibited. , - if up, billing is desired. , The SRES sequence performs a series of , checks to insure that , 1] the SPR switch is set to the all position , 2] the disk is clear , and the 6k mod is working , 3] the console switches are reset , 4] the AAU is ready , If any of the above conditions fail to , be true, the console typewriter will type , a message to the operator and continue to , do so until the condition has been corrected. , 5] SRES also checks the batch flag. If on, , it crumps the switch check and sets up an , entry into the batch overlay in the task , list. , 6] It reads in the summary record from the , disk and resets it to zero if the bootstrap was , typed on TTY 1. loc 1000 load: bss 0 ton sxg 0 !Set zero in case switch bad ldx 8k,3 lmo !Set disk flag 2 on sta dkflg2 ldz !and set address for relinquish sta relad,3 rcs !Check billing switch ext $bmsk !billing mask - oct 3767777 sta $bf !and set in flag bnz1 bru *+4 !Billing not set spb $ertyp,2 !Billing flag on dec bon bru sres spb $ertyp,2 !Billing flag off dec boff lda $nob !Inhibit KBILL and IREC sta kbill,3 sta irec,3 sres: sxg 0 !!Page 12 set pbk !and prevent interrupts lda sign sta pmbx0 ton ldz !Now find out what group we are in sta xr01 sta z1 spb *+1,1 lda xr01 bnz bru saok !Ok, neither API not Trap lda z1 !API... bnz set pst !yes, exit set pbk set trpmode set ntpmode ldx zero,2 !and exit bru *+1,2 saok: sxg 5 !continue ldx 8k,3 !Set upper 8k bit on ldx zero,1 !Test SPB switch spb *+1,1 bxh 1,1 !If 1 is higher than 1, then SPB switch is bru *+6 !set to all, else it is at 0 sxg 0 !set 0 ldx 8k,3 !Upper 8k bit on spb $ertyp,2 dec rspb !Reset SPB switch to all bru sres !Go back and test again bar bar,7 !See how AAU is bru *+4 spb $ertyp,2 dec raau !Loafing bru sres !and check again spb $dkstst,2 !Get disk lda loadf !Check for card load bmi !If load flag on, bru loadc !then punt message this time , If batch bootstrap do not bring in the summary lda sbak !See if batch bpl bru *+12 lda sbak+1 !See if have a front sta io1 !minus if a front card was around dld .sres. !Batch - so set up return dst iplst,3 dld bsums1 !Get summary back mov bsums lac !Compute batch running time !!Page 13 sub otim1t,3 add fkbat sta fkbat bru skex !and get out , procede with normal bootstrap sel 0 prf ,0 !Position for efficiency record oct 402 bcs brn,0 bru *-1 sel 0 rrd 1,0 !! original code shows 'fclock' in operand field dec fclock !!Verify value is 0000600 bcs brn,0 !Wait bru *-1 bcs ber,0 bru *-11 lda sign !Reset special mailbox to normal status sta pmbx0 lda fclock !Check starting time bnz !If not zero, then regular bootstrap bru soak2 !so skip initialization dld fclear !If zero, clear summary area mov fclock sta acrun sta acswap sta acdisk !Initialize accumulated time counts sta acbat lac !Get starting time sta fclock sta acstrt spb $time,2 , Pick up starting times for short-run summary dst fstim dst astim2 !Long run summary sel 0 !Rewrite on disk prf ,0 oct 402 bcs brn,0 bru *-1 sel 0 wrf 1,0 dec fclock bcs brn,0 bru *-1 bcs ber,0 bru *-11 soak2:ldx zero,1 !Reset flag lda f4,1 !and transmit summary so far to accumulator sta fkedit,1 !!Page 14 inx 1,1 !Step count bxl fkbat-f3,1 !and test if done bru *-4 !No lda ohzyf,3 sta bzyf , Further checks to make sure system is working ldz !Check for switch 1 down bcs bze bru *+3 spb $ertyp,2 dec res !Reset switches lda exec2+1,3 !Check 6K mod on disk sub 1025 !Left in from bootstrap bnz Bru *+4 !OK spb $ertyp,2 dec sdsd bru load1 !Try again lda $bf !Billing flag bnz bru stime !Not on, crump sboot:spb $twait,2 !Wait for tape bru *-1 !Try again sel 1 !If OK, write wtb boot,0 !Bootstrap message dec 30 !Different length spb $twait,2 !Check again bru sboot !Try again bru stime !Get around buffer stime:spb $time,2 sta d1 !Store it in done statement laq sta d1+1 spb $ertyp,2 dec d lda tmm !Temporary malfunction sta mbx1 lda kermes !Error message sta mbx0 skex: spb $relin,2 !Get rid of the disk ldx zero,2 lda pmbx0 !Wait for d-30 to answer bmi bru *+5 inx 1,2 !See how long he takes ldx zero,1 !Waste time bxl 8190,2 bru *-6 !2/3 of a second !!Page 15 kon !Go on with load oct 2506014 !Priority request bru wait,3 !Get out $relin: bru relin,3 $time: bru time,3 $twait:lda dtime !Get inteval bcs btr,1 !If tape ready bru 2,2 !return OK maq !Save count rcs !Check switches sra 19-7 !and check switch 7 bod bru stime !If down, punt laq !Else keep counting sbo !else count bpl bru $twait+1 !Still OK stx $temp,2 !Save register spb $ertyp,2 !and type message dec $tpnr !Tape not ready ldx $temp,2 !Get register bru 1,2 !and bad return $ertyp:ldx zero, 0 !Initialize coutner lda 1,2 !and get address of message sta temp ldx temp,1 ton !Turn on typewriter bnr !and check if ready bru $type1 inx 1,0 !Count bxl 8190,0 bru *-4 !and keep trying bru 2,2 !Exit if not ready $type1:lda 0,1 !Get word ext sign !and get rid of sign srd 12 !Get most in Q inx 1,1 !and step pointer ldx zero,0 !Reset counter $type:stx temp,0 !Save character pointer bnn !and wait for ready bru *-1 !!Page 16 inx 1,0 !Step counter bxl 100,0 !Stupid typewriter - IBM equipment bru *-4 !Make sure ready 50 times before using ldx temp,0 !Restore character pointer cab peom !and check for end of message bru *+2 !no bru 2,2 !Exit san 6 !else type typ inx 1,0 !Step character counter bxh 3,0 !One word typed... bru $type1 !yes sld 6 !Get next character bru $type !and type it $tpnr:bss 0 !Tape controller not ready. oct 373772 !Tape controller not ready alf tap !Make sure handler 0 has a scratch tape alf e c !and is on remote. Then clear controller alf ont alf rol alf ler alf & no alf t r alf ead oct 701537 oct 754421 alf ke& alf sur alf e h alf and alf ler alf & 0& alf has alf & a& alf scr alf atc alf h t alf ape alf & an alf d i alf s o alf n r alf emo alf te. oct 376330 alf en alf cle alf ar& alf con !!page 17 alf tro alf lle oct 513355 , Messages res: bss 0 !Reset switches oct 374124 alf set alf & sw alf itc alf hes oct 557777 rspb: bss 0 !Set SPB switch to all oct 376225 alf t s alf pb& alf swi alf tch alf & to alf & al oct 435577 boot: bss 0 oct 2606060 oct 557755 !Special pattern alf boo alf tst alf rap alf & no oct 333535 alf & & & alf & & & alf & & & alf --- alf & & & d: bss 0 !End load Date and time. oct 372545 alf d l alf oad alf & & & date: alf & & & alf & & & alf & & & alf & & & alf & & & alf & & t alf ime d1: alf & & & !Time goes in these two locations !!Page 18 alf & & & alf & ho alf urs oct 373755 oct 2606060 bon: bss 0 !Billing flag set to bill oct 372231 alf lli alf ng& alf fla alf g s alf et& alf to& alf bil oct 433355 boff: bss 0 !Flag set for no bill oct 372643 alf ag alf set alf & fo alf r n alf o b alf ill oct 335577 sdsd: bss 0 alf som alf e f alf ool alf & ch alf ang alf ed& alf the alf & 6K alf & mo alf d s alf wit oct 233037 oct 557777 raau: bss 0 !AAU loafing alf aau alf & lo alf afi alf ng. oct 373755 ejt !Page 19 !!Page 19 , The main body of the executive is first put , on the disk. The 16K loader is then , re-entered to read in the executive , overlays, each of which is put on the disk , in turn. The last overlay is followed by two , transfer cards, the second of which transfers , to the SRES routine which types out the , DONE message to signify loading has been , completed. loadc:ldz !Reset load flag sta loadf lda sload !Check system flag bpl !If not on, bru lself !Load executive dld .set. !Set up linkage dst iplst,3 !Set in list set pst !Just in case oct 2506014 !SET PRQ bru wait,3 !and scram set: dld unset !delete entry dst iplst,3 inx sys,2 !and set for system bru perget,3 , write bootstrap on the disk lself:bcs brn,0 !Put loader on the disk first bru *-1 sel 0 prf !Position oct 2476 !Disk 0, Position 5, Record 31 bcs brn,0 bru *-1 sel 0 wrf 1,0 dec load1 !Loader bcs brn,0 bru *-1 bcs ber,0 BRU *-11 lda mask6 !Convert loader to write executive on disk sra 3 !Place a 37 in highorder bits ory load2 ory load3 lda zero sta in !Zero out some critical locations sta mbx0 lda $bldv !Pick up branch and overwrite bootstrap sta ltrans !!Page 20 bru load1 loadov: ldz !Clear overlay areas sta execove,3 dld ovclr mov execov sxg 0 !Set zero for loader bru #load !and reenter it lovwrt: bss 0 sxg 5 ldx 8k,3 ldx pernum+1,2 !Pick up overlay address pointer lda 2,2 bmi !If negative, error, so crump works bru * sta relad,3 !Set for relinquish sta *+5 !Put away in position location bcs brn,0 !Wait for disk ready bru *-1 sel 0 prf ,0 !Position oct 0 bcs brn,0 bru *-1 sel 0 wrd 8,0 !Write dec execov bcs brn,0 !Wait bru *-1 bcs ber,0 !Errors... Bru *-11 !If so, rewrite bru loadov !Continue picking up overlays $dktst:ldx zero,0 !Set counter ldo !and ask for disk sta pmbx0 lda dtime bcs brr,0 !Check if ready bru 1,2 !If so, exit sbo !Decrement bpl !and wait again bru *-4 inx 1,0 !Increment bxl 3,0 bru $dktst+1 !and try again stx $temp,2 !Save entry spb $ertyp,2 !and type a nasty mesage !!Page 21 dec dc ldx $ttemp,2 !Restore entry bru $dktst !and wait again .set.: ldx zero,2 !Set pointer bru set,2 bsums1: dec fkedit dec -8 ovclr: dec execov+1 dec -511 unset: bru iplst+2 dec 0 fclear: dec flapse !Constant to clear out summary area dec f1-f2 .bres.: spb bres,1 !Reset entry to batch dec -1 date1: dec date !Date move constants dec -5 date2: dec sdate dec -6 !plus coded date dtime: oct 40000 !Disk waiting time $bmsk: oct 3767777 !Billing flag mask $nor: bru 1,2 !Tape inhibit $bldv: bru loadov !Bootstrap overwrite pernum: bss 2 !Overlay number and address pointer $bf: bss 1 !Billing flag $temp:bss 1 !Storage stl !Bootstrap ejt !Page 22 !!Page 22 , Disk map of 235 executive , Tracks 0-4 are reserved for the D-30 , 0 5 0-30 Batchsim , 2476 0 5 31 Bootstrap , 2500 0 5 32 Lower memory portion , 2540 0 5 48 Upper memory portion , 2600 0 5 64 more upper memory , 0 6 0-31 Batchsim , 3100 0 6 32 Card lister , 3120 0 6 40 Reproducer , 3140 0 6 48 System loader , 3160 0 6 56 Catalogue files , 3200 0 6 64 Catalogue printout , 3220 0 6 72 Disk dump , 3240 0 6 80 Disk load , 3260 0 6 88 Billing overlay , 3400 0 7 00 Batch front card record , 3500 0 7 32 System loader , 3520 0 7 40 GAP lister , 3540 0 7 48 Efficiency summary of system , 3560 0 7 56 Time-sharing background monit , 3600 0 7 64 Background monitor part two , 3620 0 7 72 Sysout lister , 3640 0 7 80 Tape subroutine , 3660 0 7 88 Batch systems catalogue , 4100 0 8 32 T-S batch system monitor , 4120 0 8 40 T-S batch part three , 4140 0 8 48 T-S batch part two , 4160 0 8 56 T-S batch part four , 4200 0 8 64 Card to tape , Tracks 10 to 31 are for systems , 24100 0 40 32 Batch dump areas , 24500 0 41 32 , 25100 0 42 32 , 25500 0 43 32 , 30000 0 48 00 Batch scratch areas , 30400 0 49 00 , 31000 0 50 00 , 31400 0 51 00 , 32000 0 52 00 Batch loaders !!Page 23 , 40000 1 00 00 Batch programs , to , 51400 1 19 00 loc 6000 !225 Executive bootstrap load1: bcs brn,0 !Wait for disk ready bru *-1 sel 0 !Position prf ,0 oct 2500 bcs brn,0 bru *-1 sel 0 !Read in lower memory part load2: rrf 16,0 !16 records %0 !from beginning of memory bcs brn,0 !Wait bru *-1 bcs ber,0 !Check for errors bru *-11 sel 0 !Position again prf ,0 oct 2540 bcs brn,0 !Wait bru *-1 sel 0 !Read in first K of program load3: oct 1210010 !Read 24 records z01 exec1,1 bcs brn,0 !Wait bru *-1 bcs ber,0 !Check for errors bru *-11 lda sbak bmi bru *+13 !!Whatever possessed someone (me?) to do this? sel 0 !Position for OBA from last dump prf ,0 oct 25660 bcs brn,0 !Wait bru *-1 sel 0 rrf 8,0 !Put it back %execov bcs brn,0 !Wait bru *-1 bcs ber,0 !Check for errors bru *-11 sel 0 !Pick up date for output message prf ,0 oct 400 bcs brn,0 !Wait !!Page 24 bru *-1 sel 0 !Read in date rrf 1,0 %ldate !into date region bcs brn,0 !Wait bru *-1 bcs ber,0 !Error check bru *-11 !If errors, re-read dld date1 mov ldate+3 dld date2 mov ldate+2 ltrans: bru sres loc 6074 !Special flags sbak: dec 0 !Background-in-operation flag dec 0 sload: dec 0 !System load flag loadf: dec -1 !Initialize load flag at -1 ldate: eqo 10000 stl !Lower-lower storage ejt !!Page 25 loc 0 bss 1 !Index registers used by Edit xr01: bss 1 xr02: bss 1 xr03: bss 1 xr10: bss 1 xr11: bss 1 bss 1 bss 1 ech2: bss 1 !Character holders for echar ech3: bss 1 eselec: bss 1 !Binary line number for selective list bss 1 !Starting disk address for selective list edy: bss 1 !Address of CR at end of instruction edt: bss 1 !Address of CR at end previous instruction edz: bss 1 !Line number currently being adjusted bss 5 !Other index registers bss 2 !X-group 5 xr52: bss 2 ty: bss 20 !Typewriter input line build t: bss 16 !Temporary storage for peripheral routines ta: equ t+4 !Space for tape subroutine storage dkflg1: bss 1 !Disk flag 1 for regular tasks dkflg2: bss 1 !For extra tasks iadrs: bss 2 !Disk addresses, second is memory location in: bss 2 !Current system identifier and rep number mstemp: bss 2 !Temporary storage save: bss 2 !A and Q saved by interrupt routine bzyf: bss 1 !Busy flag dcnt: bss 1 !Disk operations counter dival:bss 1 !Disk operations elapsed time interval drcnt:bss 1 !Disk operations error counter dstakf: bss 1 !Gives number of disk requests stacked up .eff: bss 1 !Efficiency flag hdskd:bss 1 !Time counter for disk requests inov: bss 1 !Overlay in use by current system inpnt:bss 1 !Points to disk address of current system .ins: bss 1 !Insert task save int1: bss 1 !Interrupt time for 235 isum: bss 1 !Clock save at interrupt time itim: bss 1 !Real time + 1 minute kanswr: bss 1 !Answer for Datanet-30 kret: bss 1 !Temporary storage for Datanet-30 routines pcnt: bss 2 !Word and character counters used by ptype pct: bss 1 !P counter save perin:bss 1 !Indicates peripheral task currently in mem. preg: bss 1 !P-counter save for kdump ptemp:bss 1 !Storage for word currently being type rawt: bss 1 !Temporary storage !!Page 26 stack:bss 1 !Backlog of typewriter requests swflg:bss 1 !Switch flag for next sector and peripherals temp: bss 1 !Temporary storage typf: bss 1 !Typewriter usage flag , Accumulator for systems operation summary fkedit: bss 1 !0 - Mailbox routine numbers fkstrt: bss 1 !1 fkwtnu: bss 1 !2 fkdump: bss 1 !3 fkread: bss 1 !4 fkwrit: bss 1 !5 fktea:bss 1 !6 fkbat:bss 1 !Batch accumulator f3: equ fkedit-1 cmess:oct 0 !Peripheral communications cmessb: bss 1 !Batch flag eavail: dec eplst !End of list einit:dec iplst !Start of task list ovtsk:dec 0 !Either zero or pointing to routine loc. ty1: dec 0 !Word pointer for typweriter input ty2: dec 8192 !Character pointer for typewriter input .dskc.: spb dskc,1 !Entries .dskd.: spb dskd,1 .dsec.: spb dsec,1 !dskop continuation .dskx.: spb dskx,1 !Disk request entry for dska, part 2 .krst.: bru krst,3 !Trap restore branch .krex.: spb krex,1 !Special interrupt-trap branch .kset.: spb kset,1 !kdump disk write entry .ktri.: bru ktri,3 !Branch to check trapmode .ktrs.: bru ktrs,3 !Trap save check .ktrs]: spb tx2,0 !Trap check .kwrt.: spb kwrt,1 !Entry for source rewriting .syov.: spb syov,1 !Overlay read entry .pms1.: spb pms1,1 !Typewriter entry org 128 z0: dec 0 z1: dec 0 z2: dec 0 z3: oct 20000 !Upper 8K bit bru inter,3 !Go to interrupt routine bss 1 !AAU trapping mode - overflow itrap:bss 1 !AAU trapping mode - underflow bss 1 !AAU trapping mode - divide check bss 2 !AAU trapping mode index group tx2: bss 2 !Registers 2 and 3 !!Page 27 stl !Mailbox area ejt !!Page 28 , Mailbox zero flag is set to indicate , Datanet-30 message. , Return message also goes in mailbox 0 , These messages [to D-30] are: , +1 Error, mbx1 tells what type , 0 Temporary malfunction , 1 No program , 2 Unrecognizable system name , +2 Read done , +3 Write done , +4 Request dump , Messages used only after a dump from the D-30: , +5 Terminal exit , +6 Intermediate output , +7 Call for input , ****************************************** , Special message switching mailbox , has the followind code: , +1 Disk request from 235 , +2 235 finished with disk , +3 Request Datanet-30 to stop counting time , +4 Datanet-30 can start counting time again , +5 Not used at present , +6 Off , +7 On , -0 Acknowledge by D-30 and normal status , +10 Start batch , +11 Stop batch , Special request by a running system... , +12 Transfer ending disk address mbx0: bss 1 !Points to routine to be executed mbx1: bss 1 !Alfameric system name - first three letters bmx2: bss 1 !Starting disk address mbx3: bss 1 !Ending disk address and rel. loc. for LIST bss 2 !User number - or Selective LIST line number bss 2 !Problem name mbx8: bss 2 !Real time for Datanet-30 pmbx0:bss 2 !Special mailbox , Upon receipt of a message from the Datanet-30 , The messages get moved into the saved mailbox , area, which follows: smbx0:bss 1 !Saved message smbx1:bss 1 !Saved system name !!Page 29 smbx2:bss 1 !Saved starting disk address smbx3:bss 1 !Saved ending disk address smbx4:bss 1 !Saved user #, sel. LIST #, Teach address smbx5:bss 1 !Saved ending Teach disk address bss 2 !Saved problem name sdate:bss 6 !Date always kept here - used in billing sclock: bss 4 !Billing time information stl !Constants ejt !!Page 30 , Double-length constants cov1: oct 1777777 !Overflow-causing constant oct 1777777 cun1: oct 2000000 !Underflow causer oct 2000001 edeof:oct 777755 !End of message mark edfill: oct 777777 !Fill character. .drmc.: spb drmc,1 !System disk usage entry z00 -- !filled in by executive kfuge1:bru iplst !Special regular mailbox entry delete constant dec wait-5 !Special for dexit kxo: dec mkx0 !Save index groups 0-4 dec -20 movmbx: dec smbx1 !Mailbox 1, 2, 3, 4, 5, 6, 7 save dec -7 d15: dec 15 dec -1 trapr:dec itrap-1 !Trapping restore constant dec -7 traps:dec mktrp+1 !Trapping mode save constant dec -7 zero: ddc 0 .effy.: spb effy,1 !Efficiency entry dec -1 .disk.: spb disk,1 !Dskop entry dec 0 .iras:bru 2 !Erase entry oct 0 .kbil.: sbp kbil,1 !Billing entry dec -1 .pty.:bnr !Pty pointer spb pty,1 , Constants one: oct 1 mone: dec -1 two: oct 2 mtwo: dec -2 three:oct 3 four: oct 4 five: oct 5 six: oct 6 seven:oct 7 o10: oct 10 ten: dec 10 o20: oct 20 !Disk count stepping constant !!Page 31 cr: oct 37 !Carriage return o40: oct 40 o60: oct 60 !Trailing blank... o100: oct 100 !Position step for disk addresses o140: oct 140 !96 records for disk o200: oct 200 !Buffer flip for dump routine o300: oct 300 !Illegal disk address test o400: oct 400 o440: oct 440 !Fudge constants for scratch algorithm 8K: oct 20000 !Upper memory relocation constant mask1:oct 3777400 !For disk address checking mask3:oct 3777770 !Message protect mask mask4:oct 3760000 !Disk protect mask mask6:oct 3000000 mask7:oct 3777700 !Edit mask mask8:oct 0000077 !Edit mask mask9:oct 3600000 !API mask mask10: oct 3700000 mask11: oct 0077777 !Special P-counter mask mask12: oct 0177777 !Special edit mask bit3: oct 200000 !Stacker full indicator on disk operations bit4: oct 100000 !Error indicator on disk operations dinst:oct 10040 !Disk instruction less high order bits dstakp: dec dstak-4 !Special disk fudge factor kfudge: dec iprior !Special dska fudge factor mblnk:oct 2606060 !End of print line blank ovflo:oct 1000000 !Overflow constant sign: oct -0 stwo: oct -2 peom: oct 55 !End of message for ptype routine tend1:dec k3area-2 !End of program nfl: set nflpoint unf: set uflpoint fix: set fixpoint !Set AAU modes , System table with disk addresses , Standard overlay is 3K, system is on fast , tracks and experimantal sys is on slow sytab:bss 0 alf BAS !Basic oct 5000 !0 10 00 oct 10540 !0 17 48 alf ALG !Algol oct 5400 !0 11 00 oct 6140 !0 12 48 oct 6540 !0 13 48 oct 15400 !0 27 00 alf FOR !Fortran oct 13400 !0 23 00 oct 14000 !0 24 00 !!Page 32 oct 14400 !0 25 00 alf DIP !Dartmouth Interpretive Program oct 7000 !0 14 00 alf TSA !Time-Sharing Assembly processor oct 7400 !0 15 00 oct 15000 !0 26 00 alf XAL !Experimental Algol oct 10000 !0 16 00 oct 6000 !0 12 00 oct 6400 !0 13 00 oct 16000 !0 28 00 alf XBA !Experimental Basic oct 11000 !0 18 00 oct 10400 !0 17 00 alf XFO !Experimantal Fortran oct 11400 !0 19 00 oct 12000 !0 20 00 oct 12400 !0 21 00 alf EDI !Edit system oct 13000 !0 22 00 last: equ *-sytab !Maximum number of entries in table sexit1: bru sysex !Exit branch sexit2: oct 20000 !Exit constant [must have 8K bit set] syloc:dec system !Read-in location mendt:oct 1400 !Move test constant smove1: mov 0 !Move constant wait1:dec wait !Interrupt point test h1: oct 52140 !Time constants [21600 = 3600*6] blzz: alf & 00 h2: oct 550 ;[360 = 60*6] colon:oct 150000 dumpbl: alf & & & k2loc:dec k2area !2K area k3loc:dec k3area !3K area k6loc:dec k6area !6K area k6area: eqo 4000 !6K area start k2area: eqo 6000 !2K area start k3area: eqo 12000 !3K area start kermes: equ one !Error answer kmes2:equ two !Normal answer for reads kmes3:equ three !Normal answer for writes kmesd:equ four !Request dump kmest:equ five !Terminal exit message kmeso:equ six !Intermediate output message kmesi:equ seven !Real-time input call message bit1: equ ovflo !Parity error indicator hdreq:equ one !Disk request message exec1:eqo 34000 !First part of 235 executive exec2:eqo 36000 !Second part 235 executive imer: oct -10 !!Page 33 , Edit constants rog: equ k3loc rog2: equ k2loc tend: equ k3loc edsf: equ o100 edpnt2: dec smbx4 !Points to selective list number $edig:equ mask12 !Edit mask 0177777 edtwo:equ mtwo edmsk1: equ mask7 !oct 3777700 edmsk2: equ mask8 !oct 0000077 edcarr: equ cr !Carriage return upper8: equ 8K table:eqo 4000 !Start of edit linkage table stl !Time-sharing typewriter options ejt !!Page 34 com: bss 0 !List of options available on typewriter oct 623700 !Stop - same as crump bru icrump,3 key: equ *-2 !Key to catalogue oct 3160 !0 6 56 alf OFF !Off tells the D-30 to stop counting time bru ioff,3 summry: equ *-2 !Time-sharing operations efficiency summary oct 3540 !0 7 48 c/p: alf C/P !Lister bru perget,3 oct 3100 !0 6 32 c/c: alf C/C !Reproducer bru perget,3 oct 3120 !0 6 40 sys: alf SYS !System loader bru perget,3 oct 3140 !0 6 48 cat: alf CAT !Catalogue printout bru perget,3 oct 3200 !0 6 64 dum: alf DUM !Disk dump bru perget,3 oct 3220 !0 6 72 loa: alf LOA !Disk loader bru perget,3 oct 3240 !0 6 80 bil: alf BIL !Billing pack program bru perget,3 oct 3260 !0 6 88 dbg: alf DBG !Debugging overlay bru perget,3 oct 3500 !0 7 32 g/p: alf G/P !GAP lister bru perget,3 oct 3520 !0 7 40 s/o: alf S/O !Sysout lister bru perget,3 oct 3620 !0 7 72 !!Page 35 batch:alf BAT !Bacground processor bru perget,3 oct 3560 !0 7 56 c/t: alf C/T !Card to tape bru perget,3 oct 4200 !0 8 64 cru: bss 0 oba: alf OBA !Special batch system overlay bru * !Will never come here oct 4100 !0 8 32 tap: equ *-2 !Tape read/write subroutine oct 3640 !0 7 80 ocat: equ *-2 !Batch Systems catalogue oct 3660 !0 7 88 bat2: equ *-2 !Background part 2 oct 3600 !0 7 64 stl !Error messages ejt !!Page 36 tmm: equ zero !Temporary malfunction message npr: equ one !No program message usn: equ two !Unrecognizable system message datnet: bss 0 !D-30 kept disk oct 372403 oct 3755 dc: bss 0 !Disk controller oct 372431 oct 624237 oct 557777 dp: bss 0 !Parity oct 473755 ilg: bss 0 !Illegal oct 313755 adrs: bss 0 !Adrs xxxxxx oct 372160 adr1: alf & & & alf & & & pcr: oct 375577 mssage: bss 0 !Message oct 443755 full: bss 0 !Full oct 372643 oct 433755 del: bss 0 !Deleted alf & DE alf LET oct 252437 oct 557777 rea: bss 0 !Ready oct 375125 alf ADY oct 333755 bzy: bss 0 !Busy. oct 372264 alf SY. oct 375577 ilr: bss 0 !Illegal task oct 373232 !!Page 37 oct 323755 stl !Efficiency summary and buffer areas ejt !!Page 38 , Efficiency summary of systems operations loc 600 !One 64-word record fclock: bss 1 !Starting time flapse: bss 1 !Elapsed time fstim:bss 2 !Actual time of start fcnt: bss 1 !Half-hour counter bss 5 !Save 5 locations on principle f4: bss 0 bss fkbat-f3 f2: bss 0 , Day accumulators acstrt: bss 1 acrun:bss 1 acswap: bss 1 acdisk: bss 1 acbat:bss 1 !Accumulated batch astim2: bss 2 !Start for accumulated storage ftem: bss 4 !Temporary storage f1: equ flapse loc 1000 io1: bss 84 !Buffer area no. 1 loc 1200 !Second buffer area io2: bss 84 !Buffer area no. 2 , Sysout buffer areas loc 600 sio1: bss 80 !80 words sio2: bss 40 !40 words sio3: bss 40 !40 words sio4: bss 111 !110 words + 1 residue word sio5: bss 111 !110 words + 1 residue word bss 1 !Just to see how far I am , Disk addresses to be used at load time only loc 2000 oba2: equ *-2 !More of batch system overlay oct 4140 !0 8 48 oba3: equ *-2 !More batch oct 4120 !0 8 40 oba4: equ 4160 !Still more oct 4160 !0 8 56 !!Page 39 stl !Save area ejt !!Page 40 , The save area is used to save all , the important registers and index groups 0-4 , when a program is temporarily dumped on the , disk. loc 4000 kclock: bss 1 !Adjusted starting time for systems mkprnt: bss 1 !System output area pointer mksxg:bss 1 !Index group save - TEACH flag ilngth: bss 1 !Length of source program in memory mkdisk: bss 1 !Starting address of 6K area bss 1 !Blank for now mkaq: bss 2 !A and Q registers save mkov: bss 1 !Overflow save mkp: bss 1 !P-counter save mkx0: bss 20 !Index groups 0-4 save mkax: bss 2 !AX register save mkqx: bss 2 !QX register save mode: bss 2 !AAU mode and indicator save mktrp:bss 6 !Trapping mode flag and branch save mktx2:bss 2 !Trapping mode index register 2 save movid:bss 1 !Overlay identifier # morep:bss 1 !Number of current replacement molen:bss 1 !Length of overlay momem:bss 1 !Memory location of overlay movint: bss 1 !Flag to indicate whether read completed clock:bss 1 !Elapsed time counter mdc: bss 1 !Dump code for D-30 mdl: bss 1 !Dump length starts at 96 records mkpr1:eqo 4100 !System output buffer system: eqo 20000 !System read-in area sname:equ system+4 !Alfameric system name stl !Interrupt routine ejt !!Page 41 9/27/02 , When not performing any specific , task, the executive sits in its wait loop, , displaying a distinctive pattern in the , A register. loc 34001 wait: sxg 5 spb time,2 !Get time dst mbx8 !and give to Datanet-30 set pst !If in interrupt mode, exit set trpmode !If in trap program, exit set ntpmode !with no trap set ldx 8K,3 bru *+1,3 bno !Turn off overflow indicator nop lac cab int1 !Check if 1 second elapsed bru *+4 !No oct 2506014 !Yes, interrupt add four !Set timing interval for 2/3 seconds sta int1 cab itim !Check if 1+minute elapsed bru *+2 !If less, do nothing bru wait !If so, pick up time again cab .eff !Check if efficiency save due bru *-10 bru *-11 set pbk !Ten minutes elapsed, save lda cov1 !Make sure no more called until completion sta .eff dld .effy. spb insert,2 !Insert task in list bru wait+3 !and get back ejt !!Page 42 , Inter saves the working registers, and , first looks at the regular mailbox. If this , is positive, it goes through the regular , mailbox and then the peripheral mailbox , task tables in turn. , If the regular mailbox was negative, ireg , isolates the low order end and performs , a table lookup with the result. oct 0 ddc 0 !Make sure itab is even bss -3 inter:dst save !Save A and Q bov !Turn off overflow indicator bru *+1 stx pct,1 !and save P-counter lda mbx0 !Look at regular mailbox bmi !Check if negative bru ireg !If so, go service it , ****** WARNING...iprior must be even ****** iprior: bru *+2 !Priority task entry oct 0 iplst:bru *+2 !0 oct 0 bru *+2 !1 oct 0 bru *+2 !2 oct 0 bru *+2 !3 oct 0 bru *+2 !4 oct 0 bru *+2 !5 oct 0 bru *+2 !6 oct 0 bru *+2 !7 oct 0 !!Page 43 9/27/02 bru ispmbx !Last entry oct 0 eplst:equ * !End of list eplen:equ *-iplst !List length ispmbx:lda pct !Check P-counter bmi !If plus, then TON set bnn !so crump bru irest+1 ldx ty1,1 !Restore register 1 !!Word counter ldx ty2,2 !and 2 !!Character counter sna 19 !Get character ext sign !and get rid of a sign lqa !Keep a copy in Q cab mask8 !Check for line delete bru *+2 bru indel !Delete line inx 1,2 !Increment character counter bxh 3,2 !and check if over word ldx 8K,2 !Yes stx ty2,2 !Save bru *+1,2 !Code for characters as follows bru inr !Rightmost is 0 bru inl !Leftmost is 1 sla 6 !Middle is 2 ory ty,1 !Save middle character in word bru inchar !and check for carriage returns inl: sla 12 !Get character into word sta ty,1 bru inchar inr: ory ty,1 !Rightmost character inx 1,1 !Increment word pointer stx ty1,1 !and save inchar:laq !Get character sub cr !Check for carriage return bze bru ianaly !Yes, analyze command bxl 20,1 !Check status of one bru irest indel:spb messg,2 !DELETED message dec del indelx: ldz !Reset pointers sta ty1 sto ty2 bru irest !and get out !!Page 44 ibusy:sbp messg,2 !Type message dec bzy !BUSY bru indelx !and get out ianaly: sta ty1 !Reset pointers sto ty2 sta z2 inc com,2 lda ty !and analyze command ianalz: cab 0,2 bru *+2 bru 1,2 !Go to task inx 3,2 !Step pointer bxl cru,2 !Check for end of list bru ianalz ild: spb messg,2 !Type message dec ilr !Illegal task bru irest !and crump ioff: lda three !Stop time count bru *+2 icrump:lda four !Ask for time count again spb spmess,2 iredy:spb messg,2 !Type READY message dec rea ldx ovtsk,1 !Check if task used at all bxh 1,1 spb irase,2 !If greater than 1, then used iresp:ldz !Reset various pointers sta ovtsk !Reset pointer sta bzyf !and turn off busy flag sta cmessb !Reset batch flag sta io1 !for batch front card search sta kbfdg,3 !Fix billing sta kbfdg+4,3 irest:lda pct !Restore P-counter sta z1 bov !Make sure overflow is not on accidentally bru *+1 ext mask9 !and get rid of high order bits sla 4 !Restore overflow dld save !Restore A and Q set pst !!Page 45 bru 0,1 !Return irase:dld .ipas !Entered on 2 with pointer to be erased add z1 !in register 1. Construct bru *+2 and ext 8K !make for bank-compatible addresses dst 0,1 !Delete entry bru 1,2 !And return insert:sta .ins !Save entry. Insert sets up tasks for ldx zero,0 !API time ldx eavail,3 !Get next available location pointer ins1: inx 2,3 !Actually is last available bxh eplst,3 !and check for wraparound ldx einit,3 !Yes, re-initialize stx eavail,3 !Save pointer inx 2,0 !Count bxh eplen+2,0 !and check for end of table bru inful !Yes lda 1,3 !Check if entry free bnz !Entries have second word non-zero bru ins1 !Not free, keep searching lda .ins !Yes dst 0,3 !and set entries in list oct 2506014 !Make sure it gets serviced soon !!set prq lda eavail !and set pointer in A ldx 8K,3 ;Reset register 3 bru 1,2 ;and scram inful:ldx 8K,3 !Restore 8K bit ldx eavail,1 !and get entry being looked at spb irase,2 !Crump some task or other sbp messg,2 !and give room to output message dec full !Should never happen bru irest !and of course crump task ireg: sta smbx0 !Save message cab imer !Check for illegal message bru *+3 bru *+2 bru mer !Message error add 8K !Add upper 8K bit sta z2 !Set up for indexed branch to task stx preg,1 !Save P-counter for kdump dld kfuge1 !Get special erase entry dst iprior,3 !and set in regular mailbox task entry lda wait1 !and set P-location for exit sta pct lac !Save time sta isum !!Page 46 dld movmbx !Save mailbox 1, 2, 3, 4, 5, 6, 7. mov mbx1 sta mbx0 !Aknowledge message received cbuga:bru *+1,2 !And branch according to mailbox number bru kedit !0 bru kstart !1 bru kcntnu !2 bru kdump !3 bru kdskrd !4 bru kdskwr !5 bru kteach !6 bru kbrun !7 bru ktrrun !10 mer: spb adrser+1,2 !Message error dec mssage bru erxtmm stl !Edit ttl !Executive routines !!Page 47 , EDIT - message 0 , 1) Read variable-length source program from , teletype standard area into upper [3K] , area of memory. , 2) Edit source program into lower [2K] area , of memory. , 3) Write variable-length source program onto , teletype standard area from lower [2K] , area of memory. , 4) Place 2*length into mbx1, starting disk , address [selective list] into mbx2. , Normal answer = 2 , EDIT reorders a source program according , to the line numbers which precede each , statement. , A linked list is constructed, each entry , in the list corresponding to one statement , and consisting of four words, as follows , 1) location of first word of each statement , 2) length of statement in two's complement , 3) statement number in binary , 4) relative address of link with next , highest line number. , EDIT moves the source program down to , 6000 octal, ordering it according to , the list. kedit:bss 0 spb upread,2 !Read source program into upper area sxg 0 !Set group zero for edit set pst !and exit priority mode bru edita,3 kwrt: spb lwwrit,2 !Write source program from lower are bru kexitr edit1:mpy ten !Convert character bru echar !and get next edita:dld zero !Selective list pickup sta mbx3 !Set relative location to zero lda smbx4 !Check first character for digit ext $edig !Extract all but high order zone bits !!Page 48 bnz dld edeof !If first character not a digit, set to fills ldx edpnt2,1 !Set pointer spb echar1,3 !Get character cab ten !Check if digit bru edit1 !Yes, convert bru *+1 !No, crump laq !Get converted digit sta eselec !and save lda smbx2 !Pick up starting disk address ext one !Mask off extraneous bits sta eselec+1 !and save lda ilngth !Pick up program length sla 6 !Computer number of words to multiple of 64 add rog !!This needs a comment--what is it doing? add mone sta xr01 !Last word of last record - odd location ldx four,2 !Initialize table pointers ldx zero,3 ! and other registers lda mone !Initialize table entries sta table lda edfill !Large number sta table+2 edbob:lda xro1 !Begin search for carriage returns add edtwo !which must be in an odd location sta xr01 bxl k3area,1 !Check for no carriage returns at all bru enpr !No-program exit lda 0,1 !Proceed down through program ext edmsk1 cab edcarr bru edbob bru edkar !Carriage return bru edbob edkar:stx edy,1 !Address of CR at end of statement edbla:lda xr01 !Proceed down through program add edtwo !for next carriage return sta xr01 bxl k3area,1 !Has end of program been reached... bru edblax !Yes lda 0,1 ext edmsk1 !Look for CR at end of next previous cab edcarr !statement bru edbla bru edblax bru edbla edblax:stx edt,1 !Address of CR at end previous statement !!Page 49 inx 1,1 lda 0,1 !Is word after CR an end-of-message cab ededof bru edblay bru *+2 bru edblay lda xr01 add edsf !Increase XR-1 to next multiple of 64 ext edmsk2 ! (to beginning of statement following sta xr01 ! end-of-message) edblay:lda xr01 sta table,2 !Address of first word of statement sub edy add mone !Get two's complement of correct length sta table+1,2 !Number of words in statement lda 0,1 !Get first character of line number ext $edig !and check it bze bru edig !Digit lmo sta table+1,2 bru enless !and set as smaller number edig1:mpy ten !Convert digit !!Duplicate code bru echar !and get next edig: sxg 1 !Set index group 1 dld zero !Initialize register and Q xr10 ldx xr10,1 !Set pointer spb echar1,3 !Get character inx 1,0 !Count bxh 6,0 !Test bru edigx !Crump if done cab ten !Check for digit bru edig1 !Yes, convert bru *+1 !No edigx:sxg 0 !Reset index group laq !and get converted line number sta table+2,2 !Statement number in binary cab table+2,3 !Is new statement higher or equal bru enless !Less bru edout !Equal sta edz !Save line number and start adjusting links stx edy,3 !Next lower group in list lda table+3,3 sta xr01 !Next higher group in list edigy:lda edz cab table+2,1 !Does the new statement fit between these !!Page 50 bru edigz !two groups bru edout stx edy,1 !Next lower in list lda table+3,1 sta xr01 bru edigy edigz:lda xr01 !Link new group to higher sta table+3,2 ldx edy,1 !Group just below new one lda xr02 sta table+3,1 !Link lower group to new one bru enlesx enless:lda xr03 sta table+3,2 !Address link of next higher group in list ldx xr02,3 !Change pointer to lowest statement in list enlesx:inx 4,2 !Next entry group in table edout:bxh 1024,2 !256 statements maximum bru edoutx lda edt cab rog !Has end of program been reached bru edoutx bru *+1 ldx edt,1 !CR at end of next statement to bru edkar ! be listed edoutx:ldx xr03,2 !Initialize, begn rewrite lda rog2 sta edt ldx upper8,3 edgurk:lda table,2 bmi !If last group in list, prepare to exit bru edsout sta xr11 lda table+1,2 cab edtwo bru eslec bru *+2 bru edelet !Delete if length is -1 sxg 1 !Set index group 1 spb echar1,3 !and get character cab ten !Is it a digit bru echar !Get next if so bru *+1 !Reset index group sxg 0 ! As here either delete or exit ext o40 ! get rid of bit cab cr ! and check if done with line number bru eslec ! No, do not delete bru edelet !Delete !!Page 51 , Selective LIST feature eslec:lda table+2,2 !Check line number against list parameter cab eselec bru go !If less than selec number, then get out bru *+1 !Check special case of first nubmer lda edt !Location of line # of current statement ext mask7 !Get rid of all but position mod 64, sta mbx3 !then set relative position in record for D-30 lda edt !Get address of line number again ext edmsk2 !and get rid of relative part sub rog2 !Compute how many records from start we are sra 5 add eselec+1 !Add starting address sta eselec+1 !and save to send over to Datanet-30 lda edfill !Take care of special selec case sta eselec !Crump selective LIST go: dld table,2 !Set up move instruction to sto *+2,3 !sequentially position program in new area lda edt mov -- !Dummy move instruction xaq neg add edt sta edt !Compute next area to be filled cab tend !Check for program toolong bru edelet !OK, continue bru *+1 !No, trim it down lda tend1 !Two words bru edsout+1 !and crump edelet:lda table+3,2 sta sr02 !Go to next higher instruction bru edgurk edsout:lda edt !Edsout computes length of program sta xr01 !Filling begins here bxl k2area+1,1 !Also check for no program bru enpr !If none, crump add edsf !Prepare to fill in last buffer load ext edmsk2 !(to next multiple of 64) neg !Construct end-of-fill test sto eds1,3 neg !Re-negate sub rog2 !Compute length sra 5 !for Datanet-30 !!Page 52 sta mbx1 sra 1 !and for TEACH sta ilngth !Save length in pointer dld edeof !Pick EOM and fill dst 0,1 !Put away laq !Double fills eds0: inx 2,1 !Increment pointer eds1: bxh *,1 !Test bru eds2 !If done, crump dst 0,1 !Fill out bru eds0 eds2: lda eselec+1 !Starting disk address sta mbx2 !Give to Datanet-30 lda .kwrt. !Get entry sta iprior,3 !and set in entry for D-30 tasks set prq !and priority request bru wait !and get out , Character picking routine - places one at a , time in the A-register echar:bxl 2,2 !Check if first character coming up bru ech23 ! characters 2 or 3 echar1:ldx zero,2 !Entry point first time - set counter lda 0,1 !Get word inx 1,1 ! and step pointer sta ech3 !Rightmost character sra 6 sta ech2 !Middle character sra 6 !High order echar2:ext mask7 !Extract high-order bits bru 1,3 !and return ech23:lda ech2,2 !Get next character inx 1,2 !Step pointer for characters bru echar2 !and exit enpr: lda npr !No program bru erex !!Error exit stl !KSTART and KCNTNU ejt !!Page 53 9/28/02 , KSTART - message 1 , 1) Read system, if necessary, into 20000 , 2) Start RUN , Normal answers to Datanet-30... , 4 - Request dump , 5 - Terminal exit , 6 - Intermediate output , 7 - Call for input kstart:bss 0 dld zero dst movid !Initialize replacement and overlay indicators lda kmeso !Set dump code for time dump sta mdc lda o140 ;and set dump length to 96 records sta mdl lda smbx2 ;Save disk address sta mkdisk lac ;Get starting time dst sclock ;Set time and flag sta kclock ;Set clock for systems spb syread,2 ;Read in system... spb relin,2 ;and relinquish disk if necessary rin ;Turn off bad lights set pst ;and interrupt mode bru system+1,3 ;and exit (to system) , KCNTNU - message 2 , 1) Read in 6K swap from teletype 6K area. , 2) Read system, if necessary, into 20000. , 3) Begin run where last interrupted , Normal answers to Datanet-30... !!*************************************************** !!JSM: Comment error: the comments below had not been !!updated to reflect a revised program termination !!protocol; I modified them to match the comments !!associate with 'kstart', above, and deleted a blank !!line to keep the line numbering intact. !!*************************************************** , 4 - Request dump , 5 - Terminal exit , 6 - Intermediate output , 7 - Real-time input call kcntnu:bss 0 lac ;Set time for billing dst sclock lda smbx3 ;Get length sto *+2,3 ;and save for read spb dska,2 ;and read in 6K from teletype 6K area z12 96 ;Read, 96 records !!Page 54 dec k6area ;into 4000 - 6K area z20 smbx2 ;Indirect to address bru erxtmm ;Error return spb syread,2 ;Read in system spb relin,2 ;Relinquish disk spb ksuma,2 ;Get elapsed time for 6K swaps lda kmeso ;Set dump code for time dump sta mdc set fixpoint ;For trap work lda 8K ;Set register for trap group sta tx2+1 lda .krst. ;Set for trap sta itrap-1 sta itrap sta itrap+1 set ntpmode ;Set no-trap mode ldx mktrp,1 ;Get condition of trapping group bru *+1,1 ;and go to branch table bru krtrp ;Trapmode set and in trap program bru krtri ;Not in trap program when interrupt occurred , Trap not set so fall through kcrest:spb khold,2 ;Restore hold indicators lda kx0+1 ;Restore index registers maq mov mkx0 sta mkprnt ;and reset output pointer lac ;Adjust clock to give sub clock ;correct starting time to system sta kclock ;(without swap time) dld trapr ;Restore trap contents mov mktrp+1 lda mode ;and restore AAU mode sta *+1,3 set nflpoint ;Dummy... fld mkqx ;Get QX register lqa ,a ;and restore fld mkax ;Restore AX resgister dld mkaq ;Prepare to restore A and Q dst save ldx mksxg,1 ;and restore old index group oct 2526013 ;*** sxg 0,1 *** lda mkov ;Isolate overflow bits ext mask11 add mkp ;and get P-counter location bru irest+1 ;Then exit to system krtri:spb khold,2 ;Trap mode set, but program not in trap when set trpmode ;exit occurred bru kcrest+1 ;and get out !!Page 55 krtrp:set trpmode ;In trap when interrupt occured fdv zero ;Cause trap bru irest ;and exit so trap can take place krst: rin ;Reset indicators - entry is here from self- lda .krex. ;caused trap sta iprior,3 ;so set for later interrupt set prq ;then interrupt this trap krex: spb irase,2 ;After above interrupt, erase entry that bru kcrest ;called here, and go finish process khold:ldx mode+1,1 ;Get type of hold condition to be restored bru *+1,1 bru 1,2 ;None bru kcov ;Overflow hold on bru kcun ;Underflos hold on fdv zero ;Divide check on - recreate it bru 1,2 ;and exit kcov: fld cov1 ;Overflow hold on fad cov1 ;Restore it bru 1,2 ;and exit kcun fld cun1 ;Underflow indicator on fad cun1 ;Restore it bru 1,2 ;and exit stl ;KDUMP ejt !!Page 56 , KDUMP - message 3 , 1) Checks mdc to see what type of dump is , required. If it is a terminal exit it , goes to koutpt. If not, , 2) Saves all program working registers in a , 64-word block at the beginning of the 6K , area. , 3) Checks dump length and dumps the required , number of words. , 4) Puts running time in mbx1. , 5) Intermediate output flag for D-30 in mbx2. , 6) Dump length in mbx3. , 7) Writes billing record , 8) Gives D-30 type of dump in mbx0 , 6 if intermediate output , 7 if real-time input kdump:bss 0 lda mdc ;Check dump code sub six bmi bru koutpt ;Terminal exit only needs 1K dump , Start regular dump procedure dld save ;Save A and Q registers dst mkaq lda preg ;get P-counter sta mkov ext mask10 ;Get rid of high-order bits cab wait1 ;and check where interrupted... sta mkp ;In program bru *+1 ;In executive dld kx0 ;Save index groups 0-4 mov 0 oga ;Get index group sta mksxg ;and save index group with instruction ldx mkprnt,1 ;Store end-of-message lda edeof ;in output area according sta mkpr1,1 ;to program pointer lac ;Compute total adjusted elapsed time dst sclock+2 ;Give ending time and set flag for kdump sub kclock sta clock ;and save maq ;and put total # of seconds dvd six sta mbx1 ;in mailbox 1 for Datanet-30. spb ksumb,2 ;Get time for program run dld traps ;Save contents of trapping mode locations !!Page 57 mov itrap-1 sta xr52 ;and initialize for later test sta movint ;Set flag to indicate interrupt occurred lda .ktrs. ;Branch to check simultaneous interrupts sta tx2 lda .ktrs] ;spb tx2,0 sta itrap+1 ;and set in trapping mode locations sta itrap sta itrap-1 lda 8K ;Set register 3 to 8K bit sta tx2+1 fst mkax ;Save AX register laq ,a ;and move QX to AX fst mkqx ;and save QX lda nfl ;Save AAU mode of operation - assume normalize bar bup,7 ;Check for un-normalized lda unf bar bfx,7 ;Check for fixed point lda fix sta mode ;and save mode of operation ldz ;Save hold indicators - zero if none bar boo,7 ldo ;Overflow hold on bar buo,7 lda two ;Underflow hold on bar bdc,7 lda three ;Divide check on add 8K ;and set upper bit sta mode+1 sxg 5 ;Set index group for executive use set pst ;and exit priority mode bru *+1,3 ;If there was a simultaneous trap, the program spb *+1,2 ;will transfer to ktrs, else will go here lda xr52 ;Check to see if in middle of trap program bnz bru ktrchk ;Not in trap program, go check if trap set , ktex sets a flag for cntnu as follows... , 0 - Program running trap group when dump , command was given, , or trap occurred simultaneously with API , 1 - Not in trap program, but trpmode set , 2 - Trap mode not set ktex: add 8K ;Set upper 8K bit on for branch table sta mktrp ;Set flag - 8K if dropped through rin ;Reset any indicators we may have turned on lda .kset. ;Set entry for later disk work sta iprior,3 !!Page 57 set prq ;Set priority request bru wait ;and go to wait loop ktrs: lda preg ;Simultaneous occurrence of trap and interrupt sta mktx2-1 ;Set trap register 1 appropriately lda tx2-2 ;Get entrance ext mask10 ;Get rid of high order sta mkp ;Set for return ldz ;Set indicator for cntnu bru ktex ;and exit ktri: ldo ;Trap mode set, but not in trap program bru ktex ;exit ktrchk:lda .ktri. ;Test for trapmode set sta itrap+1 ;If set, a branch to ktri will occur, else set fixpoint ;try and insure fdv will work ok fdv zero ;the program will continue lda two ;Trapmode not set bru ktext ;exit , kset sets up the billing for one-shot usage, , and then writes the 6K area onto the disk kset: spb kbill,2 ;Set up to bill lda mdl ;Get dump length sto *+3,3 ;and put in list sta mbx3 ;also send to D-30 spb dska,2 ;Write on disk z37 96 ;Write, 96 records dec k6area ;from 4000 (6K area) z20 mkdisk ;indirect to disk address bru erxtmm ;Error exit bru kexitd ;Dump exit , kexitd picks up the output area pointer and , sends it to the D-30 as an output flag. It , also puts the dump code in A for kexit kexitd:lda mkprnt ;Get output area pointer sta mbx2 ;Send to D-30 lda mdc ;Dump code bru kexit ;and exit stl ;KOUTPT, KDSKRD, KDSKWRT !!Page 59 ejt , KOUTPT - entered through KDUMP , 1) Dump output area onto first 16 records , of teletype standard area , 2) Write terminal billing record , Normal answer... , 5 - terminal exit koutput:lac ;Set total elapsed time for terminal billing sta sclock+2 sub kclock ;Subtract adjusted starting time sta sclock+3 ;Total elapsed time for billing record spb ksumb,2 ;and get program running time spb kbill,2 ;and set up for billing spb dska,2 ;Now write on disk z37 16 ;Write, 16 records dec k6area ;from 4000 (also output area) z20 mkdisk ;indirect to address bru erxtmm ;Error exit bru kexitd ;Dump exit , KDSKRD - message 4 , 1) Read variable-length source program from , specified address into lower (2K) area. , 2) Place 2*length in mbx1 , Normal answer... , 2 - read completed kdskrd:spb lwread,2 ;Read into lower area lda ilngth ;Get length sla 1 ;and multiply by two sta mbx1 ;and set in mailbox 1 bru kexitr ;Done , KDSKWR - message 5 , Write variable-length source program onto , specified address from lower (2K) area , Normal answer... , 3 - write completed kdskwr:spb lwwrit,2 ;Write from lower bru kexitw ;and terminate !!Page 60 stl ;KTEACH ejt !!Page 61 , KTEACH - message 6 , 1) Read in testing program from address , specified , 2) Read system, if necessary, into 20000 , 3) Start run , Normal answers...same as for START kteach:lda ilngth ;Get end of tested program, and compute sla 6 ;where testing program is to go add k2loc ;Step past 6000 sta ktea2+2,3 ;and set memory address in parameter list lda smbx5 ;Get length of testing program sub smbx4 sra 1 ;Correct to number of 64-word records sto ktea2+1,3 ;and set in parameter list add ilngth ;Get combined length for teach add sign ;Set flag for teach sta mksxg ktea2:spb dska,2 ;and pull in program z12 -- ;read, constructed length (variable) dec 0 ;constructed address (memory) z20 smbx4 ;indirect to disk address bru erxtmm ;Error exit bru kstart ;and pull in system , KTBRUN - message 10 , 1) Run teletype batch , Normal answer ... 0 ktbrun:bru * stl ;Normal and error exits ejt !!Page 62 9/29/02 , Both exists relinquish the disk and send , a completion message to the Datanet-30, as , follows... , 1 - error message, sent through erxtmm , 2 - read completed, sent through kexitr , 3 - write completed, sent through kexitw erxtmm:spb irec,2 ;Dump debugging locations on tape lda tmm ;Temporary malfunction message erex: sta mbx1 lda kermes ;Error message bru kexit ;and send kexitr:lda kmes2 ;Message 2 bru kexit kexitw:lda kmes3 ;Message 3 kexit:sta kanswr ;and save spb relin,2 ;Relinquish disk spb ksuma,2 ;and get routine elapsed time lda mbx0 ;Try not to wipe out D-30 message bpl lda kanswr ;OK, send it cbugb:sta mbx0 ;None, so send answer over cab kermes ;Check if error exit bru iplst ;No bru wait ;Yes, special exit bru iplst ;No, continue normal running , Elapsed time calculating routines ksuma:ldx smbx0,1 ;Get elapsed time for called routine lac sub isum ;Subtract starting time add fkedit,1 ;and step particular counter sta fkedit,1 bru 1,2 ;and return ksumb:lac ;Get elapsed time for program runs sub sclock ;Starting time set by Continue and Start add fkstrt ;Step running time counter sta fkstrt bru 1,2 ;and return !!Page 63 , Users will be billed according to the , amount of central processor time they , use. , The time portion of the billing record , is broken up as follows... , 1) sclock Starting time for a run , 2) sclock+1 Flag, set as follows... , 0 for a first run , non-zero otherwise , 3) sclock+2 Ending time for a run , 4) sclock+3 Flag, set as follows... , Elapsed time if terminal run , Negative number if 6K dump kbill:lda swflg ;Check for stacked-up bills bod bru 1,2 ;Yes, crump this one ldo ;Set flag on sto swflg dld .kbil. ;Set entry to bill this particular clunk bru insert ;and return kbil: bcs btn,1 ;Check if tape ready bru 2,1 ;Crump if not ldz ;Set batch tape error flag sto swflg ;Reset flag spb irase,2 ;Erase entry kbdfg:nop ;Branch to tape op overlay if in sel 1 ;and write billing record wtb smbx1,0 %24 ;Short record nop bru iplst ;and go to API list stl ;UPREAD, LWREAD, LWWRIT ttl ;Utility routines for source input/output !!Page 64 , Upread reads a source program from the , teletype standard area into upper (3k) area , of core memory. upread:lda k3loc ;Get memory address for 3K area bru kreada ;and go read , lwread reads a source program from the , teletype standard area into lower (2K) area , of core memory. lwread:lda k2loc ;Get memory address for 2K area kreada:sta kreadb+2,3 ;Set in parameter list stx kret,2 ;and save return location lda smbx3 ;Ending disk address sub smbx2 ;Subtract starting disk address sra 1 ;and correct to number of 64-word records sta ilngth ;and save in program length indicator sta mksxg ;Make positive for TEACH sto *+2,3 ;and set in parameter list kreadb:spb dska,2 ;Go read z12 -- ;Read, constructed length z00 -- ;Constructed memory address z20 smbx2 ;Points to disk address bru erxtmm ;Error return kreta:ldx kret,2 ;Return point bru 1,2 ;and get out , lwwrit writes a source program from the , lower (2K) area of memory onto the teletype , standard area lwwrit:stx kret,2 ;Save return location lda ilngth ;Get program length sto *+2,3 spb dska,2 ;Write z37 -- ;write, constructed length dec k2area ;from lower area z20 smbx2 ;address in mailbox 2 bru erxtmm ;Error return bru kreta ;Get back stl ;SYREAD !!Page 65 ttl ;System intput/output routines , Each time-sharing compatible system or , system overlay must carry certain information , for the executive at its head. The format , is rigid and must be exactly followed by , overlays, replacements, and systems. , Word No. Function , 0] System exit location - exit branch , supplied by executive when systems are , brought into memory. , 1] Entry point - executive transfers here to , begin running a problem. , 2] Transfer to cleanup routine for systems , that use disk - this is so that when a , user types *STOP* his disk space is , returned to the available space list. , 3] Spare , 4] Alfameric system name - first 3 letters. , 5] Number of replacement of overlay - 0 for , systems. In the case of an *OVERLAY*, , bit 1 is set on if the overlay , destroys the system or replacement that , called it. , 6] Move constant - 0 if no move - tells , executive to move to here... , 7] this many words (in two's complement form) , 8] from here. , syread checks to see if the called system , is in memory. If not, it searches for its , address in a table, then reads in the system , into core memory address 20000. syread:stx kret,2 ;Save entry point dld movid ;Put replacement number in Q lda smbx1 ;System wanted dcb in ;Check to see if in memory bru *+2 ;No bru syovk ;Check if correct overlay in memory ldx zero,2 ;Initialize counter/pointer !!Page 66 sysrch:cab sytab,2 ;Seatch system table bru *+2 bru syfind ;Found inx 1,2 ;Count bxl last,2 ;and check for end of table bru sysrch ;No, try again bru rsnot ;System not in table syfind:lda z2 ;Save table pointer (for overlay calls) lda inpnt add morep ;Step by replacement number sta z2 ;and set to get system disk address lda sytab+1,2 ;Address sta *+4,3 ;Set in parameter list spb dska,2 ;and go read z12 96 ;Read, 96 records dec system ;into 20000 z00 -- ;address, constructed bru erxtmm ;Error return ldx syloc,1 ;Read-in location spb symov,2 ;Move constants down and set up identifiers , If system was read, overlays must be read in lda movid bze bru *+2 ;No overlay bry syova ;Get overlay sta inov ;Set flag to zero bru kreta ;and get out syovk:lda movid ;Get overlay number requested bze ;Check for no overlay sta inov ;If so, then reset overlay indicator cab inov ;Check for correct overlay bru syova ;No, go read in overlay bru kreta ;Yes, get out bru syova ;Else go get overlay rxnot:lda usn ;System cannot be found or read in bru erex stl ;syov ejt !!Page 67 , Overlay read-in routine. Entered from syread , or from ovcall, reads in overlay to , specified location, then returns according to , which routine called it, back to program if , called from ovcall - else back to original , caller- kstart or kcntnu. syov: spb irase,2 ;Erase entry that called spb dskb,2 ;Request disk from Datanet-30 ldz ;Overlay is special, so special measures sta dkflg2 ;must be taken - reset disk flag 2 lda movint ;and check interrupt flag bze ;If zero, then interrupted bru 2,1 ;So ignore the rest of this lda movid ;Overlay identifying number syova:add inpnt ;inpnt points to master system address sta z2 ;Location of overlay address lda sytab+1,2 ;Get it sta syovb+3,3 ;set address in parameter list lda molen ;Length of overlay sto syovb+1,3 ;set in parameter list lda momem ;Memory address of where it goes sta syovb+2,3 ;set in parameter list syovb:spb dska,2 ;Get overlay z12 -- ;read, constructed length z00 -- ;memory address z00 -- ;disk address - constructed bru erxtmm ;No go ldx momem,1 ;Get read-in address lda morep ;and set up replacement number of current sto 5,1 ;System lda movid ;Set overlay number in indicator sta inov spb symov,2 ;and go move constants and set up identifiers lda movint ;Check if dump 6 occurred while reading bze ;in overlay bru kreta ;Yes, go back to caller spb relin,2 ;Let's not relinquish twice bru sret ;No, go back to system symov:lda sexit1 ;Set exit location sta 0,1 ;and set in first word of system/overlay dld 4,1 ;Check if correct system... !!Page 68 cab smbx1 ;brought in bru rsnot ;No bru *+2 bru rsnot ;No dst in ;Yes, set in indicator which gives system and lda 8,1 ;overlay #. Construct system constant move add smove1 sta symov1,3 dld 6,1 ;Where and how may words cab mendt ;Check for no move bru 1,2 ;If no move, exit bru *+1 ;Yes symov1:mov -- ;Move constants where requested bru 1,2 ;and exit stl ;Disk request ttl ;Disk read/write routines !!Page 69 , DSKR is entered on xreg 2 by non-D-30 tasks. , It checks both dkflg1 and dkflg2 for non-zero. , It also steps dreqf on entry, an decrements , it on exit. This is so that the relinquish , routine will not needlessly give back the , disk to the Datanet-30. When both dkflg1 and , dkflg2 have gone zero, it asks the Datanet-30 , for the disk. dskb: lda z2 ;Get return point maq ;and save in entry lda .dskc. ;Set up entry to check spb insert,2 ;for other disk usage. sta z1 ;Save where inserted for returns dskc: lda dkflg1 ;Check disk flags. If either non-zero, then bze ;some task is waiting for or using the disk bru dskc1 lda dstakf ;Wait for special requests to terminate bze ;before granting access to Datanet-30-called bru 2,1 ;tasks. So wait on D-30 if non special. dskc1:lda dkflg2 ;Time-sharing task using the disk or no bnz ;D-30 task waiting. bru 2,1 ;Some other routine using disk, so punt lda pmbx0 ;Wait for message switching to go normal bpl bru 2,1 ;If plus, the message waiting to be answered sta dkflg2 ;All OK, so set disk flag 2 non-zero lac ;Set timing interval to 1 second plus add seven sta hdskd lda .dskd. ;Get entry to wait for D-30 answer sta 0,1 !!I believe this entry overwrites the call to dskc lda hdreq ;Ask for disk sta pmbx0 dskd: bcs brr,0 ;If the disk is ready bru dskg ;then get out lda pmbx0 ;Else check if D-30 bmi bru 2,1 ;has answered, and if so, wait on lac ;Else check timing interval cab hdskd bru 2,1 ;Still OK bru 2,1 ;Ditto add cr ;Reset time check sta hdskd dsko: spb messg,2 ;and type message to clear disk dec dc ;Disk controller !!Page 70 bru 2,1 ;and exit dskg: lda 1,1 ;Disk ready, so get return sta z2 bru irase ;Erase entry and return to caller , DSKA is entered by D-30-called routines. , It sets dkflg1 to +1, then waits for dkflg2 , to be reset. When other tasks have finished , with the disk, it sets dkflg1 negative to , indicate the disk is being used. , Entry is on xreg 2 with the disk parameters , immediately following th calling sequence - , see dskop for an explanation of the parameter , setup. dska: lda z2 ;Get return point sta dkflg1 ;and set disk flag 1 positive to indicate wait maq ;Save return lda .dskx. ;Set entry for continuation dst iprior,3 ;and set in priority entry ldx kfudge,1 ;and get where entry is by fudge factor dskx: lda dskflg2 ;Wait for disk flag 2 to go zero bnz bru 2,1 ;No, exit lda dstakf ;Check special requests stack flag bnz ;and punt it they are not done bru 2,1 ;dskb will continue to give them the disk ldx dkflg1,2 ;Now get flag - is also calling point here lmo ;Set disk 1 negative to indicate sta dkflg1 ;actual use lda .disk. ;Set entry for disk routine sta 0,1 bru dskh ;and go to special entry point stl ;DSKOP ejt !!Page 71 , DSKOP may be entered directly or through dskh , The calling sequence follows the spb on xreg2 , and is given below... , A spb x, 2 , A+1 1) No. of 64-word records in bits 5-19 , 2) Type of instruction in bits 2-4... , 12 indicates a read. , 37 indicates a write. , A+2 Starting memory address - mod 64 , A+3 If negative, indirect pointer to disk , address. If positive, address itself. , A+4 Error return - nature of error in high , order bits. , Bit 4 - illegal address , Bit 3 - not used as yet. , A+5 Normal return. Any non-terminal error , conditions are reflected in bits 0-4 , as follows... , Bit 2 - unused as yet , Bit 1 - recovered parity error , Bit 0 - unrecovered parity error. , Dskop uses 96-record-read and will give , illegal address indication if more than , 92 records are asked for. dksop:stx .disk.+1,2 ;Get return point dld .disk. ;and get entry spb insert,2 sta z1 ;save for returns ldx .disk.+1,2 ;Get entry point again dskh: ldz sta dcnt ;Reset length counter sta drcnt ;Error count lda 1,2 sto dnct ;Length of operation ext mask11 ;Get high order bits for type add dinst ;Construct instruction sta doper+1,3 lda 2,2 ;Memory address sta iadrs+1 lda 3,2 ;Pick up disk address sta z2 bmi ;Indirect if minus lda 0,2 !!Page 72 sta iadrs ext mask1 ;Check if legal sub o300 ;If over 300 with other bits gone then bpl ;illegal bru dker ;yes lda iadrs ;Get address back sta dseek+2,3 ;put away in case legal ado ;Set bit 19 for relinquish sta relad,3 lac add o40 ;Set timing interval sta dival disk: spb dskwt,2 ;Wait for disk lda .dsec. sta 0,1 dseek:sel 0 ;Seek command prf ,0 oct 0 ;Disk address - constructed lda dcnt ;Compute 96-record bit setting sta z0 ;See if over 96 records bxh 97,0 bru dker ;Should not happen srd 4 xaq ;Remainder mod 16 in A sra 15 ;Position remainder bze dad d15 ;15, -1 ory doper+1,3 ;Put away lda iadrs+1 ;Get memory address ext mask10 ;3700000 make sure not to wipe high order bit sta doper+2,3 ldz ;Set bits 2-4 scd 4 ory doper+2,3 doper:sel 0 ;Read/write z00 -- ;Constructed (instruction, length?) z00 -- ;Constructed (memory address?) bru 2,1 dsec: spb dskwt,2 ;Wait bcs ber,0 ;Check for errors bru dcorr ;Try to correct dexit:lda 1,1 ;Get return point add four ;and step for correct return sta z2 bru irase ;and exit back to caller dskwt:bcs brr,0 ;Is disk ready... !!Page 73 bru 1,2 ;yes, exit back to caller lac ;Check interval cab dival bru 2,1 ;Still OK, go back to task list bru 2,1 ;ditto add cr ;Set interval large enough to give sta dival ;message time to get out oct 2516036 ;Check for lockout bit set bru dsko ;No, so type message to clear spb messg,2 ;Yes, type reminder on typewriter dec datnet lda hdreq ;Ask D-30 for disk - shouldn;t have to spb spmess,2 bru 2,1 ;and return , Error correction routine - will try , five times and then consider the frame as , correctly transferred. Any error is noted , by setting bit 1 on in the return address. , If an error persisted the record was rewritten , on the disk and bit 0 is set. dcorr:ldx drcnt,0 ;Error counter inx 1,0 bxh 6,0 ;Tried five times bru dnorec ;No recovery stx drcnt,0 lda bit1 ;Set bit 1 on in return address ory 1,1 ;to signify parity error of some sort bru dseek dnorec:lda sign ;Set bit 0 on in return address ory 1,1 bpe ;Clear out any parity indicator nop ldx iadrs+1,2 ;Get read-in address bru *+2 dnore1:inx 2,2 dld 0,2 ;and find where parity error was dst 0,2 bxl 2,2 ;Do not go too far bru * ;Parity on disk yet none in memory bpc bru dnore1 ;Try again lda z2 ;Get address of error ext mask8 ;77 make a multiple of 64 words sta dcorra,3 ;Put address in write command sub iadrs+1 sra 5 ;Compute new disk address !!Page 74 add dseek+2,3 sta dcorrp,3 sel 0 prf ,0 ;Position to write back bad record dcorrp:oct 0 ;Disk address bcs brn,0 ;Wait till ready bru *-1 sel 0 wrf 1,0 ;Write record back on dcorra: &0 ;Address in memory lda dcorrp,3 ;Get exact disk address spb adrser+1,2 ;and output it dec dp lda .disk. ;Set up task for disk sta 0,1 bru 2,1 ;and get out dker: spb adrser,2 ;Illegal address message decl ilg lda 1,1 ;Get return address add bit4 ;Set bit 4 on add three ;and return to error return bru dexit+2 ;Get out adrser:lda iadrs ;Get address stx rawt,2 ;Save entry point spb convrt,2 ;and convert address sta adr1 ;and set in message laq sta adr1+1 spb messg,2 ;Type message dec adrs ldx rawt,2 ;Get entry again bru messg ;and type kind of address error stl ;Relinquish ejt !!Page 75 , RELIN relinquishes the disk to the Datanet-30. , If no task has used the disk, then the relin- , quish is vacuous; if any task is waiting for , the disk, then the relinquish is punted. relin:set prq ;Request interrupt after completion dld zero ;Check out status of flags cab dstakf ;See if more tasks waiting bru relex ;yes bru *+1 cab dkflg1 ;Against disk flag 1 bru relex ;waiting bru *+2 ;Not used by D-30-called tasks bru relq ;Definitely used cab dkflg2 ;Against regular task flag bru relq ;Used bru relmes ;no, so send message only relq: dst dkflg1 ;Reset flags bcs brn,0 bru *-1 ;It shouldn't happen, but just in case sel 0 ;and relinquish prf ,0 ;Disk had better be ready relad:oct 403 ;Set up by dskop - 403 if for after boot. bcs brn,0 ;Wait here bru *-1 ;for disk sel 0 ;and read after write next sector 0 records oct 1213040 ;with power dropped and API set oct 0 relmes:lda two ;Tell D-30 it has disk sta pmbx0 bru 1,2 ;and return relex:sta dkflg2 ;Reset disk flag 2 bru 1,2 ;and get out stl ;Peripheral overlay read ejt !!Pge 76 , The peripheral overlay calling routine is , entered from the table of typewriter-entered , tasks, to perget. It is also entered to , pgetb, byt other peripheral tasks, to chain , several in sequence. When entry is through , perget, the routine checks to see if any , other peripheral tasks are currently in , memory...if so, it punts and types 'busy', , else it calls in the overlay from the disk , address given in the word after the calling , location. , It also saves the overlay called, so that if , the same peripheral task is called twice in , a row, it does not read it in the second time. perget:lda bzyf ;Check busy flag - if on bnz ;then not zero, bru ibusy ;so punt. pgetb:lda z2 ;Get caller sta bzyf ;and set flag to busy status cab perin ;and check if already in memory... bru *+2 ;No bru execov ;Yes, go execute sta perin ;Else set in indicator lda 2,2 ;and get disk address sta pgetx,3 ;and set in parameter list spb dskb,2 ;Get disk from Datanet-30 spb dskop,2 ;and go read in overlay z12 8 ;Read eight records dec execov ;Memory location pgetx:z00 -- ;Disk address dec -1 ;Should never ever return here..... spb relin,2 ;Relinquish disk to Datanet-30 bru execov ;and go execute stl ;System-called routines ejt !!Page 77 , DRAMB is entered on xreg 2 by background , systems that require disk usage. , DRAMA is entered on xreg 1 by time-sharing , systems that request the disk. , The calling sequence is... , A spb dramb,2 , A+1 Indirect pointer to a parameter list - , see later for an explanation. , A+2 Return point. The return is executed , immediately, and the completion of the , operation is signalled by setting a , flag in the parameter list. , The parameter list is a four-word table, set , up as follows... , P 1) No of 64-word records in bits 5-19, , 2) Type of operation in bits 2-4... , 12 - indicates a read , 37 - indicates a wite , P+1 Starting memory address - mod 64 , P+2 Disk address for read or write, , sign bit set if scratch area is to be , supplied to a system by the executive. , In this case, each system has 48 , 64-word records available, and the low , order end of the parameter word must , specify what particular record is to , be accessed. , Note...the particular address used , will be stored in P+2 by the executive , but most users will want to ignore , this. , P+3 Flag to indicate completion of , operation. Upon completion of , the operation, it will be set odd if , the operation was successful, even , otherwise. In either case, certain , conditions will be indicated in the , high order bits... , Bit 4 - illegal address (error) , Bit 3 - too many requests stacked , up (error) , Bit 2 - not used at present , Bit 1 - parity (recovered, no error) , Bit 0 - parity (unrecovered, but , transfer complete, so no , error indication given) !!Page 78 9/30/02 , A maximum of four , simultaneous calls are allowed. There , must be as many parameter lists as there may , be simultaneous calls, and the user should , not modify the parameter list for a given , call until that disk operation has been , completed. drama:ldx mkp,2 ;Get entry point bru *+2 dramb:inx 1,2 ;Step for return in any event lda 0,2 ;Points to *P* sta .drmc.+1 ;save ldx .drmc+1,1 ;Set in register ldx dstakf,0 ;Get stackup flag bxh 4,0 ;If four stacked up, crump bru dsful inx 1,0 ;Else step by one stx dstakf,0 ;and save ldz ;and zero out return word sta 3,1 ;*P+3* dld .drmc. ;Get list entry bru insert ;and go insert in task list drmc: ldx dstakp,2 ;Points to dstak-4 inx 3,2 ;Step to next entry lda 3,2 ;and get second word - check if entry free bnz ;non-zero in use bru *-3 ;so try again - we know there is at least 1 lda 1,1 ;Get pointer to *P* sta 3,2 ;and set in stack bru irase ;then erase current entry , The following entries go in groups of , four. They are all identical dstak:spb dskb,2 ;Now wait for disk spb drms,2 ;then use z00 -- ;Pointer to *P* goes here spb dskb,2 ;Group 2 spb drms,2 z00 -- spb dskb,2 ;Group 3 !!Page 79 spb drms,2 z00 -- spb dskb,2 ;Group 4 - last entry spb drms,2 z00 -- drms: stx temp,1 ;Save place in task list lda 1,2 ;Points to *P* sta z1 ;set for indirect #1 add stwo ;Points to *P+2* sta drmd+3,3 ;set in parameter list lda 0,1 ;Get instruction type and length sta drmd+1,3 ;and set in parameter list lda 1,1 ;Get memory address sta drmd+2,3 ;set in parameter list ldz ;Reset waiting list sta 1,2 lda 2,1 ;Get disk address bpl ;Check if real address bru drmd ;Yes, skip all this ext mask4 ;Get rid of all high order bits and start to lqa ;computer scratch address add drmd+1,3 ;Add record count to starting scratch address ext mask4 ;Wipe out high order bits sta z0 bxh 49,0 ;See if too many [records] bru dnovl ;Yes, error return xaq ;Get number [of records] back sla 1 ;Position correctly add mkdisk ;add teletype address add o440 ;step 400 to get scratch area sta 2,1 ;and put away drmd: spb dskop,2 ;Read/write on disk z00 -- ;Type and length z00 -- ;Starting memory address z00 -- ;Pointer to disk address in parameter list nop ;Ignore errors - sort of stx temp,1 ;and save place in list drme: lda drmd+3,3 ;Points to *P+2* sta z1 lda z2 ;Get spb to dskop - has error info in high ext mask11 ;order bits. Isolate these bze ;check for no errors ldo ;If none, set completion indicator odd sta 1,1 ;and set in word four of parameter list lda dstakf ;Release stackup flag one notch sbo !!Page 80 sta dstakf ldx temp,2 ;Get place in task list bru relin ;and relinquish disk dnovl:ldx bit4,2 ;Set illegal address bit on bru drme ;and return dsful:lda bit3 ;Special bits for stacker full error sta 3,1 ;and set in *P+3* bru 1,2 ;Return to caller stl ttl ;System exits !!Page 81 , All exits are entered by an spb 20000 (octal) , on index register 1, with an appropriate , constant in the A-register. , The constants and their corresponding , exits are as follows... , 0 - Terminal exit. , 1 - Intermediate output exit. , 2 - Input call exit. , 3 - Overlay call temporary exit. , 4 - Overlay delete call , 5 - Disk operations call !!JSM edited for clarity and correctness 9/30/02 , 6 - Special data transfer to the D-30, , using the special mailbox. , 7 - Special data transfer to the D-30, , using the regular mailbox. , The calling sequence for these is , A spb 20000 (octal) , A+1 data word 1 , A+2 data word 2 , A+3 return , Data words 1 and 2 will be sent to the D-30 , Data word 1 has special transfer code... , 12 - send ending disk address , 8 - Change dump length. Q has the ending dump , address, which must be rounded to the , the next higher multiple of 64. !!End JSM edits , When the sytems request a terminal exit, , intermediate output, or real-time input, the , executive will request a dump from the D-30 , after saving the type of exit. sysex:set pbk ;No interrupts while setting up exits inx 1,1 ;Save return location incremented by one stx mkp,1 !!The comparison below needs to have a symbolically defined !!upper bound based on the length of the branch table cab ten ;Dec 10 to see if legal call bru sysx1 ;Yes [length < 10] bru sret ;No, so return bru sret sysx1:sto sexit2 ;Set up for branch ldx sexit2,1 bru sysx2,1 ;and branch to start of list sysx2:bru term ;0 - Terminal exit bru otex ;1 - Intermediate output exit bru inex ;2 - Input call exit bru ovcall ;3 - Overlay call bru ovdel ;4 - Overlay delete bru drama ;5 - Disk operation bru sptra ;6 - Special transfer bru sret ;7 - Not used yet so just return bru sydlc ;8 - Change dump length !!Page 82 sret: ldx mkp,1 ;Return set pst bru 0,1 !! The code below has two bugs: !! (1) the message from the system can usurp !! executive functions with codes < 10 !! (2) because the message is stored before !! the parameter, there is a potential !! race condition, by which the D-30 !! can pick up the message before the !! parameter has been stored. sptra:ldx mkp,1 ;Get entrance location lda pmbx0 ;Wait for special mailbox bpl ;to go minus bru *-2 ;better not take too long lda 0,1 ;Data word 1 cab ten ;See if legal bru sptrx ;No bru *+1 ;Yes sta pmbx0 lda 1,1 ;Data word 2 sta pmbx0+1 ;in special mailbox+1 lda pmbx0 ;Wait for acknowledgment bpl bru *-2 sptrx:inx 2,1 ;Set for return bru sret+1 ;and enter return waitex:lda mbx0 ;Do not wipe out D-30 message bpl ;If none, go on lda kmesd ;Request dump sta mbx0 ;Answer Datanet-30 set pst ;Hang up waiting for interrupts so as not bru *-1 ; to destroy any index registers term: lda kmest ;Terminal exit sta mdc ;put in dump code bru waitex ;and exit otex: lda kmeso ;Intermediate output message sta mdc ;put in dump code bru waitex ;and exit inex: lda kmesi ;Real-time input call sta mdc ;put in dump code bru waitex ;and exit , Change dump length. Q has ending memory address sydlc:xaq ;Get address in A sub k6loc ;subtract starting address sra 6 ;divide by 64 to get record count cab o140 ;See if legal length [<= 96] bru *+3 ;yes bru *+2 bru sret ;No, so just return sta mdl ;Store in length !!Page 83 bru sret ;and return stl ;Overlay call ejt !!Page 84 , The overlay call is a special system feature. , It is treated as a special system exit. , An overlay call may be used to supplement or , replace part or all of a system. If a system , is replaced by an overlay (this is indicated , in the calling sequence), only the replacing , overlay will be called back in after swaps. , Furthermore, system replacements may have , their own overlays. , If a called-for overlay is already in memory , the information will be placed in the save , area, and the overlay will not be read in. , Two conventions must be rididly adhered to: , 1) All systems, overlays, and replacements , must have the same heading information , in the same format. (See SYREAD) , 2) The numbering system for overlays, , replacements, and systems, must be unique. , That is, if overlays, replacements, and , systems are considered as integral units , of core memory, then each of , these units must have a unique identiying , number in the word after the system name. , The calling sequence is as follows... , A spb 8192, 1 with a 3 in the A-register , A+1 Replacement # of current unit in , memory, unless a new replacement is , being called, in which case this , should have the number of the new , replacement. This is the only case , in which overlay and replacement , numbers may match up in the calling , sequence - see next item. , A+2 Number of overlay being called. If the , overlay destroys [??] the system currently , in memory, then this word should , have the sign bit on. This is so that , if a dump occurs while the overlay is , being brought in, the executive will , not needlessly read in the system , again for a new problem. , A+3 Length of overlay. It will be truncated. , So if length is not an exact multiple , of 64 words, it should be extended at , least as far as the next 64-word multiple !!Page 85 , A+4 Memory address where the overlay , is desired - must be a multiple of , 64 words. , A+5 Return address. ovcall:ldx mkp,1 ;Entry location, stepped by one lda 0,1 ;[A+1] Replacement number sta morep ;and save lda 1,1 ;[A+2] Overlay number bmi ;Check if destroys system sta in ;yes sto movid ;and set in save location lda 2,1 ;[A+3] Get length mod 64 sra 6 sta molen ;and save in length indicator lda 3,1 ;[A+4] Get memory address and extract ext edmsk2 ;low-order end sta momem ;memory location inx 4,1 ;[A+5] Step return address stx mkp,1 ;and save lda movid ;See if overlay called is already in memory sub inov bze bru sret ;yes stx movint,1 ;Set flag for interrupts ldx 8K,1 ;Do not destroy system's index registers lda .syov. ;Set entry to read in overlay sta iprior,1 ;Special treatment sta inov ;Destroy overlay indicator set prq ;Priority request set pst ;and wait for process to finish bru *-1 , Overlay delete call deletes unneeded overlays. , Return is to the first word after the spb. ovdel:ldz ;Reset indicator to show no overlay sta movid bru sret ;and get back stl ;MESSG - type routine ttl ;Odds and ends !!Page 86 messg:ldx stack,0 ;Check stack bxh 4,0 bru 2,2 ;If three stacked up, crump inx 1,0 ;Bump up stack stx stack,0 ;and save lda 1,2 ;Get pointer for message maq lda .pms1. ;Initial entry inx 1,2 ;Step for return ton ;Set for output bru insert pms1: ldx typf,2 ;Check output flag bxh 1,2 ;If non-zero, then on bru 2,1 ;so try again later. lda 1,1 ;Address of message sta pcnt+1 ;and set in save location dld .pty. ;Get entry dst 0,1 ;and replace old stx typf,1 ;Set flag on and save pointer pmore:inx 12,2 ;Set for first character stx pcnt,2 ;and save ldx pcnt+1,2 ;Word pointer lda 0,2 ;Get next word sta ptemp ;and save it inx 1,2 ;Step pointer stx pcnt+1,2 ;and save it bru 0,1 ;Then exit pty: ldx typf,1 ;Get branch word ldx pcnt,2 ;and get word pointer lda ptemp ;Get word sra 0,2 ;and shift for character [12, 6, 0] ext mask7 ;Get rid of high-order bits cab peom ;and check for end-of-message bru *+2 ;if not, OK bru pdend ;else crump san 6 ;Put character into N-register typ ;and output it bxl 1,2 ;Check for new word needed bru pmore ;if so, get it inx -6,2 ;Else set for next character stx pcnt,2 ;and save bru 0,1 ;Exit pdend:lda stack ;Decrement stack counter sbo sta stack bze ;Do not reset unless stack at zero kon stx z2,1 ;Set for 'irase' exit !!Page 87 ldz ;and reset flag sta typf bru irase ;and exit stl ;IREC, SPMESS, EFFY, CONVRT, TIME ejt !!Page 88 , Debugging tape dump. Writes lower memory , from 0 to 'sclock'+3 - see how long tape , takes to come ready by saving counts in dump irec: lac add three ;Wait two counts of clock sta temp irecs:lac ;Now check sub temp bpl ;If time up, exit bru 1,2 bcs rtn,1 ;Else check tape bru irecx sel 1 ;and write lots of stuff wtb 0,0 %sclock+3 bru 1,2 ;and get out , This routine waists for the Datanet-30 to , answer all previous messages and then , exits. spmess:bss 0 lqa ;Save message in Q lda pmbx0 ;and wait for any other messages to be bpl ;acknowledged bru *-2 ;Hope we don't hang too long laq ;Get message sta pmbx0 ;and set in special mailbox spmesx:lda pmbx0 ;and wait for this message to be answered bmi ;If negative, we are OK bru 1,2 ;so get back bru spmesx ;else wait for answer , EFFY is set up by the wait loop every 10 , minutes. It waits for all peripheral , activity to cease, then calls in an overlay , which dumpes the efficiency summary info , onto the disk. effy: lda bzyf ;Wait for peripheral tasks to be completed add stack ;and wait for all typing to stop bnz bru 2,1 spb irase,2 ;Erase entry !!Page 89 ldx zero,2 ;and get summary overlay inx summry,2 bru pgetr , Conversion routine convrt:ext mask6 ;Mask out sign bits srd 15 ;Put most in Q sla 3 ;Begin spacing with zeros sld 3 sla 3 sld 3 sta mstemp ldz sld 3 sla 3 sld 3 sla 3 sld 3 lqa lda mstemp bru 1,2 ;Return , TIME - entered on xreg 2 , uses temp and mstemp time: lac add h2 ;Add 1 minute sta itim ;Save incremented time sub o400 ;Make it reasonable maq dvd h1 ;Get hours dst mstemp maq ;[Move hours to Q] dvd ten ;Convert to decimal bze ;Delete leading zeros lda o60 ;[If zero, get a blank] sla 6 ;[Move char left one char position] sta temp laq ;[Or in the second character] ory temp ;[temp now has the hours] dld mstemp ;[Get fractional hours in Q] lda zero dvd h2 ;Get minutes maq ;[Move minutes to Q] dvd ten sla 6 ;[Tens of minutes in mstemp] dst mstemp ;[minutes < 10 in mstemp+1] !!Page 90 add mstemp+1 ;[Complete minutes in A] add colon maq ;[Leading colon, minutes in Q] lda temp ;[Hours in A] add blzz ;Leading blank bru 1,2 ;Return loc 37000 ;Overlays go here execov:bss 1 ;Normal peripheral entry point bss 1 ;System entry to peripherals bres: bss 1 ;Restart entry to peripherals kbrun:bss 1 ;Permission to run entry for batch processing bss 508 ;Save some space tcd load stl ;Lister ttl ;Peripheral overlays !!Page 91 , Time-sharing lister. Will list a deck of , decimal cards, converting parentheses and , other characters for printer compatibility. , This lister is buffered and requires that the , first card be in the hopper before starting. , The deck must be followed by two blank cards. , Error messages are printed on the console , typewriter. , At any time, depressing switch zero will , cause all activity to halt. , For the 235, as follows... , C/P followed by a carriage return will , produce a single-spaced, untranslated , listing. All other options must follow , the following code... , S Single spacing , D Double spacing , N Not translated , T Translated for printer compatibility , C/P must be followed by two letters if an , alternative option is selected, , as in C/PST followed by a CR. , After an error, depressing switch 2 will , cause the listing to take up where it , left off. org pernum dec 0 dec c/p org execov dld .lst.,3 ;Get entry spb insert,2 ;and insert in list sta ovtsk bcs bpr,6 bru lst1 spb messg,2 dec pnr ;Printer not ready bru lndra lst1: bcr bru L235 spb messg,2 ;Card reader not ready dec crn bru lndra L235: ldz sta lf lmo sta llnt1 !!Page 92 sta llsd1 spb lchar,1 ;Get next character from ty+1 cab cr ;Check if carriage return bru *+2 bru lsn ;Go check all correct bxh 3,2 ;If not CR, and LF gte 3, then error bru lerr1 ldx 8K,2 ;Initialize looping variable lst2: cab ltab,2 bru *+2 bru ltab+1,2 ;Go to indicated task inx 2,2 ;Increment bxl 8,2 ;Test for end bru lst2 lerr1:bru ild ;Illegal task lsn: lda lf ;Check indicator cab two bru lsn1 ;Single spaced and untranslated bru lerr1 ;lf equals 2, second char a CR, error bru lista ;done oct 624537 ;S N CR lsn1: lda *-1,3 ;Easiest way to get N and S sta ty+1 bru L235 lchar:ldx lf,2 ;Character picking up routine - easily bxh 1,2 ;modified to other uses... bru lchar1 ;If greater than zero, then not first time lda ty+1 ;Get second word sta lch3 ;Last character sra 6 sta lch2 ;Middle character sra 6 ;First character lchar2:ext mask7 ;Get rid of higher-order end inx 1,2 ;and increment counter stx lf,2 ;and save bru 1,1 ;Get out lchar1:lda lch2-1 ;Get character bru lchar2 ;and return ltab: alf 00N ;No translation bru ln alf 00S ;Single spacing bru ls alf 00D ;Double spacing bru ld alf 00T ;Translated bru lt !!Page 93 ln: lda ln1,3 sta lnt,3 ;Set up instruction bru llnt lt: lda lt1,3 sta lnt,3 ;Store bru llnt llnt: lda llnt1 ;Get counter ado ;increment bnz bru lerr1 ;Some idiot did it again sta llnt1 bru lchar ls: lda lss,3 ;Get instructions !!*************************************************** !!JSM: ERROR: the instruction below was originally !! sta lpr+1 !!unindexed. It seems incorrect as the effect would !!be to place a printer instruction to slew one line !!--which is also an 'add 0'--into a location high !!in the 6K area, almost at its end. This instruction !!would not cause a halt, and would probably affect !!only some user's running program, and then only if !!the program was large. Furthermore, the error !!would only occur if C/PS were specified; as S is !!the default option, it is unlikely that many people !!at Dartmouth would ever have done so. This error !!is also present in my 235 executive listing, from !!March 1965, so it's been around a long time. !!I've corrected it to include index register 3, !!which (almost) always had the 8K bit set. The !!corrected instruction is shown below. !!*************************************************** sta lpr+1,3 ;[JSM: 9/30/02 Corrected, missing index 3] lda L56,3 ;Number of lines per page lscnt:sta lpage sta lncnt lda llsd1 ;Make sure no idiot tries both single and ado ;double space bnz bru lerr1 sta llsd1 bru lchar ;Go back for some more ld: lda lss,3 ;Get instruction sla 1 ;modify for double space sta lpr+1,3 lda L56,3 ;and count sra 1 bru lscnt ;and get out lst: ldz ;Entry point here bcs ;Check switch zero down bmi bru 2,1 ;If so, out ldx lpoin,2 ;Get exit point bru 1,2 ;and return lista:dld lareas,3 ;Get buffer areas dst lin ;and set in flip-flops sta io1+27 ;[Trash first buffer's syncword location] lac ;and set timing interval add six !!Page 94 sta lctim lda cmessb ;Do not acknowledge if batch on bze spb messg,2 ;Acknowledge receipt dec pcr ;[Works because lda = 00] rcd io1 ;Read in first card hcr lslew:spb lret,2 ;Exit and wait bcs bpn,6 ;Punt if not ready bru 2,1 sel 6 ;Slew to top of page slt 8 spb lret,3 ;then exit and wait again bcs bpn,6 ;punt and wait bru 2,1 sel 6 ;Slew 3 lines slw 3 lda lpage ;Reset page count sta lncnt list: spb lret,2 ;Exit and wait bcs bpn,6 bru 2,1 spb lhop,2 ;Now check hopper condition ldx lin,2 ;Area last read into lda 27,2 ;Check syncowrd add lsync,3 bnz ;If not matched, card read error bru lserr ldx lin+1,1 ;Area to be next read into stx lin,1 ;Flip-flop them stx lin+1,2 sta 27,1 ;Zero out next syncword location dld 0,2 ;Check for quote card dcb lquot,3 bru *+2 ;No bru lqchk ;Yes, check rest lndq: rcd 0,1 ;Read card otherwise hcr lnt: bru lppnt ;[Default single-space no translation] lnt1: dld lmask,3 ;Mask for table lookup lookp:lda 0,2 ;Pick up word to be translated bmi bru lprnt z13 z1 ;Put mask into xreg 1 [dst odd location] !!Page 95 ory z1 ;Put character into low-order end sra 6 ;Make room for new character add 0,1 ;Pick it up z13 z1 ;Second character ory z1 sra 6 add 0,1 z13 z1 ;Third character ory z1 sra 6 add 0,1 sta 0,2 ;Put away word inx 1,2 ;Increment address register bru lookp ;Return to loop lprnt:lda lin+1 sto lpr+1,3 ;Construct address sel 6 lpr: wpl 0 ;Print line sta z1 ;Set address in register lmo ;Set end-of-line flag sta 27,1 add lncnt ;and decrement page counter bze ;If zero, set up to slew bru lslew sta lncnt bru list ;Get back lret: stx lpoin,2 ;Save exit point ldx ovtsk,1 ;Get entry point bru 1,2 ;and get back again lhop: bcn ;Check reader bru lhop1 ;Test hopper not ready lac ;Step timer if OK add seven sta lctim ;and save bru 1,2 ;exit back lhop1:ldx lin,2 ;Get buffer address lda 27,2 ;and check syncword for hopper empty cab lsync+1,3 bru *+2 bru lendr ;End run for list if hopper empty lac ;Time check cab lctim ;If time has run over, then bru 2,1 ;get out if time still good !!Page 96 bru 2,1 spb time,2 ;or unattended. Type message and abort run. dst lab1,3 ;Put away spb messg,2 ;Type message dec lab ;Aborting list, date and time bru iredy ;and crump lserr:spb messg,2 ;Type message dec cre ;Card read error spb lret,2 ;Exit and wait on switch 2 down ldz ;Resume normal operations rcs ;2 is depressed ext mask6 sla 2 bno bru 2,1 ldx lin,2 ;Pick up address of buffer rcd 0,2 ;Read card hcr lac ;Pick up and compute delay time add six sta lctim bru list ;and get back and try again lqchk:lda cmessb ;Check background flag bze bru lndq ;If not on, crump immediately lqchk1:ldx ovtsk,1 ;Get entry point spb irase,2 ;and erase it ldx zero,2 ;Reset 2 inx batch,2 ;and set for batch monitor lmo sta io1 ;Set front card in bru pgetb ;Go get batch monitor lndra:spb lret,2 lda stack bnz bru 2,1 lda cmessb ;Check batch flag bnz bru lqchk1 ;get batch back lendr:spb time,2 ;Pick up time dst el1,3 ;Put it in type message spb messg,2 ;Type message dec dl ;Done listing, time !!Page 97 10/1/02 spb lret,2 ;Slew after list bcs brn,6 bru 2,1 ;wait for printer sel 6 slt 8 ;and slew spb irase,2 ;and erase entry ldz ;Reset some things sta bzyf sta ovtsk sta io1 ;So batch does not get fouled up. bru 2,1 ;Crump right away .lst.:spb lst,1 dec -1 lmask:oct 0 oct 3777700 ;Special geek mask for table lookup lareas:dec io1 ;Area 1 dec io2 ;Area 2 lsync:oct 1171701 ;Negation of syncword oct 3606077 ;Hopper-empty constant louot:oct 777777 ;Double 0-7-8 punches oct 777777 lss: add 0 ;printer instruction to slew 1 line L56: dec 56 ;Number of lines per page ln1: bru lprnt lt1: bru lnt1 pnr: oct 374751 ;Printer not ready. alf INT alf ER alf NOT alf & RE alf ADY oct 333755 crn: bss 0 ;Card reader not ready oct 372321 alf RD alf REA alf DER alf & NO alf T R alf EAD oct 703337 oct 557777 cre: oct 372321 ;Card read error alf RD !!Page 98 alf REA alf D E alf RRO alf R B alf ACK alf SPA alf CE alf 1 C alf ARD alf & AN alf D T alf OGG alf LE alf 2 W alf HEN alf & RE alf ADY oct 333755 ddc 0 bss -2 lab: bss 0 ;Aborting list -- time oct 372122 alf ORT alf ING alf & LI alf ST. alf & & & lab1: alf & & & alf & & & alf & HO alf URS oct 373755 oct 0 ddc 0 bss -3 dl: bss 0 ;Done listing - time oct 372446 alf NE alf LIS alf TIN alf G. el1: alf & & & alf & & & alf & HO alf URS oct 373755 !!Page 99 org t ;Temporary storage lin: bss 2 lncnt:bss 1 lpage:bss 1 lctim:bss 1 lch2: bss 1 ;Character storage - they must be in lch3: bss 1 ;sequential order llnt1:bss 1 llsd1:bss 1 lf: bss 1 ;Character counter lpoin:bss 1 ;Entry pointer loc 37700 ;Lookup table for lister [*must be at 37700*] oct 000000 oct 010000 oct 020000 oct 030000 oct 040000 oct 050000 oct 060000 oct 070000 oct 100000 oct 110000 oct 120000 ; 2-8 oct 160000 ;# 6-8 oct 140000 ;at sign oct 150000 ;- oct 160000 ;= oct 170000 oct 200000 oct 210000 oct 220000 oct 230000 oct 240000 oct 250000 oct 260000 oct 270000 oct 300000 oct 310000 oct 320000 oct 330000 oct 760000 ;] oct 350000 oct 360000 oct 370000 oct 400000 oct 410000 oct 420000 oct 430000 !!Page 100 oct 440000 oct 450000 oct 460000 oct 470000 oct 500000 oct 510000 oct 520000 oct 530000 oct 540000 oct 550000 oct 560000 oct 570000 oct 600000 oct 610000 oct 620000 oct 630000 oct 640000 oct 650000 oct 660000 oct 670000 oct 700000 oct 710000 oct 720000 oct 730000 oct 750000 ;[ oct 750000 ;[ oct 760000 ;] oct 770000 ;End of translation table tcd lovwrt ;List transfer stl ;Reproducer ejt !!Page 101 org pernum dec 2 dec c/c , Card reproducer , Will reproduce any type of card deck. , Buffered, with error checking. , Switch 0 down at any time will cause all , activity to halt. , Card read errors may be corrected by , placing the top card from the out stacker , (the last card read) in the read station , and toggling switch two. org execov dld .rst.,3 ;Get entry spb insert,2 ;and set up in list sta ovtsk sta z1 lda 8K ;Set initialization entry sta rpoin bpr ;Crump if not ready bru *+4 spb messg,2 dec rpnr ;Punch not ready bru rcmpa bcr ;[Test card reader] bru *+4 spb messg,2 dec rcrn ;Reader not ready bru rcmpa lda cmessb ;Check batch flag bze ;If on continue, else spb messg,2 ;acknowledge receipt dec pcr ;[Works because lda = 00] dld zero ;Zero out first syncwords dst io1+82 rcf io1 ;Read first card lac ;Compute first time delay add six sta rinf ;Save incremented time dld rads,3 ;Buffer addresses dst rin bru rep ;and get out rst: ldx ovtsk,1 ;Make like all other overlays ldz ;This is the entry point rcs ;Check switch 0 own bmi !!Page 102 bru 2,1 ;Yes, crump for now ldx rpoin,2 ;Get pointer bru 1,2 ;and get there rret: stx rpoin,2 ;Temporary exit ldx ovtsk,1 bru 2,1 rep: spb rret,2 ;Give things a chance to come ready ldx rin,2 ;area last read into bcn ;If reader not ready, check hopper bru rhop ldx rin+1,1 ;Next area lda 82,2 ;Darned card reader... check if out of phase ext rbit8,3 ;bit 8 bze ;if so, word before will have crap in it lda 83,2 ;Check syncword add rsync,3 bnz ;If not matched, reader error bru rderr sta 82,1 ;and set in word again dld 0,2 ;Check for quote cards dcb rquot,3 bru *+2 ;No bru rqchk ;Yes, check rest of card and flag rnoq: stx rin+1,2 ;Else switch buffer addresses stx rin,1 sta 83,1 ;zero out [overwrite] next area's syncword wcf 0,2 ;Punch previous card rcf 0,1 ;read in next one bru rep ;and start all over rhop: lda 83,2 ;Hopper empty test add rsynch,3 bze ;If matched, task completed bru rcmplt lac ;Check clock cab rinf ;Has time run over... bru 2,1 ;Just punt bru 2,1 spb messg,2 ;Else card reader not ready dec rcrn ;Card reader not ready lac ;Set up new time count add cr ;long wait sta rinf bru 2,1 ;Punt again !!Page 103 rqchk:lda cmessb ;Check back flag bze ;if not on, return bru rnoq dld rquot,3 ;Ekse check out card some more dcb 2,2 bru rnoq ;No bru *+2 bru rnoq ;Neither dcb 4,2 ;Then check last word bru rnoq ;Not Ok unless six 0-7-8 punches in a row bru *+2 bru rnoq rqex: ldx ovtsk,1 ;Get entry's location spb irase,2 ;and erase entry ldx zero,2 ;Reset 2 inx batch,2 ;and set to get batch monitor lmo sta io1 ;Set front card in bru pgetb ;and get monitor rcmpa:spb rret,2 ;[Either reader or punch not ready at start] lda stack bnz bru 2,1 lda cmessb bnz bru rqex rcmplt:spb time,2 ;Get time dst rdat1,3 ;out away spb messg,2 ;Type message dec repc ;Reproduction completed, time ldx ovtsk,1 ;Get task spb irase,2 ;and erase task ldz ;zero out flags sta bzyf sta ovtsk sta io1 ;So batch does not get fouled up bru 2,1 ;and exit rderr:spb messg,2 ;Type message dec rcre ;Card read error spb rret,2 ldz rcs ;Wait for switch 2 down before continuing ext mask6 sla 2 bno ;Wait bru 2,1 ;Not down ldx rin,2 ;Pick up last-used read-in area !!Page 104 rcf 0,2 ;read a card bru rep ;and start up again .rst.:rpr ;If punch ready, go to task, else not spb rst,1 rads: dec io1 ;Buffer addresses dec io2 rouot:oct 1006 oct 1007 rsync:oct 1770001 ;Syncword OK check rsynch:oct 0770001 rbit8:oct 4000 ;Bit 8 for special bad card check rpnr: bss 0 ;Punch not ready oct 374764 alf NCH alf & NO alf T R alf EAD oct 703337 oct 557777 rcrn:bss 0 ;Card Reader not ready oct 372321 alf RD alf REA alf DER alf & NO alf T R alf EAD oct 703337 oct 557777 oct 0 ddc 0 bss -3 repc: bss 0 ;Reproduction completed oct 375125 alf PRO alf DUC alf TIO alf N C alf OMP alf LET alf ED. alf & & & rdat1:alf & & & alf & & & !!Page 105 alf & HO alf URS oct 373755 rcre: bss 0 ;Card read error oct 372321 alf RD alf REA alf D E alf RRO alf R B alf ACK alf SPA alf CE alf 1 C alf ARD alf & AN alf D T alf OGG alf LE alf 2 W alf HEN alf & RE alf ADY oct 333755 org t ;Temporary storage rin: bss 2 ;Buffer areas flip-flop rinf: bss 1 ;Initial flag rpoin:bss 1 ;Entry point tcd lovwrt ;Transfer stl ;Catalogue printout ejt !!Page 106 , The catalogue printout, disk dump and , Billing pack routines are all one package. , The billing and the catalogue routines may , be called separately by *BIL* or *CAT* res- , pectively but the usual sequence is to call , in the dump routine with *DUM*. The dump , then calls in the catalogue and billing , routines. , Memory allocation for the disk dump package , is as follows... , Catalogue temporary storage , 4000 - 4077 , Printer buffer areas , 4100 - 4477 , Catalogue Buffer #1 , 5000 - 6777 , Catalogue buffer #2 , 7100 - 11077 , Disk dump catalogue file area , 11176 - 13177 , Billing routine buffer area , 13300 - 16777 , Billing temporary storage , 17000 - 17777 , Catalogue file key , 20000 - 20577 , Print line build area , 20700 - 20777 , Catalogue routine , 21000 - 21777 , Billing routine , 22000 - 22777 , Disk dump buffer #1 , 23076 - 27077 , Disk dump buffer #2 , 27176 - 33177 , CMESS is used as a flag and has the , following code , Bit 19 - dump in memory , Bit 18 - catalogue in memory , Bit 17 - billing in memory pr: eqo 4100 ;Print line buffers [adrs end key-see CPL] cin1: eqo 5000 ;Catalogue file buffers cin2: eqo 7100 ;Catalogue files !!Page 107 ckey: eqo 20000 catw: eqo 21000 jfile:eqo 11200 jbuf1:eqo 23100 ;Buffer 1 jbuf2:eqo 27200 ;Buffer 2 bin1: eqo 13300 ;Billing buffer area biltmp:eqo 17000 ;Billing temporary storage billw:eqo 22000 ;Billing program lcr1: eqo 23076 lcr2: eqo 27176 ltap: equ jfile ltap1:equ ltap+28 org pernum dec 4 dec cat org execov lda three ;Ask time to stop [wow - wish I could do that] spb spmess,2 lda six ;Ask for OFF spb spmess,2 dld *+4,3 ;Move catalogue down to where it should go mov execov bru cata ;and transfer it dec -1 ;Spare dec catw ;All goes down dec -512 , Catalog format , Each entry in the catalog is 8 words long , and containes information about a single , saved program in the following format... , Word 1 - first three characters of the user , number. , Word 2 - second three characters , Word 3 - first three characters of problem , name. , Word 4 - second three characters , Word 5 - beginning disk address of program , Word 6 - ending disk address of program !!Page 108 , Word 7 - coded date on which program was last , accessed. , Word 8 - presently contains only length , information - 0 if less than a half K, , 1 if greater. , The end of the entries in a given catalog is , signified by a 555555 appearing in word , 2. If more than 127 programs are saved by users , in a particular equivalence class, another , 1024-word block will be added to the catalog. , The presence of another link is indicated , as follows...in word 2 of what would be the , 128th entry will appear 373737. The word , before this will be the disk address of the , added catalog. org catw+10 cata: spb dskb,2 ;Go ask for disk spb dskop,2 ;Read in key to catalogue z12 6 ;6 records, with labels dec ckey ;memory address z20 key+2 ;inidirect to disk address bru * ;Should never ever return here spb messg,2 ;Acknowledge request dec pcr catb: spb dksop,2 ;Go read in date z12 1 ;1 record dec cin1 ;into area 1 oct 400 ;disk address dec -1 ;Should never return here spb relin,2 ;Give up disk lda cmess ;Set flag on to indicate calogue in add two sta cmess spb time,2 ;Get time for heading line dst chead1,3 sxg 5 ;Set executive group set pst ;and exit priority mode bru *+1,3 ldx 8K,3 ;and make sure upper 8K bit is in right place dld cinit,3 ;Get buffer flip-flops dst cin dld zero dst in sta cdass ;Reset save area for address ldx zero,2 lda ovflo dst cpnum,2 ;Set flag in program counters for decmode !!Page 109 inx 2,2 bxl 16,2 bru *-3 lda nblnk ;Negative blank for print line sta p16,3 sta perin ;Knock out indicator ext sign ;and reset sign bit lqa ;Copy in Q dst p*0,3 ;and push over the line sta p1,3 sta p2,3 dst ptl,3 inx 2,3 bxl 40,3 bru *-3 lda mask6 ;Set end of line sta ptl-2,3 ldx 8K,3 ;Reset register lda cin1 ;Pick up dlong - long programs counter spb convrt,2 ;convert it dst chdas2,3 ;Put away in heading line lda cin1+2 ;Pick up coded date spb convrt,2 ;convert it dst chcode,3 ;put away in next heading line dld ctdat,3 ;Move constant for date mov cin1+3 sxg 4 ;and use all sorts of index groups ldx 8K,2 ;Set some registers ldx 8K,3 lda ckey,2 ;Get first catalogue entry inx 1,2 ;and step for next sta cfilea+2,3 ;and set in parameter list sxg 3 set pbk spb dramb,2 ;Get catalogue dec cfilea ;File 1 set pst sxg 5 ;and get into some decent group spb slt8,2 ;Slew to top of page spb slw3,2 ;Slew page three lines lda linit,3 ;Initialize line counter at eight sta cline bcs bpn,6 ;Wait for printer ready bru *-1 sel 6 z26 -- ;[What's this?] z02 chead,1 ;Skip two lines when printing headers bcs bpn,6 ;Wait again bru *-1 sel 6 z26 -- !!Page 110 z02 chdass,1 bcs brn,6 ;Wait bru *-1 sel 6 z26 -- z04 cdate,1 ;Coded date heading line cloop:lda cin+1 ;Get next address sta xr52 ;and set in register sta cmore+1,3 ;and in indirect parameter sxg 4 ;Get next catalogue address lda ckey,2 inx 1,2 sxg 5 bmi ;Check the address bru crump1 ;If negative, stop bze ;If zero bru cflip ;then print last entry and crump sta 2,2 ;set in parameter list sxg 3 set pbk cmore:spb dramb,2 ;Get catalogue z00 -- ;Constructed indirect set pst sxg 5 ldx cin,2 ;Get last used file address lda 3,2 ;and check done word bze ;Wait for disk to finish bru *-2 bev ;If error, stop so we can see what and where dec -1 cflip:lmo ;Set print flag sta pflag dld cin ;Switch buffers xaq dst cin ldx cin+1,2 ;Last entry is now +1 lda 1,2 ;Get memory address sta xr52-1 lda 2,2 ;and get address sta cadrs ;save it for later cscan:lda 1,1 ;Check for 55s in second word cab c55s,3 bru *+2 ;If not, continue bru cloop ;Else try again cab c37s,3 ;See if one of Kip's crazy catalogs bru *+2 bru ccon ;Yep !!Page 111 lda bzyf ;Check for crump bze ;If so, then flag will be zero bru wait ;so get out lda pflag ;Look at print flag bze ;If zero, special case bru pset ;Wipe out disk address bpl ;If non-zero plus, get out bru pnext lda ovflo sta p3,3 cconk:bss 0 lda cadrs spb convrt,2 sta p*0+1,3 ;Move address over xaq sta p0,3 lda zero sta pflag pnext:lda p3,3 ;Increment counter set pbk set decmode ;for decimal mode arithmetic add one set binmode set pst sta p3,3 ;Put away counter dld 2,1 ;Problem number dst p6,3 lda 4,1 ;Starting disk address ext mask1 ;Check for legal address cab o300 bru *+3 bru *+1 spb cerr,2 ;No lda 4,1 ;Get address again cab cdass ;Check against last highest available bru *+3 ;location for saved programs bru *+2 sta cdass spb convrt,2 ;Convert it dst p8,3 lda 5,1 ;Ending disk address sub 4,1 ;Compute length of program bze spb cerr,2 ;Zero-length is illegal bmi ;Check if length all wrong spb cerr,2 ;Yes cab o100 ;Or out of bounds bru *+3 bru *+2 spb cerr,2 ;Yes !!Page 112 dld 0,1 ;User number dst p4,3 ;put away sub c77s,3 ;and see if hole bze bru pnoc ;If so, do not count it set pbk set decmode ;Decimal mode for counting problems lda 7,1 ;Length code ext mask3 ;just low end of interest sla 1 ;Double length table sta xr52 ;In group 5 dld cpnum,2 dad cone,3 ;Increment dst cpnum,2 set binmode set pst pnoc: lda 5,1 ;Pick up ending disk address again spb convrt,2 dst p10,3 lda 6,1 ;Pick up coded date spb convrt,2 dst p12,3 lda 7,1 ;Pick up unused word spb convrt,2 ;convert' dst p14,3 lda cerrf ;Check error flag bmi spb cerr1,2 dld pprnt,3 ;Get number of words in Q lda cpl,3 ;Get currently used buffer address add o200 ;Switch it ext o400 sta cpl,3 ;and restore mov P*0 ;Move into print area bcs bpn,6 ;Wait for printer bru *-1 sel 6 z36 cform,1 ;Format line cpl: z01 pr ;Print line inx 8,1 ;Increment area pointer lda cline ;Check if slew necessary add one sta cline ;put away incremented counter cab c57,3 ;57 lines per page bru cscan ;If less, go scan again lda three ;Else reset counter sta cline ;and slew page spb slt8,2 ;Slew to top bcs bpn,6 ;Wait for printer bru *-1 sel 6 !!Page 113 slw 1 ;Slew one line at top lda ptl1,3 ;and get page set pbk set decmode ;Count [page number] ado set binmode ;get back set pst sta ptl1,3 bcs bpn,6 ;Wait again bru *-1 sel 6 z26 -- z03 ptl,1 ;Title print bru cscan ;go scan pset: lda dumpbl ;Blanks sta p*0+1,3 ;Wipe out disk address sta p0,3 sta p1,3 sta pflag ;Reset flag to positive bru pnext ;Get back , This is used to fudge the right catalog when , a linked one is found. It reads the linked , catalog over the one it just listed and , then lists it. ccon:bss 0 ldx cin+1,2 lda 1,2 ;Fudge right catalog sta cconl+1,3 lda 0,1 sta cconl+2,3 sta cadrs set pbk spb dramb,2 dec cconl set pst lda cconl+3,3 bze bru *-2 ;Wait till done bev bru * ;[Hang on error] lda cconl+1,3 sta xr52-1 bru cconk , Catalog printout finished, determine next , available location and number of programs. !!Page 114 crump1:spb slw3,2 ;Slew three lines lda cdass ;Next available location for saved programs add o100 ;round up sta cdass ;save ext mask1 ;Check legality sub o300 bpl ;Bad bru *+3 ldz ;OK bru *+2 lda o100 add cdass ;Get good address spb convrt,2 ;convert it dst ccom2,3 ;put away bcs bpn,6 bru *-1 sel 6 ;Print it z26 -- z02 ccom1,1 , Now start totalling progams crump2:ldx zero,2 ;Loop counter bcs bpn,6 ;Wait at start bru *-1 dld cpnum,2 ;Number of programs cab ovflo bru *+1 add cig1,3 ;Delete right number of characters add cig2,3 dst ctotp,3 ;Total programs set pbk set decmode dld cpnum,2 dad ctot6,3 ;Keep total programs dst ctot6,3 set binmode set pst lda xr52 ;Get counter sra 1 add cig2,3 ;Do not want zeros sta cend1,3 ;Put in print line sel 6 ;Print it wpl cend1 inx 2,2 bxl 12,2 bru crump2+1 ;Start again spb slw3,2 ;Slew three lines dld ctot+6,3 ;Get rid of high-order zeros on this too cab ovflo bru *+1 !!Page 115 10/3/02 add cig1,3 add cig2,3 dst ctot6,3 bcs bpn,6 bru *-1 sel 6 ;Print total programs z24 -- dec ctot spb slt8,2 lda cmess ;Delete catalogue from roster sub two sta cmess bnz bru wait ;Yes, so crump bru icrump ;and type message cerr: lmo ;Set flag sta cerrf,3 bru 1,2 ;and get out cerr1:dld ****,3 ;Get asterisks dst p12,3 ;and set in last words dst p14,3 ldz ;Reset flag sta cerrf,3 bru 1,2 ;and get out slw3: bcs bpn,6 ;Wait bru *-1 sel 6 slw 3 bru 1,2 slt8: bcs bpn,6 bru *-1 sel 6 slw 8 bru 1,2 , Constants cfilea:z12 16 ;Read, 16 records - file parameter list dec cin1 ;Area 1 z00 -- ;Constructed disk address z00 -- ;Special terminate word !!Page 116 cfileb:z12 16 dec cin2 z00 -- z00 -- cconl:z12 16 z00 -- z00 -- z00 -- c37s: oct 373737 c57: dec 57 ;Number of lines per page c77s: oct 777777 ****: alf *** ;Special indicators alf *** cinit:dec cfilea ;Areas flip flop dec cfileb ctdat:dec chead2 ;Move constant for date dec -5 cone: oct 0 oct 1 pprnt:dec 0 ;Print move constant dec -19 c55s: oct 555555 linit:dec 11 ;Initial value for line counter cerrf:oct 0 ;Flag cig1: oct 35 cig2: oct 603500 , Format line cform:oct 353535 oct 353535 oct 353535 oct 353535 oct 373757 oct 353535 oct 363535 oct 353535 oct 363535 oct 353535 oct 363535 oct 353535 oct 363535 oct 353535 oct 363535 oct 353535 !!Page 117 oct 363535 oct 353535 oct 353535 , General heading line oct 0 ;Make into odd location ddc 0 org *-3 chead:alf DAR ;Dartmouth College Time-Sharing System alf TMO ;Catalogue files as of date alf UTH alf & CO alf LLE alf GE alf TIM alf E-S alf HAR alf ING alf & SY alf STE alf M C alf ATA alf LOG alf UE alf FIL alf ES alf AS alf OF chead2:alf & & & ;Date goes in these five locations alf & & & alf & & & alf & & & alf & & & alf & & T alf IME chead1:alf & & & ;Time goes in these two locations alf & & & alf & HO alf URS oct 2336060 , Second heading line oct 0 ;Make sure chdass is even chdass:oct 353545 ;[Next available location for saved ] alf EXT ;[programs is] alf & AV alf AIL alf ABL !!Page 118 alf E L alf OCA alf TIO alf N F alf OR alf SAV alf ED alf PRO alf GRA alf MS alf IS chdas2:alf & & & ;Dassgn foes in these two locations alf & & & oct 2336060 , Third heading line cdate:oct 353523 ;Coded date-- alf ODE alf D D alf ATE oct 404060 chcode:alf & & & ;Coded date goes in these two locations alf & & & oct 2336060 , Computed next available location ccom1:alf COM alf PUT alf ED alf NEX alf T A alf VAI alf LAB alf LE alf LOC alf ATI alf ON OCT 601660 ;Equal sign oct 353535 ;Ignores ccom2:alf & & & alf & & & oct 2336060 , Terminating lines for catalog printout cend1:alf & & & alf & LE alf NGT alf H P !!Page 119 alf ROG alf RAM alf S = ctotp:alf & & & alf & & & oct -336060 oct 0 ;Make next even ctot: alf & TO alf TAL alf & PR alf OGR alf AMS alf & = ctot6:ddc 0 oct -336060 , Print line build area loc 20700 p*0: bss 2 ;Leading blanks p0: bss 1 p1: bss 1 p2: bss 1 p3: bss 2 p4: bss 2 p6: bss 2 p8: bss 2 p10: bss 2 p12: bss 2 p14: bss 2 p16: bss 1 ptl: bss 40 ;Save 40 places for title ptl1: equ ptl+38 , Temporary storage org k6area cin: bss 2 cpnum:bss 16 ;Counters for programs cdass:bss 1 cadrs:bss 1 pflag:bss 1 cline:bss 1 org k2area ;Special fudging routine excv: equ execov dec excv+10 dec -502 catmov:dld *-2 ;Move catalogue up for loading onto disk !!Page 120 mov cata bru lovwrt ;and go write overlay tcd lovwrt stl ;Disk dump ejt !!Page 121 , Time-sharing disk dump. , The following areas will be dumped... , 1) The first half of disk zero , 2) The catalogue files , 3) All saved programs , Usually only one tape will be required, , and it should be mounted on handler 3. , If a second tape were to be required, the , program will ask for it via the console , typewriter and wait for zero to be toggled. , The second tape must be placed on handler , 7. In this case tape three will have to , be rewound manually. org pernum ;Heading information dec 6 dec dum org execov lda three ;Ask for time count stop sbp spmess,2 lda six ;Ask for OFF spb spmess,2 lda wait1 ;Reset P-counter sta pct lmo ;Reset some indicators sta perin ;Peripheral indicator sta in ;System indicator ldo ;Set cmess sta cmess spb dskb,2 ;Ask for disk spb dskop,2 ;and read in tape routine z12 3 ;300 octal words dec treqst z20 tap+2 ;Indirect to disk address bru * ;Should never happen spb treqst,2 ;Then use it sel 1 ;to rewind tape 3 rwd ,3 oct 0 ;Flag to indicate return spb dskop,2 ;Read in catalogue routine z12 8 ;1K octal dec catw z20 cat+2 ;Indirect to address bru * ;Neither should it return here spb dskop,2 ;Read in key to catalogue z12 6 ;6 records, with labels for dump dec ckey ;Key area z20 ckey+2 ;Indirecto to disk address bru * ;Real trouble if it returns here !!Page 122 spb dskop,2 ;Read in billing routine z12 8 dec billw z20 bil+2 ;Indirect to disk address bru * dld .jlnk.,3 ;Get linkage to dump routine spb insert,2 ;and insert in task list sta jlist ;Save entrance bru catb ;and transfer to catalogue , JLNK is entered after the catalogue routine , is initialized, and it writes labels on , tapes and types them out and does other odd , things. jlnk: lda 1,1 ;Switch entries for rest of time sta 0,1 dld jinit,3 ;Points to jfila, jfileb dst jin spb dramb,2 ;Pick up first 2K from disk zero dec jfila dld lab3 ;Get date mov sdate+1 spb time,2 ;and time dst dlab2,3 lmo ;Set flag word negative sta dlab5 ;to indicate tape #1 spb jexec,2 ;and exit with return saved bcs brw,1 ;Wait for tape to finish rewinding bru 2,1 ;If so [rewinding], exit spb billi,2 ;Initialize billing routine spb treqst,2 ;Write label sel 1 wtb dlab1,3 %30 oct 0 spb jexec,2 ;Do not overload task table lda *-2 bze ;If label not done, crump bru 2,1 spb messg,2 ;and type message dec dlab1 ;label spb messg,2 ;and time dec dumtim , JLOOPA reads in the first half of disk zero , and writes it on the dump tape !!Page 123 jloopa:spb jexec,2 ;Exit ldx jin,2 ;Points to current file spb jchk,0 ;See if any errors spb jtape,1 ;Go write records on tape ldx jin,2 ;Get file addresses again ldx jin+1,1 lda 2,2 ;Disk addresses cab jlast,3 ;and check for end first half disk zero bru *+2 bru jlba ;exit if so add o100 ;Step 2K sta 2,1 ;and set in next file ext mask1 ;Check for illegal cab o300 bru *+5 ;OK bru *+1 ;No, so step position lda 2,1 add o100 sta 2,1 stx jin+1,2 ;Flip flop buffer addresses lda z1 ;Get next one sta jin sta *+2,3 ;and set in calling pointer spb dramb,2 ;Pick up next 2K dec jfilb bru jloopa ;and get next , JLBA picks up catalogue files as indicated , by addresses in the key. jlba: ldx 8K,2 ;Begin saved programs dump stx jkey,2 ;Initialize catalogue pointer jlbb: ldx jkey,2 ;Get file pointer lda ckey,2 ;and entry for file bze ;Check for all done bru jend ;Yes, so terminate dump inx 1,2 ;Step pointer stx jkey,2 ;and save jlcn: sta jfilc+2,3 spb jexec,2 ;Now exit lda jtflg,3 ;and check to make sure last entry written bze ;on tape if one file empty bru 2,1 ;Wait if not spb dramb,2 ;If OK, bring in file jlfdg:dec jfilc ;Fudge factor spb jexec,2 ;and exit !!Page 124 lda jdfilc,3 sta z2 spb jchk,0 ;See if any errors lda jlfdg,3 ;Get fudge constant sta z2 ;and set in register 2 spb jtape,1 ;Write file on tape lda jfilc+1,3 ;Get memory address and initialize running sub jeig ;dec 8 sta jkvar ;pointer sta z2 ;and set in register bru jl1; ;and begin saving programs , JLOOPB picks up saved programs according to , the entries in each individual catalogue , file, and writes them out onto the dump , tape. jloopb:spb jexec,2 ;Exit ldx jin+1,2 ;Get current entry pointer spb jchk,0 ;See if any errors spb jtape,1 ;Write out just-read program jl1: ldx jkvar,2 ;Get running pointer inx 8,2 ;and step stx jkvar,2 ;save lda 1,2 ;Check for end file cab c37s ;check linked catalo bru *+2 bru jl2 ;Get next link cab j55s ;See if end of catalog file bru *+2 ;No bru jlbb ;Get next catalog record cab c77s,3 ;See if hole bru *+2 ;No bru jl1 ;Yes, just skip it lda 4,2 ;Get starting disk address ext mask1 cab o300 ;Check for legal bru *+3 bru jl1 ;No, crump it bru jl1 lda 5,2 ;Get length sub 4,2 sra 1 ;Mod 64 bpl ;Check if bad length, such as bze ;zero bru jl1 ;or negative cab o40 ;or too long bru *+3 bru *+2 !!Page 125 bru jl1 ldx jin+1,1 ;Get pointer to next parameter list sto 0,1 ;and set length in command lda 4,2 ;Get address again sta 2,1 ;and set in parameter list dld jin ;Flip entries xaq dst jin sta *+2,3 ;and in call spb dramb,2 ;Now read a program dec 0 ;Constructed parameter list pointer , These are fudges for buffering. Skip , write out prgram first time through and , make sure last one gets written lda *+4,3 ;Get branch for next time sta *-1,3 sta jloopb-1,3 ;Make sure last program gets written bru jl1 ;and get next program bru jloopb ;Normal entrance jl2: lda 0,2 ;This is a fudge to get extended catalog bru jlch ;and get it , JTAPE is entered on xreg1. Index register 2 , points to the disk parameter list , containing the information about the record , to be written on the tape. , This information becomes part of each tape , record in a special two-word key at the , beginning of each one, as follows. , word 1 - disk address , word 2 - length (mod 64) jtape:stx jtmp,1 ;Save entrance stx jtmpp,2 ;and save other spb jexec,2 ;and exit lda jtflg,3 ;Get completion flag bze ;If zero, not yet done bru 2,1 sra 1 ;Check for end of tape bod bru jswtch ;in which case change tapes jt2: ldx jtmpp,2 ;Get file pointer lda 1,2 ;and get memory address sub two ;decrement for key sta z1 ;and set in register lda jtap+2,3 ;Get operation ext mask11 ;less address add z1 ;and add memory address !!Page 126 sta jtap+2,3 ;Then set in call lda 0,2 ;Get length ext mask10 ;extract high-order end sta 1,1 ;and set in key sla 6 ;and set as # of records add two ;incremented for key sto jtap+3,3 ;in call lda 2,1 ;Set disk address in key sta 0,1 jtap: spb treqst,2 ;Write record on tape sel 1 wtb --,3 ;Constructed %0 jtflg:oct 1 ;Flag word - initialized ldx jtmp,1 ;Get return bru 1,1 ;and return jexec:stx jpoin,2 ;Save caller ldx jlist,1 ;Get entrance point bru 1,2 ;get back jent: ldx jpoin,2 ;Get caller bru 1,2 ;and return jswtch:lda jtap+3,3 ;Check for tape 7 already bmi ;If so, real trouble bru jtroub spb messg,2 ;Else type message to change tapes dec t07 lda sign ;Now switch handlers ory jtap+3,3 !!*************************************************** !!JSM: ERROR: the instruction below was !! ory jend+3,3 !!which is clearly wrong. It is !!part of a sequence contructing a tape operation, !!but as originally written, this instruction would !!place a sign bit into a location whose contents are !! spb jtape,1 !!creating an unintended (and probably illegal) !!instruction. The intent was to indicate whether !!a tape rewind operation should address handler !!3 or 7, as indicated by the comment at location !!'jend' + 9 (circa line 5321), so I created a symbol !!jend0 at that location and changed the original !!instruction as shown below. !!*************************************************** ory jend0+3,3 ;[jsm: *** CLEARLY AN ERROR *** was jend0+3] ory jend1+3,3 spb treqst,2 ;and rewind old tape sel 1 rwd ,3 oct 0 spb jexec,2 ;Exit ldz ;and wait for 2 to be toggled rcs sla 2 bno bru 2,1 ;Exit if not down yet ldz ;Set flag for second label sta dlab5.3 spb treqst,2 ;and write it on second tape which had better !!Page 127 sel 1 ;be rewound wtb dlab1,7 ;Write label out on 7 %30 oct 0 spb jexec,2 ;Exit and wait for label to be done lda *-2 bze bru 2,1 bru jt2 jtroub:spb messg,2 ;Type message and abort run dec psoo , JEND must write out the last program which is , still in memory jend: spb jexec,2 ;Exit first ldx jin+1,2 ;Get current file entry pointer spb jchk,0 ;Check disk spb jtape,1 ;Write on tape spb jexec,2 ;Exit again lda jtflg,3 ;Check done bze bru 2,1 ;Not yet jend0:spb treqb,2 ;Now rewind 3 - or 7 as may be sel 1 ;and write end-of-file on three - or 7 wef ,3 oct 0 jend1:spb treqb,2 sel 1 rwd ,3 oct spb jexec,2 ;Exit and wait lda *-2,3 ;Keep checking bze ;punt if not done bru 2,1 lda cmess ;Decrement flag to indicate completion sbo sta cmess sra 2 ;Check for billing in bev spb tclos,2 ;If not, close out tape routine ldx jlist,1 ;Get entry point spb irase,2 ;and erase lda cmess bze ;Check if billing or catalogue still in bru icrump ;if none, exit and type message bru 2,1 ;Exit !!Page 128 jchk: lda 3,2 ;Check for file read bze bru 2,1 ;If not, punt stx rawt,0 ;Save entrance bev ;Hang if any errors bru * ;not recovered ldx rawt,1 bru 1,1 ;Return , Disk parameter lists jfila:z12 32 ;Read in first half of disk zero dec jbuf1 ;into buffer #1 dec 0 ;constructed dec 0 ;completion indicator jfilb:z12 32 ;Read 2K dec jbuf2 ;Buffer 2 dec 0 ;constructed dec 0 ;completion indicator jfilc:z12 16 ;Special file for catalogues dec jfile dec 0 dec 0 .jlnk.:spb jlnk,1 ;Linkage entry for first time spb jent,1 ;subsequent times entry jinit:dec jfila ;Files flip flop dec jfilb jdfilc:dec jfilc dlab3:dec dlab ;Date move dec -5 jlast:oct 37600 ;Last record on disk zero j55s: oct 555555 jeig: dec 8 ;Start jkvar off right , ********************************************** , Do not go above 37500--tape sub. overlay , ********************************************** org ta ;Leave treqst some room jin: bss 2 jlist:bss 1 jkey: bss 1 !!Page 129 jkvar:bss 1 jtmp: bss 1 jtmpp:bss 1 jpoin:bss 1 tcd lovwrt ;Transfer stl ;Billing master pack ejt !!Page 130 10/4/02 , The billing master packing routine writes an , end-of-file on tape 0, rewinds 0 and 6, , then spaces forward 6 until it senses an , end-of-file. It then packs tape 0 onto 6, , blocking the latter by a factor of ten. , If called by *BILL*, it moves itself down to , 22000, but normally it is read in by the , dump routine and is part of the dump - cat , - billing package. org pernum dec 8 dec bil org execov lda three ;Ask for off spb spmess,2 lda six ;Turn off other teletypes spb mess,2 dld *+4,3 ;Move program down mov execov bru billa dec -1 ;Spare wo